bfrini.f90

Go to the documentation of this file.

 
 
subroutine bfrini
 
USE modv_maxjl
USE modv_maxtba
USE modv_maxtbb
USE modv_maxtbd
USE modv_mxmsgl
USE modv_nfiles
 
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 = &
'/home/jeffa/build/install/tables'
call mtinfo(cmtdir,98,99)
 
return
end