bfrini.f90

Go to the documentation of this file.

subroutine bfrini

USE moda_stbfr
USE moda_idrdm
USE moda_msglim
USE moda_bitbuf
USE moda_bufrmg
USE moda_bufrsr
USE moda_tababd
USE moda_usrint
USE moda_tables
USE moda_h4wlc
USE moda_dscach

COMMON /maxcmp/ maxcmb,maxrow,maxcol,ncmsgs,ncsubs,ncbyts
COMMON /padesc/ ibct,ipd1,ipd2,ipd3,ipd4
COMMON /reptab/ idnr(5,2),typs(5,2),reps(5,2),lens(5)
COMMON /dxtab / maxdx,idxv,nxstr(10),ldxa(10),ldxb(10),ldxd(10), &
                ld30(10),dxstr(10)
COMMON /mrgcom/ nrpl,nmrg,namb,ntot
COMMON /dateln/ lendat
COMMON /acmode/ iac
COMMON /msgstd/ csmf
COMMON /msgcmp/ ccmf
COMMON /tablef/ cdmf
COMMON /tnkrcp/ itryr,itrmo,itrdy,itrhr,itrmi,ctrt
COMMON /endord/ iblock,iordbe(4),iordle(4)

character*100 cmtdir
character*56  dxstr
character*6   adsn(5,2),dndx(25,10)
character*3   typx(5,2),typs
character*1   repx(5,2),reps
character*1   csmf
character*1   ccmf
character*1   cdmf
character*1   ctrt
dimension     ndndx(10),nldxa(10),nldxb(10),nldxd(10),nld30(10)
dimension     lenx(5)

data adsn   / '101000','360001','360002','360003','360004' , &
              '101255','031002','031001','031001','031000' /
data typx   /    'REP',   'DRP',   'DRP',   'DRS' ,  'DRB' , &
                 'SEQ',   'RPC',   'RPC',   'RPS' ,  'SEQ' /
data repx   /      '"',     '(',     '{',     '[' ,    '<' , &
                   '"',     ')',     '}',     ']' ,    '>' /
data lenx   /       0 ,     16 ,      8 ,      8  ,     1  /

data (dndx(i,1),i=1,25)/ &
'102000','031001','000001','000002', &
'110000','031001','000010','000011','000012','000013','000015', &
                  '000016','000017','000018','000019','000020', &
'107000','031001','000010','000011','000012','000013','101000', &
                  '031001','000030'/

data (dndx(i,2),i=1,15)/ &
'103000','031001','000001','000002','000003', &
'101000','031001','300004', &
'105000','031001','300003','205064','101000','031001','000030'/

data ndndx /  25 ,  15 , 8*0 /
data nldxa /  35 ,  67 , 8*0 /
data nldxb /  80 , 112 , 8*0 /
data nldxd /  38 ,  70 , 8*0 /
data nld30 /   5 ,   6 , 8*0 /

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

!  Initialize /ENDORD/ to control output blocking -1=LE 0=NONE +1=BE
!  -----------------------------------------------------------------

iblock = 0

!  Initialize module BITBUF
!  ------------------------

maxbyt = min(10000,mxmsgl)

!  Initialize module H4WLC
!  -----------------------

nh4wlc = 0

!  Initialize /MAXCMP/
!  -------------------

maxcmb = maxbyt
maxrow = 0
maxcol = 0
ncmsgs = 0
ncsubs = 0
ncbyts = 0

!  Initialize /PADESC/
!  -------------------

ibct = ifxy('063000')
ipd1 = ifxy('102000')
ipd2 = ifxy('031001')
ipd3 = ifxy('206001')
ipd4 = ifxy('063255')

!  Initialize module STBFR
!  -----------------------

do i=1,nfiles
  iolun(i) = 0
  iomsg(i) = 0
enddo

!  Initialize module IDRDM
!  -----------------------

do i=1,nfiles
  idrdm(i) = 0
enddo

!  Initialize module MSGLIM
!  ------------------------

do i=1,nfiles
  msglim(i) = 3
enddo

!  Initialize module USRINT
!  ------------------------

do i=1,nfiles
  nval(i) = 0
enddo

!  Initialize /REPTAB/
!  -------------------

do i=1,5
  lens(i) = lenx(i)
  do j=1,2
    idnr(i,j) = ifxy(adsn(i,j))
    typs(i,j) = typx(i,j)
    reps(i,j) = repx(i,j)
  enddo
enddo

!  Initialize TABABD (internal arrays holding dictionary table)
!  ------------------------------------------------------------

!    NTBA(0) is the maximum number of entries w/i internal BUFR table A

ntba(0) = maxtba

!    NTBB(0) is the maximum number of entries w/i internal BUFR Table B

ntbb(0) = maxtbb

!    NTBD(0) is the maximum number of entries w/i internal BUFR Table D

ntbd(0) = maxtbd

!  Initialize /DXTAB/
!  ------------------

maxdx = maxbyt
!  .... IDXV is the version number of the local tables
idxv  = 1

do j=1,10
  ldxa(j)  = nldxa(j)
  ldxb(j)  = nldxb(j)
  ldxd(j)  = nldxd(j)
  ld30(j)  = nld30(j)
  dxstr(j) = '      '
  nxstr(j) = ndndx(j)*2
  do i=1,ndndx(j)
    i1 = i*2-1
    call ipkm(dxstr(j)(i1:i1),2,ifxy(dndx(i,j)))
  enddo
enddo

!  Initialize module TABLES
!  ------------------------

maxtab = maxjl

!  Initialize module BUFRMG
!  ------------------------

do i=1,nfiles
  msglen(i) = 0
enddo

!  Initialize /MRGCOM/
!  -------------------

nrpl = 0
nmrg = 0
namb = 0
ntot = 0

!  Initialize /DATELN/
!  -------------------

if(lendat.ne.10) lendat = 8

!  Initialize /ACMODE/
!  -------------------

iac = 0

!  Initialize module BUFRSR
!  ------------------------

do i=1,nfiles
  jsr(i) = 0
enddo

!  Initialize /DSCACH/
!  -------------------

ncnem = 0

!  Initialize /MSGSTD/
!  -------------------

csmf = 'N'

!  Initialize /MSGCMP/
!  -------------------

ccmf = 'N'

!  Initialize /TABLEF/
!  -------------------

cdmf = 'N'

!  Initialize /TNKRCP/
!  -------------------

ctrt = 'N'

!  Initialize /MSTINF/
!  -------------------

cmtdir = &
'/gpfs/dell2/emc/obsproc/noscrub/Jeff.Ator/NCEPLIBS-bufr-GitHub/build/install/tables'
call mtinfo(cmtdir,98,99)

return
end