wrfv2_fire/var/external/bufr/rdmemm.inc

   1       SUBROUTINE RDMEMM (IMSG, SUBSET, JDATE, IRET)
   2
   3 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 !
   5 ! SUBPROGRAM:    RDMEMM
   6 !   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 !
   8 ! ABSTRACT: THIS SUBROUTINE READS A PARTICULAR BUFR MESSAGE FROM
   9 !   INTERNAL MEMORY (ARRAY MSGS IN COMMON BLOCK /MSGMEM/) INTO A
  10 !   MESSAGE BUFFER (ARRAY MBAY IN COMMON BLOCK /BITBUF/).  IT IS
  11 !   IDENTICAL TO BUFR ARCHIVE LIBRARY SUBROUTINE READMM EXCEPT IT DOES
  12 !   NOT ADVANCE THE VALUE OF IMSG PRIOR TO RETURNING TO CALLING
  13 !   PROGRAM.
  14 !
  15 ! PROGRAM HISTORY LOG:
  16 ! 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  17 ! 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  18 !                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  19 !                           ROUTINE "BORT"; MODIFIED TO MAKE Y2K
  20 !                           COMPLIANT
  21 ! 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  22 !                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  23 !                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  24 !                           BUFR FILES UNDER THE MPI); THE MAXIMUM
  25 !                           NUMBER OF BYTES REQUIRED TO STORE ALL
  26 !                           MESSAGES INTERNALLY WAS INCREASED FROM 4
  27 !                           MBYTES TO 8 MBYTES
  28 ! 2000-09-19  J. WOOLLEN -- REMOVED MESSAGE DECODING LOGIC THAT HAD
  29 !                           BEEN REPLICATED IN THIS AND OTHER READ
  30 !                           ROUTINES AND CONSOLIDATED IT INTO A NEW
  31 !                           ROUTINE CKTABA, CALLED HERE, WHICH IS
  32 !                           ENHANCED TO ALLOW COMPRESSED AND STANDARD
  33 !                           BUFR MESSAGES TO BE READ; MAXIMUM MESSAGE
  34 !                           LENGTH INCREASED FROM 10,000 TO 20,000
  35 !                           BYTES
  36 ! 2001-08-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  37 !                           BYTES REQUIRED TO STORE ALL MESSAGES
  38 !                           INTERNALLY) WAS INCREASED FROM 8 MBYTES TO
  39 !                           16 MBYTES
  40 ! 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  41 !                           INTERDEPENDENCIES
  42 ! 2003-11-04  D. KEYSER  -- PARAMETER MAXMSG (THE MAXIMUM NUMBER OF
  43 !                           BUFR MESSAGES WHICH CAN BE STORED
  44 !                           INTERNALLY) INCREASED FROM 50000 TO 200000;
  45 !                           UNIFIED/PORTABLE FOR WRF; ADDED
  46 !                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  47 !                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  48 !                           TERMINATES ABNORMALLY OR UNUSUAL THINGS
  49 !                           HAPPEN
  50 ! 2004-08-09  J. ATOR    -- MAXIMUM MESSAGE LENGTH INCREASED FROM
  51 !                           20,000 TO 50,000 BYTES
  52 ! 2004-11-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  53 !                           BYTES REQUIRED TO STORE ALL MESSAGES
  54 !                           INTERNALLY) WAS INCREASED FROM 16 MBYTES TO
  55 !                           50 MBYTES
  56 !
  57 ! USAGE:    CALL RDMEMM (IMSG, SUBSET, JDATE, IRET)
  58 !   INPUT ARGUMENT LIST:
  59 !     IMSG     - INTEGER: POINTER TO BUFR MESSAGE NUMBER (RECORD) IN
  60 !                         STORAGE
  61 !                       0 = resets the memory file
  62 !
  63 !   OUTPUT ARGUMENT LIST:
  64 !     SUBSET   - CHARACTER*8: TABLE A MNEMONIC FOR TYPE OF BUFR MESSAGE
  65 !                BEING READ
  66 !     JDATE    - INTEGER: DATE-TIME STORED WITHIN SECTION 1 OF BUFR
  67 !                MESSAGE BEING READ, IN FORMAT OF EITHER YYMMDDHH OR
  68 !                YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
  69 !     IRET     - INTEGER: RETURN CODE:
  70 !                       0 = normal return
  71 !                      -1 = IMSG is either zero or greater than the
  72 !                           number of messages in memory
  73 !
  74 !   OUTPUT FILES:
  75 !     UNIT 06  - STANDARD OUTPUT PRINT
  76 !
  77 ! REMARKS:
  78 !    NOTE THAT UFBMEM IS CALLED PRIOR TO THIS TO STORE THE BUFR
  79 !    MESSAGES INTO INTERNAL MEMORY.
  80 !
  81 !    THIS ROUTINE CALLS:        BORT     CKTABA   STATUS   WTSTAT
  82 !    THIS ROUTINE IS CALLED BY: UFBMMS   UFBMNS   UFBRMS   UFBTAM
  83 !                               Also called by application programs.
  84 !
  85 ! ATTRIBUTES:
  86 !   LANGUAGE: FORTRAN 77
  87 !   MACHINE:  PORTABLE TO ALL PLATFORMS
  88 !
  89 !$$$
  90
  91       INCLUDE 'bufrlib.prm'
  92
  93       COMMON / MSGCWD / NMSG (NFILES), NSUB (NFILES), MSUB (NFILES),    &
  94       INODE (NFILES), IDATE (NFILES)
  95       COMMON / BITBUF / MAXBYT, IBIT, IBAY (MXMSGLD4), MBYT (NFILES),   &
  96       MBAY (MXMSGLD4, NFILES)
  97 !     COMMON / MSGMEM / MUNIT, MLAST, MSGP (0:MAXMSG), MSGS (MAXMEM)
  98       COMMON / QUIET / IPRT
  99
 100       CHARACTER(8) SUBSET
 101
 102 !-----------------------------------------------------------------------
 103 !-----------------------------------------------------------------------
 104
 105 !  CHECK THE MESSAGE REQUEST AND FILE STATUS
 106 !  -----------------------------------------
 107
 108       CALL STATUS (MUNIT, LUN, IL, IM)
 109       CALL WTSTAT (MUNIT, LUN, IL, 1)
 110       IF (IL.EQ.0) GOTO 900
 111       IF (IL.GT.0) GOTO 901
 112       IRET = 0
 113
 114       IF (IMSG.EQ.0.OR.IMSG.GT.MSGP (0) ) THEN
 115          CALL WTSTAT (MUNIT, LUN, IL, 0)
 116          IF (IPRT.GE.1) THEN
 117             PRINT *
 118       PRINT * , '+++++++++++++++++++++++WARNING+++++++++++++++++++++++++&
 119      &'
 120             IF (IMSG.EQ.0) THEN
 121                PRINT * , 'BUFRLIB: RDMEMM - REQUESTED MEMORY MESSAGE ', &
 122                'NUMBER {FIRST (INPUT) ARGUMENT} IS 0, RETURN WITH ',    &
 123                'IRET = -1'
 124             ELSE
 125                PRINT * , 'BUFRLIB: RDMEMM - REQ. MEMORY MESSAGE NO. {', &
 126                IMSG, ' - {1ST (INPUT) ARG.} > NO. OF MESSAGES IN ',     &
 127                'MEMORY (', MSGP (0) , '), RETURN WITH IRET = -1'
 128             ENDIF
 129       PRINT * , '+++++++++++++++++++++++WARNING+++++++++++++++++++++++++&
 130      &'
 131             PRINT *
 132          ENDIF
 133          IRET = - 1
 134          GOTO 100
 135       ENDIF
 136
 137 !  READ MEMORY MESSAGE NUMBER IMSG INTO A MESSAGE BUFFER
 138 !  -----------------------------------------------------
 139
 140       IPTR = MSGP (IMSG)
 141       IF (IMSG.LT.MSGP (0) ) LPTR = MSGP (IMSG + 1) - IPTR
 142       IF (IMSG.EQ.MSGP (0) ) LPTR = MLAST - IPTR + 1
 143       IPTR = IPTR - 1
 144
 145       DO I = 1, LPTR
 146       MBAY (I, LUN) = MSGS (IPTR + I)
 147       ENDDO
 148
 149 !  PARSE THE MESSAGE SECTION CONTENTS
 150 !  ----------------------------------
 151
 152       CALL CKTABA (LUN, SUBSET, JDATE, JRET)
 153       NMSG (LUN) = IMSG
 154
 155 !  EXITS
 156 !  -----
 157
 158   100 RETURN
 159   900 CALL BORT ('BUFRLIB: RDMEMM - INPUT BUFR FILE IS CLOSED, IT '//   &
 160       'MUST BE OPEN FOR INPUT')
 161   901 CALL BORT ('BUFRLIB: RDMEMM - INPUT BUFR FILE IS OPEN FOR '//     &
 162       'OUTPUT, IT MUST BE OPEN FOR INPUT')
 163       END SUBROUTINE RDMEMM