C----------------------------------------------------------------------- SUBROUTINE CTL_RDR ( lunctl, mxg, kpds, kmdl, kgrd, type, + prcsn, name, ksmpr, ksmpo, kgt, nr, iret ) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: CTL_RDR Reads control file for Product Generator C PRGMMR: BRILL ORG: W/NP22 DATE: 97-07-01 C C ABSTRACT: READS A CONTROL FILE AND RETURNS PDS (9-12,21) VALUES & C MODEL #, GRID #, WMO TYPE FOR EACH GRID TARGETED IN THE C FILE CONNECTED TO LUNCTL. ALSO RETURNS THE PRECISION FOR C PACKING AND THE NUMBER OF SMOOTHING PASSES. C C PROGRAM HISTORY LOG: C C USAGE: CALL CTL_RDR ( LUNCTL, MXG, KPDS, KMDL, KGRD, TYPE, PRCSN, C NAME, KSMPR, KSMPO, KGT, NR, IRET ) C INPUT ARGUMENT LIST: C See below. C C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) C See below. C C ATTRIBUTES: C LANGUAGE: FORTRAN C MACHINE: PORTABLE C C$$$ C************************************************************************ C* CTL_RDR * C* * C* This subroutine reads a product generator control file and returns * C* GRIB PDS elements 9-12, and 21 along with the model numbers, grid * C* numbers, corresponding WMO header types, packing precision numbers * C* for FNDBTS, output file names, and smoothing numbers. * C* * C* Each control file entry consists of a header record followed by a * C* family of output grid specifications. The header consists of PDS * C* elements 9-12, and 21, along with a character string describing the * C* grid. The output grid specifications consist of the following * C* fields separated by slashes: * C* * C* PDS6 - the model ID number * C* GRD# - the grid number * C* WMO - the WMO header type (blank, H, A, X, or combination) * C* SCAL - the precision number for FNDBTS * C* FNAM - the output file name * C* PRSM - the pre-smooth number * C* POSM - the post-smooth number * C* * C* The smoothing numbers may be omitted. If there is only one smooth * C* number, it is assumed to be a pre-smooth number. If there must be * C* a post-smooth number, a pre-smooth number must also be entered, or * C* it may be a single number preceded by two slashes. * C* * C* Here is an exmple of such a control file entry: * C* * C* PDS9 PDS10 PDS11 PDS12 PDS21 description * C* PDS6/###1/HAX/3.3/name1 * C* PDS6/###2/HAX/-3/name2/7/3 * C* PDS6/###3/HAX/2.9/name3//2 * C* PDS6/###4/HAX/-2/name4/2 * C* * C* The control file file is already assumed to be connected to the * C* input unit numbers. * C* * C* CTL_RDR ( LUNCTL, MXG, KPDS, KMDL, KGRD, TYPE, PRCSN, NAME, * C* KSMPR, KSMPO, KGT, NR,IRET ) * C* * C* Input parameters: * C* LUNCTL INTEGER Unit number of control file * C* MXG INTEGER Maximum # of grids per control * C* record * C* * C* Output parameters: * C* KPDS (5, NR) INTEGER PDS elements 9-12, 21 * C* KMDL (MXG,NR) INTEGER Model number for this grid * C* KGRD (MXG,NR) INTEGER Grid numbers for output * C* TYPE (MXG,NR) CHAR*4 Message type string for each * C* grid # in KGRD--one or more of: * C* H = international * C* A = AWIPS * C* X = No header * C* PRCSN (MXG,NR) REAL Precision for packing * C* NAME (MXG,NR) CHAR*16 Output name ID * C* KSMPR (MXG,NR) INTEGER Number of pre-smoothing passes * C* KSMPO (MXG,NR) INTEGER Number of post-smoothing passes * C* KGT (NR) INTEGER Number of grid/type records * C* following each control record * C* NR INTEGER Number of control records read * C* IRET INTEGER Return code * C* 0 = normal return * C* -1 = invalid file entry * C* -2 = misplaced grid/type info * C* -3 = invalid grid/type entry * C* -4 = invalid grid # * C* -5 = invalid precision # * C* -6 = invalid smoothing # * C** * C* Log: * C* K. Brill/EMC 6/97 * C* K. Brill/EMC 8/97 Added KSMO, PRCSN * C* K. Brill/EMC 9/97 Added NAME * C* K. Brill/EMC 10/97 Added KMDL, 2 smo #'s, K6PDS->KPDS * C* G. Manikin/EMC 3/03 Added 2 more elements to KPDS C************************************************************************ CHARACTER*(*) type (mxg,*) CHARACTER*(*) name (mxg,*) INTEGER kpds (7,*), kmdl (mxg,*), kgrd (mxg,*), + ksmpr (mxg,*), ksmpo (mxg,*), kgt (*) REAL prcsn (mxg,*) C* CHARACTER*80 buff CHARACTER*32 carr (10) C------------------------------------------------------------------------ iret = 0 nr = 0 REWIND lunctl iostat = 0 DO WHILE ( iostat .eq. 0 ) READ ( lunctl, '(A)', IOSTAT=iostat ) buff IF ( iostat .eq. 0 ) THEN islsh = INDEX ( buff, '/' ) IF ( islsh .ne. 0 ) THEN IF ( nr .eq. 0 ) THEN iret = -2 RETURN END IF CALL ST_CLST ( buff, '/', '?', 7, carr, num, ier ) IF ( ier .lt. 0 ) THEN iret = -3 RETURN ELSE IF ( carr (1) .eq. '?' .or. + carr (2) .eq. '?' .or. + carr (3) .eq. '?' .or. + carr (4) .eq. '?' .or. + carr (5) .eq. '?' ) THEN iret = -3 RETURN ELSE CALL ST_NUMB ( carr (1), imdl, ier ) CALL ST_NUMB ( carr (2), igrd, ier1 ) ier = ier + ier1 IF ( ier .ne. 0 ) THEN iret = -4 RETURN END IF kgt (nr) = kgt (nr) + 1 kmdl ( kgt(nr), nr ) = imdl kgrd ( kgt(nr), nr ) = igrd type ( kgt(nr), nr ) = carr (3) CALL ST_CRNM ( carr (4), prc, ier ) IF ( ier .ne. 0 ) THEN iret = -5 RETURN END IF prcsn ( kgt(nr), nr ) = prc name ( kgt(nr), nr ) = carr (5) IF ( carr (6) .ne. '?' ) THEN CALL ST_NUMB ( carr (6), ismth, ier ) IF ( ier .ne. 0 ) THEN iret = -6 RETURN ELSE ksmpr ( kgt(nr), nr ) = ismth END IF ELSE ksmpr ( kgt(nr), nr ) = 0 END IF IF ( carr (7) .ne. '?' ) THEN CALL ST_NUMB ( carr (7), ismth, ier ) IF ( ier .ne. 0 ) THEN iret = -6 RETURN ELSE ksmpo ( kgt(nr), nr ) = ismth END IF ELSE ksmpo ( kgt(nr), nr ) = 0 END IF END IF ELSE CALL ST_CLST ( buff, ' ', ' ', 7, carr, num, ier ) IF ( ier .lt. 0 .or. num .lt. 7 ) THEN iret = - 1 ELSE nr = nr + 1 kgt (nr) = 0 kmdl (1,nr) = 0 kgrd (1,nr) = 0 type (1,nr) = ' ' DO i = 1, 7 CALL ST_NUMB ( carr (i), kpds (i,nr), ier ) END DO END IF END IF END IF END DO C* RETURN END