var/external/bufr/rewnbf.f

   1       SUBROUTINE REWNBF(LUNIT,ISR)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    REWNBF
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2003-11-04
   7 C
   8 C ABSTRACT: THIS SUBROUTINE, DEPENDING ON THE VALUE OF ISR, WILL
   9 C   EITHER:
  10 C        1) STORE THE CURRENT PARAMETERS ASSOCIATED WITH A BUFR FILE
  11 C   CONNECTED TO LUNIT (READ/WRITE POINTERS, ETC.), SET THE FILE STATUS
  12 C   TO READ, THEN REWIND THE BUFR FILE AND POSITION IT SUCH THAT THE
  13 C   NEXT BUFR MESSAGE READ WILL BE THE FIRST MESSAGE IN THE FILE
  14 C   CONTAINING ACTUAL SUBSETS WITH DATA; OR
  15 C        2) RESTORE THE BUFR FILE CONNECTED TO LUNIT TO THE PARAMETERS
  16 C   IT HAD PRIOR TO 1) ABOVE USING THE INFORMATION SAVED IN 1) ABOVE.
  17 C
  18 C   THIS ALLOWS INFORMATION TO BE EXTRACTED FROM A PARTICULAR SUBSET IN
  19 C   A BUFR FILE WHICH IS IN THE MIDST OF BEING READ FROM OR WRITTEN TO
  20 C   BY AN APPLICATION PROGRAM.  NOTE THAT FOR A PARTICULAR BUFR FILE 1)
  21 C   ABOVE MUST PRECEDE 2) ABOVE.  AN APPLICATION PROGRAM MIGHT FIRST
  22 C   CALL THIS SUBROUTINE WITH ISR = 0, THEN CALL EITHER BUFR ARCHIVE
  23 C   LIBRARY SUBROUTINE RDMGSB OR UFBINX TO GET INFO FROM A SUBSET, THEN
  24 C   CALL THIS ROUTINE AGAIN WITH ISR = 1 TO RESTORE THE POINTERS IN THE
  25 C   BUFR FILE TO THEIR ORIGINAL LOCATION.  ALSO, BUFR ARCHIVE LIBRARY
  26 C   SUBROUTINE UFBTAB WILL CALL THIS ROUTINE IF THE BUFR FILE IT IS
  27 C   ACTING UPON IS ALREADY OPEN FOR INPUT OR OUTPUT.
  28 C
  29 C PROGRAM HISTORY LOG:
  30 C 2003-11-04  J. WOOLLEN -- ORIGINAL AUTHOR (WAS IN VERIFICATION
  31 C                           VERSION BUT MAY HAVE BEEN IN THE PRODUCTION
  32 C                           VERSION AT ONE TIME AND THEN REMOVED)
  33 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  34 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  35 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  36 C                           ABNORMALLY
  37 C 2004-08-09  J. ATOR    -- MAXIMUM MESSAGE LENGTH INCREASED FROM
  38 C                           20,000 TO 50,000 BYTES
  39 C 2009-03-23  J. ATOR    -- MODIFIED TO HANDLE EMBEDDED BUFR TABLE
  40 C                           (DICTIONARY) MESSAGES
  41 C 2011-09-26  J. WOOLLEN -- FIXED BUG TO PREVENT SKIP OF FIRST DATA
  42 C                           MESSAGE AFTER REWIND
  43 C 2012-09-15  J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE;
  44 C                           REPLACE FORTRAN REWIND WITH C CEWIND
  45 C
  46 C USAGE:    CALL REWNBF (LUNIT, ISR)
  47 C   INPUT ARGUMENT LIST:
  48 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  49 C     ISR      - INTEGER: SWITCH:
  50 C                       0 = store current parameters associated with
  51 C                           BUFR file, set file status to read, rewind
  52 C                           file such that next message read is first
  53 C                           message containing subset data
  54 C                       1 = restore BUFR file with parameters saved
  55 C                           from the previous call to this routine with
  56 C                           ISR=0
  57 C
  58 C   INPUT FILES:
  59 C     UNIT "LUNIT" - BUFR FILE
  60 C
  61 C REMARKS:
  62 C    THIS ROUTINE CALLS:        BORT     I4DY     READMG   STATUS
  63 C                               WTSTAT   CEWIND
  64 C    THIS ROUTINE IS CALLED BY: UFBINX   UFBTAB
  65 C                               Also called by application programs.
  66 C
  67 C ATTRIBUTES:
  68 C   LANGUAGE: FORTRAN 77
  69 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  70 C
  71 C$$$
  72
  73       INCLUDE 'bufrlib.prm'
  74
  75       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  76      .                INODE(NFILES),IDATE(NFILES)
  77       COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
  78      .                MBAY(MXMSGLD4,NFILES)
  79       COMMON /BUFRSR/ JUNN,JILL,JIMM,JBIT,JBYT,JMSG,JSUB,KSUB,JNOD,JDAT,
  80      .                JSR(NFILES),JBAY(MXMSGLD4)
  81
  82       CHARACTER*128 BORT_STR
  83
  84       CHARACTER*8   SUBSET
  85
  86       DIMENSION     MESG(MXMSGLD4)
  87
  88 C-----------------------------------------------------------------------
  89 C-----------------------------------------------------------------------
  90
  91 C  TRY TO TRAP BAD CALL PROBLEMS
  92 C  -----------------------------
  93
  94       IF(ISR.EQ.0) THEN
  95          CALL STATUS(LUNIT,LUN,IL,IM)
  96          IF(JSR(LUN).NE.0)  GOTO 900
  97          IF(IL.EQ.0) GOTO 901
  98       ELSEIF(ISR.EQ.1) THEN
  99          LUN = JUNN
 100          IF(JSR(JUNN).NE.1)  GOTO 902
 101       ELSE
 102          GOTO 903
 103       ENDIF
 104
 105 C  STORE FILE PARAMETERS AND SET FOR READING
 106 C  -----------------------------------------
 107
 108       IF(ISR.EQ.0) THEN
 109          JUNN = LUN
 110          JILL = IL
 111          JIMM = IM
 112          JBIT = IBIT
 113          JBYT = MBYT(LUN)
 114          JMSG = NMSG(LUN)
 115          JSUB = NSUB(LUN)
 116          KSUB = MSUB(LUN)
 117          JNOD = INODE(LUN)
 118          JDAT = IDATE(LUN)
 119          DO I=1,JBYT
 120          JBAY(I) = MBAY(I,LUN)
 121          ENDDO
 122          CALL WTSTAT(LUNIT,LUN,-1,0)
 123       ENDIF
 124
 125 C  REWIND THE FILE
 126 C  ---------------
 127
 128       call cewind(lun)
 129
 130 C  RESTORE FILE PARAMETERS AND POSITION IT TO WHERE IT WAS SAVED
 131 C  -------------------------------------------------------------
 132
 133       IF(ISR.EQ.1) THEN
 134          LUN        = JUNN
 135          IL         = JILL
 136          IM         = JIMM
 137          IBIT       = JBIT
 138          MBYT(LUN)  = JBYT
 139          NMSG(LUN)  = JMSG
 140          NSUB(LUN)  = JSUB
 141          MSUB(LUN)  = KSUB
 142          INODE(LUN) = JNOD
 143          IDATE(LUN) = I4DY(JDAT)
 144          DO I=1,JBYT
 145            MBAY(I,LUN) = JBAY(I)
 146          ENDDO
 147          DO IMSG=1,JMSG
 148            CALL READMG(LUNIT,SUBSET,KDATE,IER)
 149            IF(IER.LT.0) GOTO 905
 150          ENDDO
 151          CALL WTSTAT(LUNIT,LUN,IL,IM)
 152       ENDIF
 153
 154       JSR(LUN) = MOD(JSR(LUN)+1,2)
 155
 156 C  EXITS
 157 C  -----
 158
 159       RETURN
 160 900   WRITE(BORT_STR,'("BUFRLIB: REWNBF - ATTEMPING TO SAVE '//
 161      . 'PARAMETERS FOR FILE FOR WHICH THEY HAVE ALREADY BEEN SAVED '//
 162      . '(AND NOT YET RESTORED) (UNIT",I3,")")') LUNIT
 163       CALL BORT(BORT_STR)
 164 901   WRITE(BORT_STR,'("BUFRLIB: REWNBF - ATTEMPING TO SAVE '//
 165      . 'PARAMETERS FOR BUFR FILE WHICH IS NOT OPENED FOR EITHER INPUT'//
 166      . ' OR OUTPUT) (UNIT",I3,")")') LUNIT
 167       CALL BORT(BORT_STR)
 168 902   WRITE(BORT_STR,'("BUFRLIB: REWNBF - ATTEMPING TO RESTORE '//
 169      . 'PARAMETERS TO BUFR FILE WHICH WERE NEVER SAVED (UNIT",I3,")")')
 170      . LUNIT
 171       CALL BORT(BORT_STR)
 172 903   WRITE(BORT_STR,'("BUFRLIB: REWNBF - SAVE/RESTORE SWITCH (INPUT '//
 173      . 'ARGUMENT ISR) IS NOT ZERO OR ONE (HERE =",I4,") (UNIT",I3,")")')
 174      . ISR,LUNIT
 175       CALL BORT(BORT_STR)
 176 905   WRITE(BORT_STR,'("BUFRLIB: REWNBF - HIT END OF FILE BEFORE '//
 177      . 'REPOSITIONING BUFR FILE IN UNIT",I3," TO ORIGINAL MESSAGE '//
 178      . 'NO.",I5)') LUNIT,JMSG
 179       CALL BORT(BORT_STR)
 180       END