SUBROUTINE LS_IFSP ( rimnem, cimnem, iret ) C************************************************************************ C* LS_IFSP * C* * C* This subroutine sets the pointers within COMMON / RINTFP / and * C* COMMON / CINTFP /. * C* * C* LS_IFSP ( RIMNEM, CIMNEM, IRET ) * C* * C* Input parameters: * C* NRSLMN INTEGER Number of real single-level * C* interface mnemonics * C* NCIMN INTEGER Number of char interface * C* mnemonics * C* NRIMN INTEGER Number of real interface * C* mnemonics * C* RIMNEM (*) REAL Real interface mnemonics array * C* CIMNEM (*) CHAR* Char interface mnemonics array * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = normal return * C* -1 = One or more pointers * C* could not be set * C* * C** * C* Log: * C* D. Kidwell/NCEP 10/97 Adapted from AF_IFSP * C* R. Hollern/NCEP 01/98 Changes based on MA_IFSP * C* A. Hardy/GSC 01/98 Added GEMINC * C* R. Hollern/NCEP 01/99 Initialized interface mnemonics and * C* added interface mnemonic arrays to * C* calling sequence * C* R. Hollern/NCEP 08/99 Added more mnemonics to rifmn array * C* R. Hollern/NCEP 01/00 Removed the Section 1 and 3 cloud mnems;* C* Added supplementary wind mnemonics; * C* Added new precipitation data multi-layer* C* interface variable set * C* R. Hollern/NCEP 04/00 Removed mnemonics CORN, CBAS, WMOB, * C* WMOS, XS10, and XS20. Replaced SOGR with* C* SGR1 and SGR2. * C* J. Ator/NCEP 01/02 SUWS -> ISWS, remove old PXXM from/INTF/* C* C. Caruso Magee/NCEP 01/02 Add HBLCS * C* R. Hollern/NCEP 08/02 Added mnemonics QCEVR, MRSQ * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER rimnem ( NRIMN )*8, cimnem ( NCIMN )*8 C* LOGICAL allok INTEGER iploc (NRSLMN) CHARACTER rifmn ( NRIMN )*8, cifmn ( NCIMN )*8 C* C* Establish array equivalence to COMMON / RINTFP / C* EQUIVALENCE ( iploc (1), irslat ) C* C* Real interface mnemonics. C* DATA ( rifmn (i), i = 1, NRSLMN ) / + 'SLAT' , 'SLON' , 'SELV' , 'YEAR' , 'MNTH' , + 'DAYS' , 'HOUR' , 'MINU' , 'DRCT' , 'SPED' , + 'PRES' , 'PMSL' , 'P03D' , 'CHPT' , '3HPC' , + 'RELH' , 'MSST' , 'STMWC' , 'TMPC' , 'DWPC' , + 'SSTC' , 'TMWC' , 'DTFV1' , 'MXTM' , 'DTFV2' , + 'MITM' , 'GEOP' , 'ISOB' , 'INPC' , 'ITSO' , + 'TOST' , 'VSBK' , 'CFRT' , 'PWPD' , 'WWMO' , + 'WWMA' , 'PWWM' , 'PWWA' , 'PWA2' , 'PSW2' , + 'DOFS' , 'DHFS' , 'SNOWCM', 'CTTP' , 'CTMX' , + 'CTMN' , 'CTP24' , 'WPER' , 'POWW' , 'HOWW' , + 'COIA' , 'IDTH' , 'ROIA' , '24PC' , 'PWYR' , + 'PWMO' , 'PWDY' , 'PWHR' , 'PWMN' , 'PWDR' , + 'PWSP' , 'WHGT' , 'ISWS' , 'VRTM' , 'SGR1' , + 'SGR2' , 'HBLCS' , 'MRSQ' , 'QCEVR'/ C* DATA ( rifmn (i), i = NRSLMN+1, NRIMN ) / + 'NCLO' , 'VSSO' , 'CLAM' , 'CLTP' , 'HOCB' , + 'CTDS' , 'HOCT' , 'CSEC' , + MCM1T7 * ' ' , + 'NSWV' , 'DOSW' , 'POSW' , 'HOSW' , + MSM1T3 * ' ' , + 'NSPW' , 'SPWP' , 'SPWS' , 'SPWT' , + MSPWT3 * ' ' , + 'NPCV' , 'PPRD' , 'PAMT' , + MPCVT1 * ' '/ C* C* Character interface mnemonics. C* DATA ( cifmn (i), i = 1, NCIMN ) / 'STID' / C----------------------------------------------------------------------- iret = 0 C DO i = 1, NRIMN rimnem ( i ) = rifmn ( i ) END DO C DO i = 1, NCIMN cimnem ( i ) = cifmn ( i ) END DO C C* The logical variable "allok" is initially set to .true. but will C* be reset to .false. if any of the pointers cannot be set. C allok = .true. C C* Set the pointers for the single-level interface mnemonics. C DO i = 1, NRSLMN CALL DC_IFFP ( rimnem ( i ), rimnem, NRIMN, allok, + iploc ( i ), ier ) END DO C CALL DC_IFFP ( 'STID', cimnem, NCIMN, allok, icstid, ier ) C C* Set the pointers for cloud data. C CALL DC_IFFP ( 'NCLO', rimnem, NRIMN, allok, irnclo, ier ) CALL DC_IFFP ( 'VSSO', rimnem, NRIMN, allok, irvsso (1), ier ) CALL DC_IFMP ( 7, MXCLYR, irvsso, ier ) CALL DC_IFFP ( 'CLAM', rimnem, NRIMN, allok, irclam (1), ier ) CALL DC_IFMP ( 7, MXCLYR, irclam, ier ) CALL DC_IFFP ( 'CLTP', rimnem, NRIMN, allok, ircltp (1), ier ) CALL DC_IFMP ( 7, MXCLYR, ircltp, ier ) CALL DC_IFFP ( 'HOCB', rimnem, NRIMN, allok, irhocb (1), ier ) CALL DC_IFMP ( 7, MXCLYR, irhocb, ier ) CALL DC_IFFP ( 'CTDS', rimnem, NRIMN, allok, irctds (1), ier ) CALL DC_IFMP ( 7, MXCLYR, irctds, ier ) CALL DC_IFFP ( 'HOCT', rimnem, NRIMN, allok, irhoct (1), ier ) CALL DC_IFMP ( 7, MXCLYR, irhoct, ier ) CALL DC_IFFP ( 'CSEC', rimnem, NRIMN, allok, ircsec (1), ier ) CALL DC_IFMP ( 7, MXCLYR, ircsec, ier ) C C* Set the pointers for precipitation data. C CALL DC_IFFP ( 'NPCV', rimnem, NRIMN, allok, irnpcv, ier ) CALL DC_IFFP ( 'PPRD', rimnem, NRIMN, allok, irpprd(1), ier ) CALL DC_IFMP ( 2, MXPCVL, irpprd, ier ) CALL DC_IFFP ( 'PAMT', rimnem, NRIMN, allok, irpamt(1), ier ) CALL DC_IFMP ( 2, MXPCVL, irpamt, ier ) C C* Set the pointers for wave data. C CALL DC_IFFP ( 'NSWV', rimnem, NRIMN, allok, irnswv, ier ) CALL DC_IFFP ( 'DOSW', rimnem, NRIMN, allok, irdosw (1), ier ) CALL DC_IFMP ( 3, MXSLYR, irdosw, ier ) CALL DC_IFFP ( 'POSW', rimnem, NRIMN, allok, irposw (1), ier ) CALL DC_IFMP ( 3, MXSLYR, irposw, ier ) CALL DC_IFFP ( 'HOSW', rimnem, NRIMN, allok, irhosw (1), ier ) CALL DC_IFMP ( 3, MXSLYR, irhosw, ier ) C C* Set the pointers for supplementary wind data. C CALL DC_IFFP ( 'NSPW', rimnem, NRIMN, allok, irnspw, ier ) CALL DC_IFFP ( 'SPWP', rimnem, NRIMN, allok, irspwp (1), ier ) CALL DC_IFMP ( 3, MXSPWL, irspwp, ier ) CALL DC_IFFP ( 'SPWS', rimnem, NRIMN, allok, irspws (1), ier ) CALL DC_IFMP ( 3, MXSPWL, irspws, ier ) CALL DC_IFFP ( 'SPWT', rimnem, NRIMN, allok, irspwt (1), ier ) CALL DC_IFMP ( 3, MXSPWL, irspwt, ier ) C C* Were all of the pointers properly set? C IF ( .not. allok ) THEN iret = -1 END IF C* RETURN END