dxinit.f

Go to the documentation of this file.

C> @file
C> @brief Initialize the internal arrays which contain the DX BUFR table.
C>
C> @author Woollen @date 1994-01-06
 
C> This subroutine initializes the internal arrays
C> (in module @ref moda_tababd) holding the DX BUFR table. It then
C> initializes the table with apriori Table B and D entries
C> (optional).
C>
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C> @param[in] IOI - integer: switch:
C> - 0 do not initialize the table with apriori Table B and D entries.
C> - else initialize the table with apriori Table B and D entries.
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE dxinit(LUN,IOI)
 
      USE moda_tababd
 
      COMMON /padesc/ ibct,ipd1,ipd2,ipd3,ipd4
      COMMON /reptab/ idnr(5,2),typs(5,2),reps(5,2),lens(5)
 
      CHARACTER*8   INIB(6,5),INID(5)
      CHARACTER*6   ADN30
      CHARACTER*3   TYPS
      CHARACTER*1   REPS
 
      DATA inib   /'------','BYTCNT  ','BYTES  ','+0','+0','16',
     .             '------','BITPAD  ','NONE   ','+0','+0','1 ',
     .             '031000','DRF1BIT ','NUMERIC','+0','+0','1 ',
     .             '031001','DRF8BIT ','NUMERIC','+0','+0','8 ',
     .             '031002','DRF16BIT','NUMERIC','+0','+0','16'/
      DATA ninib  /5/
 
      DATA inid   /'        ',
     .             'DRP16BIT',
     .             'DRP8BIT ',
     .             'DRPSTAK ',
     .             'DRP1BIT '/
      DATA ninid  /5/
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CLEAR OUT A TABLE PARTITION
C  ---------------------------
 
      ntba(lun) = 0
      DO i=1,ntba(0)
      taba(i,lun) = ' '
      mtab(i,lun) = 0
      ENDDO
 
      ntbb(lun) = 0
      DO i=1,ntbb(0)
      tabb(i,lun) = ' '
      ENDDO
 
      ntbd(lun) = 0
      DO i=1,ntbd(0)
      tabd(i,lun) = ' '
      CALL pktdd(i,lun,0,iret)
      ENDDO
 
      IF(ioi.EQ.0) GOTO 100
 
C  INITIALIZE TABLE WITH APRIORI TABLE B AND D ENTRIES
C  ---------------------------------------------------
 
      inib(1,1) = adn30(ibct,6)
      inib(1,2) = adn30(ipd4,6)
 
      DO i=1,ninib
      ntbb(lun) = ntbb(lun)+1
      idnb(i,lun) = ifxy(inib(1,i))
      tabb(i,lun)(  1:  6) = inib(1,i)(1:6)
      tabb(i,lun)(  7: 70) = inib(2,i)
      tabb(i,lun)( 71: 94) = inib(3,i)
      tabb(i,lun)( 95: 98) = inib(4,i)(1:4)
      tabb(i,lun)( 99:109) = inib(5,i)
      tabb(i,lun)(110:112) = inib(6,i)(1:3)
      ENDDO
 
      DO i=2,ninid
      n = ntbd(lun)+1
      idnd(n,lun) = idnr(i,1)
      tabd(n,lun)(1: 6) = adn30(idnr(i,1),6)
      tabd(n,lun)(7:70) = inid(i)
      CALL pktdd(n,lun,idnr(1,1),iret)
      CALL pktdd(n,lun,idnr(i,2),iret)
      ntbd(lun) = n
      ENDDO
 
C  EXIT
C  ----
 
100   RETURN
      END