var/external/bufr/bfrini.f

   1       SUBROUTINE BFRINI
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    BFRINI
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE IS CALLED ONLY ONE TIME (DURING THE FIRST
   9 C   CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE OPENBF) IN ORDER TO
  10 C   INITIALIZE SOME GLOBAL VARIABLES AND ARRAYS WITHIN SEVERAL COMMON
  11 C   BLOCKS.
  12 C
  13 C PROGRAM HISTORY LOG:
  14 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  15 C 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
  16 C                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
  17 C 1998-07-08  J. WOOLLEN -- MODIFIED TO MAKE Y2K COMPLIANT
  18 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  19 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  20 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  21 C                           BUFR FILES UNDER THE MPI)
  22 C 2000-09-19  J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
  23 C                           10,000 TO 20,000 BYTES
  24 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  25 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  26 C                           INTERDEPENDENCIES
  27 C 2003-11-04  D. KEYSER  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
  28 C                           INCREASED FROM 15000 TO 16000 (WAS IN
  29 C                           VERIFICATION VERSION); INITIALIZES
  30 C                           VARIABLE JSR AS ZERO IN NEW COMMON BLOCK
  31 C                           /BUFRSR/ (WAS IN VERIFICATION VERSION);
  32 C                           UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  33 C                           DOCUMENTATION
  34 C 2004-08-18  J. ATOR    -- ADDED INITIALIZATION OF COMMON /MSGSTD/;
  35 C                           MAXIMUM MESSAGE LENGTH INCREASED FROM
  36 C                           20,000 TO 50,000 BYTES
  37 C 2005-11-29  J. ATOR    -- ADDED INITIALIZATION OF COMMON /MSGCMP/
  38 C                           AND CALLS TO PKVS1 AND PKVS01
  39 C 2009-03-23  J. ATOR    -- ADDED INITIALIZATION OF COMMON /DSCACH/,
  40 C                           COMMON /MSTINF/ AND COMMON /TNKRCP/
  41 C 2012-09-15  J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE
  42 C                        -- ADDED INITIALIZATION OF COMMON BLOCKS
  43 C                        -- /ENDORD/ AND /BUFRBMISS/
  44 C
  45 C USAGE:    CALL BFRINI
  46 C
  47 C REMARKS:
  48 C    THIS ROUTINE CALLS:        IFXY     IPKM     PKVS01
  49 C    THIS ROUTINE IS CALLED BY: OPENBF
  50 C                               Normally not called by any application
  51 C                               programs.
  52 C
  53 C ATTRIBUTES:
  54 C   LANGUAGE: FORTRAN 77
  55 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  56 C
  57 C$$$
  58
  59       INCLUDE 'bufrlib.prm'
  60
  61       COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
  62      .                MBAY(MXMSGLD4,NFILES)
  63       COMMON /MAXCMP/ MAXCMB,MAXROW,MAXCOL,NCMSGS,NCSUBS,NCBYTS
  64       COMMON /PADESC/ IBCT,IPD1,IPD2,IPD3,IPD4
  65       COMMON /REPTAB/ IDNR(5,2),TYPS(5,2),REPS(5,2),LENS(5)
  66       COMMON /STBFR / IOLUN(NFILES),IOMSG(NFILES)
  67       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  68      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  69      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  70      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  71      .                TABD(MAXTBD,NFILES)
  72       COMMON /DXTAB / MAXDX,IDXV,NXSTR(10),LDXA(10),LDXB(10),LDXD(10),
  73      .                LD30(10),DXSTR(10)
  74       COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
  75      .                JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
  76      .                IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
  77      .                ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
  78      .                ISEQ(MAXJL,2),JSEQ(MAXJL)
  79       COMMON /DSCACH/ NCNEM,CNEM(MXCNEM),NDC(MXCNEM),
  80      .                IDCACH(MXCNEM,MAXNC)
  81       COMMON /BUFRMG/ MSGLEN,MSGTXT(MXMSGLD4)
  82       COMMON /MRGCOM/ NRPL,NMRG,NAMB,NTOT
  83       COMMON /DATELN/ LENDAT
  84       COMMON /ACMODE/ IAC
  85       COMMON /BUFRSR/ JUNN,JILL,JIMM,JBIT,JBYT,JMSG,JSUB,KSUB,JNOD,JDAT,
  86      .                JSR(NFILES),JBAY(MXMSGLD4)
  87       COMMON /MSGSTD/ CSMF
  88       COMMON /MSGCMP/ CCMF
  89       COMMON /TNKRCP/ ITRYR,ITRMO,ITRDY,ITRHR,ITRMI,CTRT
  90       COMMON /MSTINF/ LUN1,LUN2,LMTD,MTDIR
  91       COMMON /ENDORD/ IBLOCK,IORDBE(4),IORDLE(4)
  92
  93
  94       CHARACTER*600 TABD
  95       CHARACTER*128 TABB
  96       CHARACTER*128 TABA
  97       CHARACTER*100 MTDIR
  98       CHARACTER*56  DXSTR
  99       CHARACTER*10  TAG
 100       CHARACTER*8   CNEM
 101       CHARACTER*6   ADSN(5,2),DNDX(25,10)
 102       CHARACTER*3   TYPX(5,2),TYPS,TYP
 103       CHARACTER*1   REPX(5,2),REPS
 104       CHARACTER*1   CSMF
 105       CHARACTER*1   CCMF
 106       CHARACTER*1   CTRT
 107       DIMENSION     NDNDX(10),NLDXA(10),NLDXB(10),NLDXD(10),NLD30(10)
 108       DIMENSION     LENX(5)
 109
 110       DATA ADSN   / '101000','360001','360002','360003','360004' ,
 111      .              '101255','031002','031001','031001','031000' /
 112       DATA TYPX   /    'REP',   'DRP',   'DRP',   'DRS' ,  'DRB' ,
 113      .                 'SEQ',   'RPC',   'RPC',   'RPS' ,  'SEQ' /
 114       DATA REPX   /      '"',     '(',     '{',     '[' ,    '<' ,
 115      .                   '"',     ')',     '}',     ']' ,    '>' /
 116       DATA LENX   /       0 ,     16 ,      8 ,      8  ,     1  /
 117
 118       DATA (DNDX(I,1),I=1,25)/
 119      .'102000','031001','000001','000002',
 120      .'110000','031001','000010','000011','000012','000013','000015',
 121      .                  '000016','000017','000018','000019','000020',
 122      .'107000','031001','000010','000011','000012','000013','101000',
 123      .                  '031001','000030'/
 124
 125       DATA (DNDX(I,2),I=1,15)/
 126      .'103000','031001','000001','000002','000003',
 127      .'101000','031001','300004',
 128      .'105000','031001','300003','205064','101000','031001','000030'/
 129
 130       DATA NDNDX /  25 ,  15 , 8*0 /
 131       DATA NLDXA /  35 ,  67 , 8*0 /
 132       DATA NLDXB /  80 , 112 , 8*0 /
 133       DATA NLDXD /  38 ,  70 , 8*0 /
 134       DATA NLD30 /   5 ,   6 , 8*0 /
 135
 136 C-----------------------------------------------------------------------
 137 C-----------------------------------------------------------------------
 138
 139 C  INITIALIZE /ENDORD/ TO CONTROL OUTPUT BLOCKING -1=LE 0=NONE +1=BE
 140 C  -----------------------------------------------------------------
 141
 142       IBLOCK = 0
 143
 144 C  INITIALIZE /BUFRBMISS/
 145 C  ----------------------
 146
 147       BMISS = 10E10
 148
 149 C  INITIALIZE /BITBUF/
 150 C  -------------------
 151
 152       MAXBYT = 10000
 153
 154 C  INITIALIZE /MAXCMP/
 155 C  -------------------
 156
 157       MAXCMB = MAXBYT
 158       MAXROW = 0
 159       MAXCOL = 0
 160       NCMSGS = 0
 161       NCSUBS = 0
 162       NCBYTS = 0
 163
 164 C  INITIALIZE /PADESC/
 165 C  -------------------
 166
 167       IBCT = IFXY('063000')
 168       IPD1 = IFXY('102000')
 169       IPD2 = IFXY('031001')
 170       IPD3 = IFXY('206001')
 171       IPD4 = IFXY('063255')
 172
 173 C  INITIALIZE /STBFR/
 174 C  ------------------
 175
 176       DO I=1,NFILES
 177       IOLUN(I) = 0
 178       IOMSG(I) = 0
 179       ENDDO
 180
 181 C  INITIALIZE /REPTAB/
 182 C  -------------------
 183
 184       DO I=1,5
 185       LENS(I) = LENX(I)
 186       DO J=1,2
 187       IDNR(I,J) = IFXY(ADSN(I,J))
 188       TYPS(I,J) = TYPX(I,J)
 189       REPS(I,J) = REPX(I,J)
 190       ENDDO
 191       ENDDO
 192
 193 C  INITIALIZE /TABABD/ (INTERNAL ARRAYS HOLDING DICTIONARY TABLE)
 194 C  --------------------------------------------------------------
 195
 196 C    NTBA(0) is the maximum number of entries w/i internal BUFR table A
 197
 198       NTBA(0) = MAXTBA
 199
 200 C    NTBB(0) is the maximum number of entries w/i internal BUFR Table B
 201
 202       NTBB(0) = MAXTBB
 203
 204 C    NTBD(0) is the maximum number of entries w/i internal BUFR Table D
 205
 206       NTBD(0) = MAXTBD
 207
 208 C  INITIALIZE /DXTAB/
 209 C  ------------------
 210
 211       MAXDX = MAXBYT
 212 c  .... IDXV is the version number of the local tables
 213       IDXV  = 1
 214
 215       DO J=1,10
 216       LDXA(J)  = NLDXA(J)
 217       LDXB(J)  = NLDXB(J)
 218       LDXD(J)  = NLDXD(J)
 219       LD30(J)  = NLD30(J)
 220       DXSTR(J) = '      '
 221       NXSTR(J) = NDNDX(J)*2
 222       DO I=1,NDNDX(J)
 223       I1 = I*2-1
 224       CALL IPKM(DXSTR(J)(I1:I1),2,IFXY(DNDX(I,J)))
 225       ENDDO
 226       ENDDO
 227
 228 C  INITIALIZE /BTABLES/
 229 C  -------------------
 230
 231       MAXTAB = MAXJL
 232
 233 C  INITIALIZE /BUFRMG/
 234 C  -------------------
 235
 236       MSGLEN = 0
 237
 238 C  INITIALIZE /MRGCOM/
 239 C  -------------------
 240
 241       NRPL = 0
 242       NMRG = 0
 243       NAMB = 0
 244       NTOT = 0
 245
 246 C  INITIALIZE /DATELN/
 247 C  -------------------
 248
 249       IF(LENDAT.NE.10) LENDAT = 8
 250
 251 C  INITIALIZE /ACMODE/
 252 C  ------------------_
 253
 254 c  .... DK: What does this control??
 255       IAC = 0
 256
 257 C  INITIALIZE /BUFRSR/
 258 C  -------------------
 259
 260       DO I=1,NFILES
 261       JSR(I) = 0
 262       ENDDO
 263
 264 C  INITIALIZE /DSCACH/
 265 C  -------------------
 266
 267       NCNEM = 0
 268
 269 C  INITIALIZE /MSGSTD/
 270 C  -------------------
 271
 272       CSMF = 'N'
 273
 274 C  INITIALIZE /MSGCMP/
 275 C  -------------------
 276
 277       CCMF = 'N'
 278
 279 C  INITIALIZE /TNKRCP/
 280 C  -------------------
 281
 282       CTRT = 'N'
 283
 284 C  INITIALIZE /MSTINF/
 285 C  -------------------
 286
 287       MTDIR = '/nwprod/fix'
 288       LMTD = 11
 289
 290       LUN1 = 98
 291       LUN2 = 99
 292
 293 C  INITIALIZE /S01CM/
 294 C  -------------------
 295
 296       CALL PKVS01('INIT',-99)
 297
 298       RETURN
 299       END