SUBROUTINE BFRIZE ( luntbl, lunbfr, sbset, iyr, imn, idy, ihr,
+ seqnam, seqflg, nseq, lvlwise, data, nlvl,
+ clist, npp, wrkd, iret)
C************************************************************************
C* BFRIZE *
C* *
C* This subroutine calls Jack Woollen's BUFR encoding routines to *
C* write a BUFR message to an output file. SBSET is the Mnemonic *
C* for the TABLE A entry associated with this message. It appears *
C* in the table referenced by LUNTBL. If LUNTBL = 0, the output *
C* BUFR file is closed. *
C* *
C* The data in the array DATA are ordered according to the individual *
C* elements of the Sequences given in SEQNAM. The contents of SEQNAM *
C* and SEQFLG and, consequently of DATA, are determined by the BUFR *
C* table file referenced by LUNTBL. Each entry in SEQNAM has a list of *
C* parameters associated with it in the table. This list is read from *
C* the table and the number of parameters is determined. This *
C* information is stored in CLIST and NPP for future calls to BFRIZE. *
C* If the parameters associated with the entry in SEQNAM exist on NLVL *
C* levels, the corresponding array element of SEQFLG must be .true.; *
C* otherwise, it is .false. NLVL is an integer array with an entry *
C* corresponding to each .true. entry in SEQFLG. *
C* *
C* Profile data in array DATA may be stored such that contiguous *
C* elements are values of different parameters on the same level *
C* (parameter-wise storage) or the same parameter on different levels *
C* (level-wise storage). If LVLWISE=.false. parameter-wise storage *
C* is assumed; otherwise, LVLWISE=.true. and level-wise storage is *
C* assumed. If there is more than one multi-level (replicated) *
C* sequence, LVLWISE applies to each one of them. *
C* *
C* The example below shows the contents of SEQNAM, SEQFLG, and DATA *
C* for a case when NLVL=3, LVLWISE=.true., and the table file has the *
C* following entries for the Mnemonic Sequences: *
C* *
C* MNEMONIC | SEQUENCE *
C* *
C* MODELOUT | HDR {PROF} SFC *
C* HDR | RLAT RLON *
C* PROF | PRES TMPK *
C* SFC | PMSL PRCP *
C* *
C* SEQNAM and SEQFLG have the following assigned entries: *
C* *
C* INDEX SEQNAM SEQFLG *
C* 1 HDR .false. *
C* 2 PROF .true. *
C* 3 SFC .false. *
C* *
C* DATA must contain the following values in this order: *
C* *
C* DATA (1) = rlat DATA (6) = tmpk (1) *
C* DATA (2) = rlon DATA (7) = tmpk (2) *
C* DATA (3) = pres (1) DATA (8) = tmpk (3) *
C* DATA (4) = pres (2) DATA (9) = pmsl *
C* DATA (5) = pres (3) DATA (10) = prcp *
C* *
C* The lower-case names above signify numerical values of the *
C* parameters. The values of multiple level parameters are stored *
C* contiguously. *
C* *
C* To add a new output parameter, update the table file by adding the *
C* Mnemonic for the parameter to an existing Sequence or by adding *
C* a new Sequence. If a new Sequence has been added, SEQNAM and *
C* SEQFLG must be updated accordingly. In any case, the new output *
C* parameter value must be placed in the correct position within the *
C* array DATA. *
C* *
C* CLIST contains the lists of parameter names for each element of *
C* SEQNAM. If CLIST (1) is blank, BFRHDR is called with SEQNAM and *
C* SEQFLG as inputs to load the names of the parameters into CLIST; *
C* otherwise, the names in CLIST are used. For every element of *
C* SEQNAM there is a corresponding element of CLIST. For each element *
C* of CLIST, there is a corresponding element of NPP giving the number *
C* of parameter names in the list. *
C* *
C* DATA (i) = 10.E+10 is the missing value. *
C* *
C* WRKD is a scratch array and should be dimensioned the same size as *
C* data. WRKD is not used if LVLWISE=.false. *
C* *
C* BFRIZE ( LUNTBL, LUNBFR, SBSET, IYR, IMN, IDY, IHR, *
C* SEQNAM, SEQFLG, NSEQ, LVLWISE, DATA, NLVL, CLIST, NPP, *
C* WRKD, IRET ) *
C* *
C* Input parameters: *
C* LUNTBL INTEGER Unit number of BUFR Table file *
C* LUNBFR INTEGER Unit number of BUFR data file *
C* SBSET CHAR* BUFR subset name *
C* IYR INTEGER 2-digit year *
C* IMN INTEGER 2-digit month *
C* IDY INTEGER 2-digit day *
C* IHR INTEGER 2-digit cycle hour *
C* SEQNAM (NSEQ) CHAR* Mnemonic Sequence names *
C* SEQFLG (NSEQ) LOGICAL Multi-level flag *
C* NSEQ INTEGER Number of Sequence names & flags*
C* LVLWISE LOGICAL Level-wise profile data flag *
C* DATA (*) REAL*8 Data array *
C* NLVL (*) INTEGER Number of levels/replications *
C* *
C* Input and Output parameters: *
C* CLIST (NSEQ) CHAR* Parameter name lists *
C* NPP (NSEQ) INTEGER Number of parameter names *
C* *
C* Output parameters: *
C* WRKD (*) REAL*8 Array of reordered profile data *
C* IRET INTEGER Return code *
C* 0 = normal return *
C** *
C* Log: *
C* K. Brill/NMC 05/94 *
C* K. Brill/NMC 06/94 Added LVLWISE, CLIST, NPP, WRKD *
C* K. Brill/EMC 5/97 Make NLVL an array for other replication*
C************************************************************************
REAL*8 data (*)
INTEGER npp (*), nlvl (*)
CHARACTER*(*) seqnam (*), sbset
LOGICAL seqflg (*), lvlwise
CHARACTER*(*) clist (*)
REAL*8 wrkd (*)
C-----------------------------------------------------------------------
iret = 0
C
C* Close BUFR file if LUNTBL = 0.
C
IF ( luntbl .eq. 0 ) THEN
CALL CLOSBF ( lunbfr )
RETURN
END IF
C
C* Check the status of the output BUFR file.
C
CALL STATUS ( lunbfr, lun, iopn, imm )
IF ( iopn .eq. 0 ) THEN
CALL OPENBF ( lunbfr, 'OUT', luntbl )
CALL DATELEN ( 10 )
END IF
C
C* Open a new message.
C
idate = iyr * 1000000 + imn * 10000 + idy * 100 + ihr
CALL OPENMB ( lunbfr, sbset, idate )
C
C* Create the parameter name lists if CLIST (1) is blank.
C
IF ( clist (1) .eq. ' ' ) THEN
DO is = 1, nseq
CALL BFRHDR ( luntbl, seqnam (is), seqflg (is),
+ clist (is), npp (is), iret )
IF ( iret .ne. 0 ) RETURN
END DO
END IF
C
C* Load the sequences.
C
idpntr = 1
indxlv = 0
DO is = 1, nseq
np = npp (is)
IF ( seqflg (is) ) THEN
indxlv = indxlv + 1
IF ( lvlwise ) THEN
C
C* This is level-wise multi-level data.
C
istrt = idpntr
indx = 0
DO k = 1, nlvl (indxlv)
DO ip = 1, np
indx = indx + 1
wrkd ( indx ) =
+ data ( istrt + (ip-1) * nlvl (indxlv) )
END DO
istrt = istrt + 1
END DO
CALL UFBINT ( lunbfr, wrkd, np, nlvl (indxlv),
+ irtrn, clist (is) )
ELSE
C
C* This is parameter-wise multi-level data.
C
CALL UFBINT ( lunbfr, data (idpntr), np,
+ nlvl (indxlv), irtrn, clist (is) )
END IF
idpntr = idpntr + np * nlvl (indxlv)
ELSE
C
C* This is single-level data.
C
CALL UFBINT ( lunbfr, data (idpntr),
+ np, 1, irtrn, clist (is) )
idpntr = idpntr + np
END IF
END DO
CALL WRITSB ( lunbfr )
C*
RETURN
END