var/external/bufr/uptdd.f

   1       SUBROUTINE UPTDD(ID,LUN,IENT,IRET)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UPTDD
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE RETURNS THE BIT-WISE REPRESENTATION OF THE
   9 C   FXY VALUE CORRESPONDING TO, SEQUENTIALLY, A PARTICULAR (IENT'th)
  10 C   "CHILD" MNEMONIC OF A TABLE D SEQUENCE ("PARENT") MNEMONIC.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  14 C 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
  15 C                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
  16 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  17 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  18 C                           ROUTINE "BORT"
  19 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  20 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  21 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  22 C                           BUFR FILES UNDER THE MPI)
  23 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  24 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  25 C                           INTERDEPENDENCIES
  26 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  27 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  28 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  29 C                           ABNORMALLY
  30 C
  31 C USAGE:    CALL UPTDD (ID, LUN, IENT, IRET)
  32 C   INPUT ARGUMENT LIST:
  33 C     ID       - INTEGER: POSITIONAL INDEX OF PARENT MNEMONIC WITHIN
  34 C                INTERNAL BUFR TABLE D ARRAY TABD
  35 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  36 C     IENT     - INTEGER: ORDINAL INDICATOR OF CHILD MNEMONIC TO RETURN
  37 C                FROM WITHIN TABD(ID,LUN) SEQUENCE:
  38 C                       0 = return a count of the total number of child
  39 C                           mnemonics within TABD(ID,LUN)
  40 C
  41 C   OUTPUT ARGUMENT LIST:
  42 C     IRET     - INTEGER: RETURN VALUE (SEE REMARKS)
  43 C
  44 C REMARKS:
  45 C    THE INTERPRETATION OF THE RETURN VALUE IRET DEPENDS UPON THE INPUT
  46 C    VALUE IENT, AS FOLLOWS:
  47 C
  48 C    IF ( IENT = 0 ) THEN
  49 C       IRET = a count of the total number of child mnemonics within
  50 C              TABD(ID,LUN)
  51 C    ELSE
  52 C       IRET = the bit-wise representation of the FXY value
  53 C              corresponding to the IENT'th child mnemonic of
  54 C              TABD(ID,LUN)
  55 C    END IF
  56 C
  57 C
  58 C    THIS ROUTINE CALLS:        BORT     IUPM
  59 C    THIS ROUTINE IS CALLED BY: NEMTBD   RESTD
  60 C                               Normally not called by any application
  61 C                               programs.
  62 C
  63 C ATTRIBUTES:
  64 C   LANGUAGE: FORTRAN 77
  65 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  66 C
  67 C$$$
  68
  69       INCLUDE 'bufrlib.prm'
  70
  71       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  72      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  73      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  74      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  75      .                TABD(MAXTBD,NFILES)
  76       COMMON /DXTAB / MAXDX,IDXV,NXSTR(10),LDXA(10),LDXB(10),LDXD(10),
  77      .                LD30(10),DXSTR(10)
  78
  79       CHARACTER*600 TABD
  80       CHARACTER*128 BORT_STR
  81       CHARACTER*128 TABB
  82       CHARACTER*128 TABA
  83       CHARACTER*56  DXSTR
  84
  85 C-----------------------------------------------------------------------
  86 C-----------------------------------------------------------------------
  87
  88       LDD = LDXD(IDXV+1)+1
  89
  90 C  CHECK IF IENT IS IN BOUNDS
  91 C  --------------------------
  92
  93       NDSC = IUPM(TABD(ID,LUN)(LDD:LDD),8)
  94
  95       IF(IENT.EQ.0) THEN
  96          IRET = NDSC
  97          GOTO 100
  98       ELSEIF(IENT.LT.0 .OR. IENT.GT.NDSC) THEN
  99          GOTO 900
 100       ENDIF
 101
 102 C  RETURN THE DESCRIPTOR INDICATED BY IENT
 103 C  ---------------------------------------
 104
 105       IDSC = LDD+1 + (IENT-1)*2
 106       IRET = IUPM(TABD(ID,LUN)(IDSC:IDSC),16)
 107
 108 C  EXITS
 109 C  -----
 110
 111 100   RETURN
 112 900   WRITE(BORT_STR,'("BUFRLIB: UPTDD - VALUE OF THIRD ARGUMENT IENT'//
 113      . ' (INPUT) IS OUT OF RANGE (IENT =",I4,")")') IENT
 114       CALL BORT(BORT_STR)
 115       END