var/external/bufr/drfini.f

   1       SUBROUTINE DRFINI(LUNIT,MDRF,NDRF,DRFTAG)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    DRFINI
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2002-05-14
   7 C
   8 C ABSTRACT:  THIS SUBROUTINE INITIALIZES DELAYED REPLICATION FACTORS
   9 C   AND EXPLICITLY ALLOCATES A CORRESPONDING AMOUNT OF SPACE IN THE
  10 C   INTERNAL SUBSET ARRAYS, THEREBY ALLOWING THE SUBSEQUENT USE OF BUFR
  11 C   ARCHIVE LIBRARY SUBROUTINE UFBSEQ TO WRITE DATA DIRECTLY INTO
  12 C   DELAYED REPLICATION SEQUENCES.  NOTE THAT THIS SAME TYPE OF
  13 C   INITIALIZATION IS DONE IMPLICTLY WITHIN BUFR ARCHIVE LIBRARY
  14 C   SUBROUTINE UFBINT FOR DELAYED REPLICATION SEQUENCES WHICH APPEAR
  15 C   ONLY ONE TIME WITHIN AN OVERALL SUBSET DEFINITION.  HOWEVER, BY
  16 C   USING SUBROUTINE DRFINI ALONG WITH A SUBSEQUENT CALL TO SUBROUTINE
  17 C   UFBSEQ, IT IS ACTUALLY POSSIBLE TO HAVE MULTIPLE OCCURRENCES OF A
  18 C   PARTICULAR DELAYED REPLICATION SEQUENCE WITHIN A SINGLE OVERALL
  19 C   SUBSET DEFINITION.
  20 C
  21 C PROGRAM HISTORY LOG:
  22 C 2002-05-14  J. WOOLLEN -- ORIGINAL AUTHOR
  23 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  24 C                           INTERDEPENDENCIES
  25 C 2003-11-04  D. KEYSER  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
  26 C                           INCREASED FROM 15000 TO 16000 (WAS IN
  27 C                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
  28 C                           WRF; ADDED DOCUMENTATION (INCLUDING
  29 C                           HISTORY); OUTPUTS MORE COMPLETE DIAGNOSTIC
  30 C                           INFO WHEN ROUTINE TERMINATES ABNORMALLY
  31 C 2005-03-04  J. ATOR    -- UPDATED DOCUMENTATION
  32 C
  33 C USAGE:    CALL DRFINI (LUNIT, MDRF, NDRF, DRFTAG)
  34 C   INPUT ARGUMENT LIST:
  35 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  36 C     MDRF     - INTEGER: ARRAY OF DELAYED REPLICATION FACTORS,
  37 C                IN ONE-TO-ONE CORRESPONDENCE WITH THE NUMBER OF
  38 C                OCCURRENCES OF DRFTAG WITHIN THE OVERALL SUBSET
  39 C                DEFINITION, AND EXPLICITLY DEFINING HOW MUCH SPACE
  40 C                (I.E. HOW MANY REPLICATIONS) TO ALLOCATE WITHIN
  41 C                EACH SUCCESSIVE OCCURRENCE
  42 C     NDRF     - INTEGER: NUMBER OF DELAYED REPLICATION FACTORS
  43 C                WITHIN MDRF
  44 C     DRFTAG   - CHARACTER*(*): SEQUENCE MNEMONIC, BRACKETED BY
  45 C                APPROPRIATE DELAYED REPLICATION NOTATION
  46 C                (E.G. {}, () OR <>)
  47 C
  48 C REMARKS:
  49 C    THIS ROUTINE CALLS:        BORT     STATUS   USRTPL
  50 C    THIS ROUTINE IS CALLED BY: None
  51 C                               Normally called only by application
  52 C                               programs
  53 C
  54 C ATTRIBUTES:
  55 C   LANGUAGE: FORTRAN 77
  56 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  57 C
  58 C$$$
  59
  60       INCLUDE 'bufrlib.prm'
  61
  62       COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
  63      .                JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
  64      .                IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
  65      .                ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
  66      .                ISEQ(MAXJL,2),JSEQ(MAXJL)
  67       COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
  68
  69       CHARACTER*(*) DRFTAG
  70       CHARACTER*128 BORT_STR
  71       CHARACTER*10  TAG
  72       CHARACTER*3   TYP
  73       REAL*8        VAL
  74       DIMENSION     MDRF(NDRF)
  75
  76 C-----------------------------------------------------------------------
  77 C-----------------------------------------------------------------------
  78
  79       IF(NDRF.GT.100) GOTO 900
  80
  81       CALL STATUS(LUNIT,LUN,IL,IM)
  82
  83 C  COMFORM THE TEMPLATES TO THE DELAYED REPLICATION FACTORS
  84 C  --------------------------------------------------------
  85
  86       M = 0
  87       N = 0
  88
  89 10    DO N=N+1,NVAL(LUN)
  90       NODE = INV(N,LUN)
  91       IF(ITP(NODE).EQ.1 .AND. TAG(NODE).EQ.DRFTAG) THEN
  92          M = M+1
  93          CALL USRTPL(LUN,N,MDRF(M))
  94          GOTO 10
  95       ENDIF
  96       ENDDO
  97
  98 C  EXITS
  99 C  -----
 100
 101       RETURN
 102  900  WRITE(BORT_STR,'("BUFRLIB: DRFINI - THE NUMBER OF DELAYED '//
 103      . 'REPLICATION FACTORS (",I5,") EXCEEDS THE LIMIT (100)")') NDRF
 104       CALL BORT(BORT_STR)
 105       END