SUBROUTINE BT_IFSP ( rimnem, cimnem, iret ) C************************************************************************ C* BT_IFSP * C* * C* This subroutine initializes the interface mnemonic arrays and sets * C* the pointers within COMMON / RINTFP / and COMMON / CINTFP /. * C* * C* BT_IFSP ( RIMNEM, CIMNEM, IRET ) * 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* R. Hollern/NCEP 11/98 Adapted from MA_IFSP * C* R. Hollern/NCEP 1/99 Added initialization of interface * C* mnemonics and added interface mnemonics * C* to calling sequence * C* R. Hollern/NCEP 2/99 Added trackob interface mnemonics * C* R. Hollern/NCEP 4/00 Removed mnemonics CORN and BPID * C* R. Hollern/NCEP 8/00 Added date/time interface mnemonics * C* J. Ator/NCEP 01/02 SUWS -> IUWS * C* C. Caruso Magee/NCEP 02/02 Rename DOCW to DROC * C* C. Caruso Magee/NCEP 02/02 Add UCSP. * C* C. Caruso Magee/NCEP 03/02 Add MRMV, DTCC, POCM. * C* C. Caruso Magee/NCEP 03/02 Add separate code to initialize * C* multi-lev current data. * C* C. Caruso Magee/NCEP 01/06 Replace iryear with irydgt. * C* J. Ator/NCEP 02/06 IWTP->IWTM, WTPR->WTMR C************************************************************************ INCLUDE 'btcmn.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' , 'YDGT' , 'MNTH' , + 'DAYS' , 'HOUR' , 'MINU' , 'IUWS' , 'DRCT' , + 'SPED' , 'TMPC' , 'IDGT' , 'IWTM' , 'WTMR' , + 'SSTC' , 'TOWD' , 'MCMS' , 'MSDM' , 'UCSP' , + 'MRMV' , 'POCM' , 'DTCC' / C* DATA ( rifmn (i), i = NRSLMN+1, MNNN ) / + 'NDTS' , 'DBSS' , 'STMP' , 'SALN', + MDM1P3 * ' ' / C* DATA ( rifmn (i), i = MNNN+1 , MNNO ) / + 'NDDC' , 'DBSC' , 'DROC' , 'SPOC', + MCM1P3 * ' ' / C* DATA ( rifmn (i), i = MNNO+1 , NRIMN ) / + 'NTRK' , 'AVGP', + MTM1P1 * ' ' / C* C* Character interface mnemonics C* DATA ( cifmn(i), i = 1,NCIMN) / 'STID' / C* 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 C* will 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 depth, temperature, and salinity C* from a bathy or a tesac report. C CALL DC_IFFP ( 'NDTS', rimnem, NRIMN, allok, irndts, ier ) CALL DC_IFFP ( 'DBSS', rimnem, NRIMN, allok, irdbss (1), ier ) CALL DC_IFMP ( 3, MXDLYR, irdbss, ier ) CALL DC_IFFP ( 'STMP', rimnem, NRIMN, allok, irstmp (1), ier ) CALL DC_IFMP ( 3, MXDLYR, irstmp, ier ) CALL DC_IFFP ( 'SALN', rimnem, NRIMN, allok, irsaln (1), ier ) CALL DC_IFMP ( 3, MXDLYR, irsaln, ier ) C C* Set the pointers for depth, direction, and speed of current C* from a bathy or a tesac report. C CALL DC_IFFP ( 'NDDC', rimnem, NRIMN, allok, irnddc, ier ) CALL DC_IFFP ( 'DBSC', rimnem, NRIMN, allok, irdbsc (1), ier ) CALL DC_IFMP ( 3, MXDLYR, irdbsc, ier ) CALL DC_IFFP ( 'DROC', rimnem, NRIMN, allok, irdroc (1), ier ) CALL DC_IFMP ( 3, MXDLYR, irdroc, ier ) CALL DC_IFFP ( 'SPOC', rimnem, NRIMN, allok, irspoc (1), ier ) CALL DC_IFMP ( 3, MXDLYR, irspoc, ier ) C C* Set the pointers for averaging period, temperature, salinity, C* and direction and speed of current from a trackob report. C CALL DC_IFFP ( 'NTRK', rimnem, NRIMN, allok, irntrk, ier ) CALL DC_IFFP ( 'AVGP', rimnem, NRIMN, allok, iravgp (1), ier ) CALL DC_IFMP ( 1, TRKAVP, iravgp, ier ) C* C* Were all of the pointers properly set? C IF ( .not. allok ) THEN iret = -1 END IF C* RETURN END