Line data    Source code

       1           0 :       subroutine RPFERR (text)
       2             : 
       3             : *-----------------------------------------------------------------------
       4             : *     Report an error.
       5             : *
       6             : *     Given:
       7             : *          TEXT*(*) char  The basic error message used to construct
       8             : *                         ERRMSG.
       9             : *
      10             : *     Given via the IOSTAT common:
      11             : *          ERRLUN   int   If non-negative, write the message on ERRLUN.
      12             : *                         The message written is ' RPFITSIN: ' followed
      13             : *                         by ERRMSG (without trailing blanks).
      14             : *
      15             : *     Returned via the NAMES common:
      16             : *          ERRMSG*80
      17             : *                   char  TEXT which, if rp_iostat is non-zero, will be
      18             : *                         suffixed with ', iostat =' and the number.
      19             : *
      20             : *     Original: 2008/09/11 Mark Calabretta
      21             : *     $Id: rpferr.f,v 1.1 2008/09/11 06:36:57 cal103 Exp $
      22             : *-----------------------------------------------------------------------
      23             : 
      24             :       character text*(*)
      25             : 
      26             :       include 'rpfits.inc'
      27             : 
      28             :       integer   idx, NCHAR
      29             : 
      30           0 :       errmsg = text
      31           0 :       if (rp_iostat.ne.0) then
      32             : *        Find last non-blank.
      33           0 :          idx = NCHAR(errmsg)
      34           0 :          if (errmsg(idx:idx).ne.'.') idx = idx + 1
      35             : 
      36           0 :          if (idx.lt.80) then
      37           0 :            write (errmsg(idx:), 10) rp_iostat
      38             :  10        format (', iostat =', i4, '.')
      39             :          end if
      40             :       end if
      41             : 
      42           0 :       if (errlun.ge.0) then
      43           0 :          write (errlun, *) ' RPFITSIN: ', errmsg(:NCHAR(errmsg))
      44             :       end if
      45             : 
      46           0 :       return
      47           0 :       end
      48             : 
      49             : *     ------------------------------------------------------------------
      50             : 
      51             :       block data bd_iostat
      52             :       include 'rpfits.inc'
      53             :       data rp_iostat /0/
      54             :       data errlun /6/
      55             :       end