SUBROUTINE DB_IFPT ( rimnem, cimnem, iret ) C************************************************************************ C* DB_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* DB_IFPT ( RIMNEM, CIMNEM, IRET ) * C* * C* Input parameters: * 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 12/99 * C* C. Caruso Magee/NCEP 01/2000 Remove print statements for * C* multi-level wave data. * C* C. Caruso Magee/NCEP 02/2000 Remove print of raw report. * C* C. Caruso Magee/NCEP 02/2000 Move 2 logmsg prints to main. * C* C. Caruso Magee/NCEP 03/2000 Remove ref to logtim (not used) * C* C. Caruso Magee/NCEP 12/2002 Add code to print multi-lev * C* current data. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'dbcmn.cmn' C* CHARACTER*(*) rimnem ( NRIMN ), cimnem ( NCIMN ) 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* Print depth, temperature, and salinity. C IF ( rivals ( irndts ) .gt. 0 ) THEN C WRITE ( UNIT = logmsg, FMT = '( 4A10 )' ) + rimnem ( irndts ), + rimnem ( irdbss (1) ), + rimnem ( irstmp (1) ), rimnem ( irsaln (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 4F10.2 )' ) + rivals ( irndts ), + rivals ( irdbss (1) ), + rivals ( irstmp (1) ), rivals ( irsaln (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) C IF ( rivals ( irndts ) .gt. 1 ) THEN DO jj = 2, rivals ( irndts ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 3F10.2 )' ) + rivals ( irdbss ( jj ) ), + rivals ( irstmp ( jj ) ), rivals ( irsaln ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), + ierwlg ) END DO END IF C END IF C C* Print depth, direction, and speed of current. C IF ( rivals ( irnddc ) .gt. 0 ) THEN C WRITE ( UNIT = logmsg, FMT = '( 4A10 )' ) + rimnem ( irnddc ), + rimnem ( irdbsc (1) ), + rimnem ( irdroc (1) ), rimnem ( irspoc (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 4F10.2 )' ) + rivals ( irnddc ), + rivals ( irdbsc (1) ), + rivals ( irdroc (1) ), rivals ( irspoc (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), ierwlg ) C IF ( rivals ( irnddc ) .gt. 1 ) THEN DO jj = 2, rivals ( irnddc ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 3F10.2 )' ) + rivals ( irdbsc ( jj ) ), + rivals ( irdroc ( jj ) ), rivals ( irspoc ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), + ierwlg ) END DO END IF C END IF C* RETURN END