var/external/bufr/getabdb.f

   1       SUBROUTINE GETABDB(LUNIT,TABDB,ITAB,JTAB)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    GETABDB
   6 C   PRGMMR: ATOR             ORG: NP12       DATE: 2005-11-29
   7 C
   8 C ABSTRACT: THIS SUBROUTINE RETURNS INTERNAL TABLE B AND TABLE D
   9 C   INFORMATION FOR LOGICAL UNIT LUNIT IN A PRE-DEFINED ASCII FORMAT.
  10 C
  11 C PROGRAM HISTORY LOG:
  12 C 2005-11-29  J. ATOR    -- ADDED TO BUFR ARCHIVE LIBRARY (WAS IN-LINED
  13 C                           IN PROGRAM NAMSND)
  14 C
  15 C USAGE:    CALL GETABDB( LUNIT, TABDB, ITAB, JTAB )
  16 C   INPUT ARGUMENT LIST:
  17 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  18 C     ITAB     - INTEGER: DIMENSIONED SIZE OF TABDB ARRAY
  19 C
  20 C   OUTPUT ARGUMENT LIST:
  21 C     TABDB    - CHARACTER*128: (JTAB)-WORD ARRAY OF INTERNAL TABLE B
  22 C                AND TABLE D INFORMATION
  23 C     JTAB     - INTEGER: NUMBER OF ENTRIES STORED WITHIN TABDB
  24 C
  25 C REMARKS:
  26 C    THIS ROUTINE CALLS:        NEMTBD   STATUS
  27 C    THIS ROUTINE IS CALLED BY: None
  28 C                               Normally called only by application
  29 C                               programs.
  30 C
  31 C ATTRIBUTES:
  32 C   LANGUAGE: FORTRAN 77
  33 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  34 C
  35 C$$$
  36
  37       INCLUDE 'bufrlib.prm'
  38
  39       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  40      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  41      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  42      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  43      .                TABD(MAXTBD,NFILES)
  44
  45       CHARACTER*600 TABD
  46       CHARACTER*128 TABB
  47       CHARACTER*128 TABA
  48       CHARACTER*128 TABDB(*)
  49       CHARACTER*8   NEMO,NEMS(MAXCD)
  50       DIMENSION     IRPS(MAXCD),KNTS(MAXCD)
  51
  52 C-----------------------------------------------------------------------
  53 C-----------------------------------------------------------------------
  54
  55       JTAB = 0
  56
  57 C  MAKE SURE THE FILE IS OPEN
  58 C  --------------------------
  59
  60       CALL STATUS(LUNIT,LUN,IL,IM)
  61       IF(IL.EQ.0) RETURN
  62
  63 C  WRITE OUT THE TABLE D ENTRIES FOR THIS FILE
  64 C  -------------------------------------------
  65
  66       DO I=1,NTBD(LUN)
  67       NEMO = TABD(I,LUN)(7:14)
  68       CALL NEMTBD(LUN,I,NSEQ,NEMS,IRPS,KNTS)
  69       DO J=1,NSEQ,10
  70       JTAB = JTAB+1
  71       IF(JTAB.LE.ITAB) THEN
  72          WRITE(TABDB(JTAB),1) NEMO,(NEMS(K),K=J,MIN(J+9,NSEQ))
  73 1        FORMAT('D ',A8,10(1X,A10))
  74       ENDIF
  75       ENDDO
  76       ENDDO
  77
  78 C  ADD THE TABLE B ENTRIES
  79 C  -----------------------
  80
  81       DO I=1,NTBB(LUN)
  82       JTAB = JTAB+1
  83       IF(JTAB.LE.ITAB) THEN
  84          WRITE(TABDB(JTAB),2) TABB(I,LUN)(7:14),TABB(I,LUN)(71:112)
  85 2        FORMAT('B ',A8,1X,A42)
  86       ENDIF
  87       ENDDO
  88
  89       RETURN
  90       END