SUBROUTINE MA_IFSP ( rimnem, cimnem, iret ) C************************************************************************ C* MA_IFSP * C* * C* This subroutine initializes the interface mnemonic arrays and sets * C* the pointers within COMMON / RINTFP / and COMMON / CINTFP /. * C* * C* MA_IFSP ( RIMNEM, CIMNEM, IRET ) * C* * C* Output parameters: * C* RIMNEM (*) CHAR* Interface mnemonics for reals * C* CIMNEM (*) CHAR* Interface mnemonics for chars * 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 12/97 Replaced MA_IFFP, MA_IFMP calls with DC_* C* D. Kidwell/NCEP 10/98 Added init of interface mnemonics; * C* added intf mnemonics to calling sequence* C* R. Hollern/NCEP 7/99 Added 24 more mnemonics * C* R. Hollern/NCEP 9/99 Added mnemonics for section 4 data in * C* drifting buoy report * C* R. Hollern/NCEP 11/99 Removed the Section 1 and 3 cloud mnems.* C* Added supplementary wind mnemonics. * C* R. Hollern/NCEP 11/99 Removed the drifting buoy logic * C* R. Hollern/NCEP 2/00 Removed the MSDM and BPID mnemonics * C* R. Hollern/NCEP 3/00 Removed the CORN mnemonic * C* J. Ator/NCEP 01/02 SUWS -> ISWS, remove old PXXM from/INTF/* C* C. Caruso Magee/NCEP 01/02 Add HBLCS * C* C. Caruso Magee/NCEP 02/04 Remove DTVFM (obsolete), add TLLW * C************************************************************************ INCLUDE 'macmn.cmn' C* CHARACTER*(*) rimnem (*), cimnem (*) 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), iryear ) C* DATA ( rifmn (i), i = 1, NRSLMN ) / + 'YEAR' , 'MNTH' , 'DAYS' , 'HOUR' , 'MINU' , + 'SLAT' , 'SLON' , 'SELV' , 'DRCT' , 'SPED' , + 'XS10' , 'XS20' , 'PRES' , 'PMSL' , 'P03D' , + 'CHPT' , '3HPC' , 'RELH' , 'MSST' , 'STMWC' , + 'TMPC' , 'DWPC' , 'SSTC' , 'TMWC' , 'DTFV1' , + 'MXTM' , 'DTFV2' , 'MITM' , + 'INPC' , 'ITSO' , 'TOST' , 'VSBK' , 'CFRT' , + 'PWPD' , 'WWMO' , 'WWMA' , 'PWWM' , 'PWWA' , + 'PSW2' , 'TDMP' , 'ASMP' , 'WPER' , 'POWW' , + 'HOWW' , 'COIA' , 'IDTH' , 'ROIA' , '24PC' , + 'PWYR' , 'PWMO' , 'PWDY' , 'PWHR' , 'PWMN' , + 'PWDR' , 'PWSP' , 'WHGT' , 'ISWS' , 'PWA2' , + 'VRTM' , 'HBLCS' , 'TLLW'/ C* DATA ( rifmn (i), i = NRSLMN+1, NRIMN ) / + 'NCLO' , 'VSSO' , 'CLAM' , 'CLTP' , 'HOCB' , + 'CSEC' , MCM1T5 * ' ' , + 'NCWD' , 'TPMI' , 'WDRC' , 'WDSC' , + MWM1T3 * ' ', + 'NSWV' , 'DOSW' , 'POSW' , 'HOSW' , + MSM1T3 * ' ', + 'NSPW' , 'SPWP' , 'SPWS' , 'SPWT' , + MSPWT3 * ' ', + 'NPCV' , 'PPRD' , 'PAMT' , + MPCVT1 * ' '/ C* Real interface mnemonics. C* DATA ( cifmn (i), i = 1, NCIMN ) / 'STID' / C* Character interface mnemonics. C----------------------------------------------------------------------- iret = 0 C C* Initialize the interface mnemonics. C DO i = 1, NRIMN rimnem ( i ) = rifmn ( i ) END DO 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 ( 5, MXCLYR, irvsso, ier ) CALL DC_IFFP ( 'CLAM', rimnem, NRIMN, allok, irclam (1), ier ) CALL DC_IFMP ( 5, MXCLYR, irclam, ier ) CALL DC_IFFP ( 'CLTP', rimnem, NRIMN, allok, ircltp (1), ier ) CALL DC_IFMP ( 5, MXCLYR, ircltp, ier ) CALL DC_IFFP ( 'HOCB', rimnem, NRIMN, allok, irhocb (1), ier ) CALL DC_IFMP ( 5, MXCLYR, irhocb, ier ) CALL DC_IFFP ( 'CSEC', rimnem, NRIMN, allok, ircsec (1), ier ) CALL DC_IFMP ( 5, 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 continuous wind data. C CALL DC_IFFP ( 'NCWD', rimnem, NRIMN, allok, irncwd, ier ) CALL DC_IFFP ( 'TPMI', rimnem, NRIMN, allok, irtpmi (1), ier ) CALL DC_IFMP ( 3, MXWLYR, irtpmi, ier ) CALL DC_IFFP ( 'WDRC', rimnem, NRIMN, allok, irwdrc (1), ier ) CALL DC_IFMP ( 3, MXWLYR, irwdrc, ier ) CALL DC_IFFP ( 'WDSC', rimnem, NRIMN, allok, irwdsc (1), ier ) CALL DC_IFMP ( 3, MXWLYR, irwdsc, 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