var/external/bufr/readdx.f

   1       SUBROUTINE READDX(LUNIT,LUN,LUNDX)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    READDX
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE GENERATES INTERNAL ARRAYS CONTAINING BUFR
   9 C   DICTIONARY TABLES WHICH ARE NEEDED TO READ, WRITE, INITIALIZE OR
  10 C   APPEND A BUFR FILE.  THE INFORMATION USED TO CREATE THE INTERNAL
  11 C   DICTIONARY TABLE ARRAYS (IN COMMON BLOCK /TABABD/) AND THE
  12 C   DICTIONARY MESSAGE CONTROL WORD PARTITION ARRAYS (IN COMMON BLOCK
  13 C   /MSGCWD/) (WHICH ARE ALWAYS THEN ASSOCIATED WITH THE BUFR FILE IN
  14 C   LUNIT) MAY COME FROM AN EXTERNAL, USER-SUPPLIED, BUFR DICTIONARY
  15 C   TABLE FILE IN CHARACTER FORMAT (I.E., A BUFR MNEMONIC TABLE), FROM
  16 C   THE BUFR FILE BEING ACTED UPON (IN WHICH CASE THE FILE MUST BE
  17 C   OPENED FOR INPUT PROCESSING AND POSITIONED AT A DICTIONARY TABLE
  18 C   MESSAGE SOMEWHERE IN THE FILE), OR FROM ANOTHER CURRENTLY OPENED
  19 C   AND DEFINED BUFR FILE.  IN THIS LATTER CASE, THE BUFR FILE WOULD
  20 C   MOST LIKELY BE OPENED FOR INPUT, HOWEVER THERE IS NOTHING
  21 C   PREVENTING THE USE OF A FILE OPEN FOR OUTPUT AS LONG AS IT IS
  22 C   ASSOCIATED WITH INTERNAL DICTIONARY ARRAYS THAT CAN BE USED.
  23 C
  24 C PROGRAM HISTORY LOG:
  25 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  26 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  27 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  28 C                           ROUTINE "BORT"
  29 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  30 C                           INTERDEPENDENCIES
  31 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  32 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  33 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  34 C                           TERMINATES ABNORMALLY OR FOR INFORMATIONAL
  35 C                           PURPOSES
  36 C 2009-04-21  J. ATOR    -- USE ERRWRT
  37 C
  38 C USAGE:    CALL READDX (LUNIT, LUN, LUNDX)
  39 C   INPUT ARGUMENT LIST:
  40 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  41 C                BEING READ, WRITTEN, INITIALIZED OR APPENDED
  42 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  43 C                (ASSOCIATED WITH FILE CONNECTED TO LOGICAL UNIT LUNIT)
  44 C     LUNDX    - INTEGER: FORTRAN LOGICAL UNIT NUMBER CONTAINING
  45 C                DICTIONARY TABLE INFORMATION TO BE USED IN READING/
  46 C                WRITING FROM/TO LUNIT (DEPENDING ON THE CASE); MAY BE
  47 C                SET EQUAL TO LUNIT IF DICTIONARY TABLE INFORMATION IS
  48 C                ALREADY EMBEDDED IN LUNIT (BUT ONLY IF LUNIT IS BEING
  49 C                READ)
  50 C
  51 C REMARKS:
  52 C    THIS ROUTINE CALLS:        BORT     CPBFDX   ERRWRT   MAKESTAB
  53 C                               RDBFDX   RDUSDX   STATUS
  54 C    THIS ROUTINE IS CALLED BY: OPENBF   WRITDX
  55 C                               Normally not called by any application
  56 C                               programs.
  57 C
  58 C ATTRIBUTES:
  59 C   LANGUAGE: FORTRAN 77
  60 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  61 C
  62 C$$$
  63
  64       COMMON /QUIET/ IPRT
  65
  66       CHARACTER*128 ERRSTR
  67
  68 C-----------------------------------------------------------------------
  69 C-----------------------------------------------------------------------
  70
  71 C  GET THE BUFR STATUS OF UNIT LUNDX
  72 C  ---------------------------------
  73
  74       CALL STATUS(LUNDX,LUD,ILDX,IMDX)
  75
  76 C  READ A DICTIONARY TABLE FROM THE INDICATED SOURCE
  77 C  -------------------------------------------------
  78
  79       IF (LUNIT.EQ.LUNDX) THEN
  80 c  .... Source is input BUFR file in LUNIT
  81          IF(IPRT.GE.2) THEN
  82           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
  83           WRITE ( UNIT=ERRSTR, FMT='(A,A,I3,A)' )
  84      .     'BUFRLIB: READDX - READING BUFR DICTIONARY TABLE FROM ',
  85      .     'INPUT BUFR FILE IN UNIT ', LUNDX, ' INTO INTERNAL ARRAYS'
  86           CALL ERRWRT(ERRSTR)
  87           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
  88           CALL ERRWRT(' ')
  89          ENDIF
  90          REWIND LUNIT
  91          CALL RDBFDX(LUNIT,LUN)
  92       ELSEIF(ILDX.EQ.-1) THEN
  93 c  .... Source is input BUFR file in LUNDX
  94 c  .... BUFR file in LUNIT may be input or output
  95          IF(IPRT.GE.2) THEN
  96           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
  97           WRITE ( UNIT=ERRSTR, FMT='(A,A,I3,A,A,I3)' )
  98      .     'BUFRLIB: READDX - COPYING BUFR DCTY TBL FROM INTERNAL ',
  99      .     'ARRAYS ASSOC. W/ INPUT UNIT ', LUNDX, ' TO THOSE ASSOC. ',
 100      .     'W/ UNIT ', LUNIT
 101           CALL ERRWRT(ERRSTR)
 102           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
 103           CALL ERRWRT(' ')
 104          ENDIF
 105          CALL CPBFDX(LUD,LUN)
 106          CALL MAKESTAB
 107       ELSEIF(ILDX.EQ.1) THEN
 108 c  .... Source is output BUFR file in LUNDX
 109 c  .... BUFR file in LUNIT may be input or output
 110          IF(IPRT.GE.2) THEN
 111           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
 112           WRITE ( UNIT=ERRSTR, FMT='(A,A,I3,A,A,I3)' )
 113      .     'BUFRLIB: READDX - COPYING BUFR DCTY TBL FROM INTERNAL ',
 114      .     'ARRAYS ASSOC. W/ OUTPUT UNIT ', LUNDX, ' TO THOSE ASSOC. ',
 115      .     'W/ UNIT ', LUNIT
 116           CALL ERRWRT(ERRSTR)
 117           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
 118           CALL ERRWRT(' ')
 119          ENDIF
 120          CALL CPBFDX(LUD,LUN)
 121          CALL MAKESTAB
 122       ELSEIF(ILDX.EQ.0) THEN
 123 c  .... Source is user-supplied character table in LUNDX
 124 c  .... BUFR file in LUNIT may be input or output
 125          IF(IPRT.GE.2) THEN
 126           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
 127           WRITE ( UNIT=ERRSTR, FMT='(A,A,I3,A)' )
 128      .     'BUFRLIB: READDX - READING BUFR DICTIONARY TABLE FROM ',
 129      .     'USER-SUPPLIED TEXT FILE IN UNIT ', LUNDX,
 130      .     ' INTO INTERNAL ARRAYS'
 131           CALL ERRWRT(ERRSTR)
 132           CALL ERRWRT('++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++')
 133           CALL ERRWRT(' ')
 134          ENDIF
 135          REWIND LUNDX
 136          CALL RDUSDX(LUNDX,LUN)
 137       ELSE
 138          GOTO 900
 139       ENDIF
 140
 141 C  EXITS
 142 C  -----
 143
 144       RETURN
 145 900   CALL BORT('BUFRLIB: READDX - CANNOT DETERMINE SOURCE OF '//
 146      . 'INPUT DICTIONARY TABLE')
 147       END