SUBROUTINE TG_IFPT ( rimnem, cimnem, iret ) C************************************************************************ C* TG_IFPT * C* * C* This subroutine prints the interface values arrays to the decoder * C* log if the verbosity level is 3 or higher. * C* * C* TG_IFPT ( RIMNEM, CIMNEM, IRET ) * C* * C* Input parameters: * C* NRIMN INTEGER Total number of real interface * C* mnemnonics * C* NRSLMN INTEGER Number of real single-level * C* real interface mnemnonics * C* NCIMN INTEGER Total number of character * C* interface mnemnonics * C* RMISSD REAL Missing real data value * C* RIMNEM (*) CHAR* Interface mnemonics for reals * C* CIMNEM (*) CHAR* Interface mnemonics for chars * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = Normal return * C* * C** * C* Log: * C* R. Hollern/NCEP 8/00 * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'tgcmn.cmn' C* CHARACTER*(*) rimnem (*), cimnem (*) C------------------------------------------------------------------------ iret = 0 loglvl = 3 C C* Print all of the single-level character interface values C* that are not missing. C CALL DC_IFPC ( loglvl, cimnem, civals, NCIMN, ierf ) C C* Print all of the single-level real interface values C* that are not missing. C CALL DC_IFPR ( loglvl, rimnem, rivals, NRSLMN, ierf ) C C* Print all of the multi-level interface values. C C* Print the tidal elevation data. C IF ( rivals ( irntid ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 3A10 )' ) + rimnem ( irntid ), + rimnem ( irterc (1) ), rimnem ( irmrte (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( F10.0, 2F10.3 )' ) + rivals ( irntid ), + rivals ( irterc (1) ), rivals ( irmrte (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), ierwlg ) IF ( rivals ( irntid ) .gt. 1 ) THEN DO jj = 2, rivals ( irntid ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 2F10.3 )' ) + rivals ( irterc ( jj ) ), rivals ( irmrte ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), + ierwlg ) END DO END IF END IF C* RETURN END