getabdb.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2005-11-29
      
C> THIS SUBROUTINE RETURNS INTERNAL TABLE B AND TABLE D
C>   INFORMATION FOR LOGICAL UNIT LUNIT IN A PRE-DEFINED ASCII FORMAT.
C>
C> PROGRAM HISTORY LOG:
C> 2005-11-29  J. ATOR    -- ADDED TO BUFR ARCHIVE LIBRARY (WAS IN-LINED
C>                           IN PROGRAM NAMSND)
C> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C>
C> USAGE:    CALL GETABDB( LUNIT, TABDB, ITAB, JTAB )
C>   INPUT ARGUMENT LIST:
C>     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C>     ITAB     - INTEGER: DIMENSIONED SIZE OF TABDB ARRAY
C>
C>   OUTPUT ARGUMENT LIST:
C>     TABDB    - CHARACTER*128: (JTAB)-WORD ARRAY OF INTERNAL TABLE B
C>                AND TABLE D INFORMATION
C>     JTAB     - INTEGER: NUMBER OF ENTRIES STORED WITHIN TABDB
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        NEMTBD   STATUS
C>    THIS ROUTINE IS CALLED BY: None
C>                               Normally called only by application
C>                               programs.
C>
      SUBROUTINE getabdb(LUNIT,TABDB,ITAB,JTAB)

      USE moda_tababd
      USE moda_nmikrp

      CHARACTER*128 tabdb(*)
      CHARACTER*8   nemo

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

      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