var/external/bufr/dxinit.f

   1       SUBROUTINE DXINIT(LUN,IOI)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    DXINIT
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE INITIALIZES THE INTERNAL ARRAYS
   9 C   (COMMON BLOCK /TABABD/) HOLDING THE DICTIONARY TABLE.  IT THEN
  10 C   INITIALIZES THE TABLE WITH APRIORI TABLE B AND D ENTRIES
  11 C   (OPTIONAL).
  12 C
  13 C PROGRAM HISTORY LOG:
  14 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  15 C 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
  16 C                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
  17 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  18 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  19 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  20 C                           BUFR FILES UNDER THE MPI)
  21 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  22 C                           INTERDEPENDENCIES
  23 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  24 C                           DOCUMENTATION (INCLUDING HISTORY)
  25 C 2009-03-23  J. ATOR    -- REMOVE INITIALIZATION OF COMMON /MSGCWD/
  26 C
  27 C USAGE:    CALL DXINIT (LUN, IOI)
  28 C   INPUT ARGUMENT LIST:
  29 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  30 C     IOI      - INTEGER: SWITCH:
  31 C                       0 = do not initialize the table with apriori
  32 C                           Table B and D entries
  33 C                    else = initialize the table with apriori Table B
  34 C                           and D entries
  35 C
  36 C REMARKS:
  37 C    THIS ROUTINE CALLS:        ADN30    IFXY     PKTDD
  38 C    THIS ROUTINE IS CALLED BY: CPBFDX   OPENBF   RDBFDX   RDUSDX
  39 C                               READERME READS3
  40 C                               Normally not called by any application
  41 C                               programs.
  42 C
  43 C ATTRIBUTES:
  44 C   LANGUAGE: FORTRAN 77
  45 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  46 C
  47 C$$$
  48
  49       INCLUDE 'bufrlib.prm'
  50
  51       COMMON /PADESC/ IBCT,IPD1,IPD2,IPD3,IPD4
  52       COMMON /REPTAB/ IDNR(5,2),TYPS(5,2),REPS(5,2),LENS(5)
  53       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  54      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  55      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  56      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  57      .                TABD(MAXTBD,NFILES)
  58
  59       CHARACTER*600 TABD
  60       CHARACTER*128 TABB
  61       CHARACTER*128 TABA
  62       CHARACTER*8   INIB(6,5),INID(5)
  63       CHARACTER*6   ADN30
  64       CHARACTER*3   TYPS
  65       CHARACTER*1   REPS
  66
  67       DATA INIB   /'------','BYTCNT  ','BYTES  ','+0','+0','16',
  68      .             '------','BITPAD  ','NONE   ','+0','+0','1 ',
  69      .             '031000','DRF1BIT ','NUMERIC','+0','+0','1 ',
  70      .             '031001','DRF8BIT ','NUMERIC','+0','+0','8 ',
  71      .             '031002','DRF16BIT','NUMERIC','+0','+0','16'/
  72       DATA NINIB  /5/
  73
  74       DATA INID   /'        ',
  75      .             'DRP16BIT',
  76      .             'DRP8BIT ',
  77      .             'DRPSTAK ',
  78      .             'DRP1BIT '/
  79       DATA NINID  /5/
  80
  81 C-----------------------------------------------------------------------
  82 C-----------------------------------------------------------------------
  83
  84 C  CLEAR OUT A TABLE PARTITION
  85 C  ---------------------------
  86
  87       NTBA(LUN) = 0
  88       DO I=1,NTBA(0)
  89       TABA(I,LUN) = ' '
  90       MTAB(I,LUN) = 0
  91       ENDDO
  92
  93       NTBB(LUN) = 0
  94       DO I=1,NTBB(0)
  95       TABB(I,LUN) = ' '
  96       ENDDO
  97
  98       NTBD(LUN) = 0
  99       DO I=1,NTBD(0)
 100       TABD(I,LUN) = ' '
 101 c  .... This zeroes the counter in TABD array, IRET returns as 0 and
 102 c       is not tested
 103       CALL PKTDD(I,LUN,0,IRET)
 104       ENDDO
 105
 106       IF(IOI.EQ.0) GOTO 100
 107
 108 C  INITIALIZE TABLE WITH APRIORI TABLE B AND D ENTRIES
 109 C  ---------------------------------------------------
 110
 111       INIB(1,1) = ADN30(IBCT,6)
 112       INIB(1,2) = ADN30(IPD4,6)
 113
 114       DO I=1,NINIB
 115       NTBB(LUN) = NTBB(LUN)+1
 116       IDNB(I,LUN) = IFXY(INIB(1,I))
 117       TABB(I,LUN)(  1:  6) = INIB(1,I)
 118       TABB(I,LUN)(  7: 70) = INIB(2,I)
 119       TABB(I,LUN)( 71: 94) = INIB(3,I)
 120       TABB(I,LUN)( 95: 98) = INIB(4,I)
 121       TABB(I,LUN)( 99:109) = INIB(5,I)
 122       TABB(I,LUN)(110:112) = INIB(6,I)
 123       ENDDO
 124
 125       DO I=2,NINID
 126       N = NTBD(LUN)+1
 127       IDND(N,LUN) = IDNR(I,1)
 128       TABD(N,LUN)(1: 6) = ADN30(IDNR(I,1),6)
 129       TABD(N,LUN)(7:70) = INID(I)
 130 c  .... DK: what if IRET = -1 ???
 131       CALL PKTDD(N,LUN,IDNR(1,1),IRET)
 132 c  .... DK: what if IRET = -1 ???
 133       CALL PKTDD(N,LUN,IDNR(I,2),IRET)
 134       NTBD(LUN) = N
 135       ENDDO
 136
 137 C  EXIT
 138 C  ----
 139
 140 100   RETURN
 141       END