getabdb.f

Go to the documentation of this file.

C> @file
C> @brief Get Table B and Table D information from the internal DX BUFR
C> tables
C> @author J. Ator @date 2005-11-29
 
C> This subroutine reads Table B and Table D information from the
C> internal DX BUFR tables for a specified Fortran logical unit, then
C> returns this information in a pre-defined ASCII format.
C>
C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR file
C> @param[in] ITAB  -- integer: Dimensioned size of TABDB array; used
C>                     by the subroutine to ensure that it doesn't
C>                     overflow the TABDB array
C> @param[out] TABDB -- character*128(*): Internal Table B and Table D
C>                      information
C> @param[out] JTAB -- integer: Number of entries stored within TABDB
C>
C> @author J. Ator @date 2005-11-29
      RECURSIVE SUBROUTINE getabdb(LUNIT,TABDB,ITAB,JTAB)
 
      USE moda_tababd
      USE moda_nmikrp
      USE modv_im8b
 
      CHARACTER*128 tabdb(*)
      CHARACTER*8   nemo
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL x84(itab,my_itab,1)
         CALL getabdb(my_lunit,tabdb,my_itab,jtab)
         CALL x48(jtab,jtab,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      jtab = 0
 
C  MAKE SURE THE FILE IS OPEN
C  --------------------------
 
      CALL status(lunit,lun,il,im)
      IF(il.EQ.0) RETURN
 
C  WRITE OUT THE TABLE D ENTRIES FOR THIS FILE
C  -------------------------------------------
 
      DO i=1,ntbd(lun)
      nemo = tabd(i,lun)(7:14)
      CALL nemtbd(lun,i,nseq,nem(1,1),irp(1,1),krp(1,1))
      DO j=1,nseq,10
      jtab = jtab+1
      IF(jtab.LE.itab) THEN
         WRITE(tabdb(jtab),1) nemo,(nem(k,1),k=j,min(j+9,nseq))
1        FORMAT('D ',a8,10(1x,a10))
      ENDIF
      ENDDO
      ENDDO
 
C  ADD THE TABLE B ENTRIES
C  -----------------------
 
      DO i=1,ntbb(lun)
      jtab = jtab+1
      IF(jtab.LE.itab) THEN
         WRITE(tabdb(jtab),2) tabb(i,lun)(7:14),tabb(i,lun)(71:112)
2        FORMAT('B ',a8,1x,a42)
      ENDIF
      ENDDO
 
      RETURN
      END