SUBROUTINE BT_IFPT ( rimnem, cimnem, iret ) C************************************************************************ C* BT_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* BT_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 11/98 Adapted from AF_IFPT * C* R. Hollern/NCEP 1/99 Added interface mnemonics to calling * C* sequence * C* R. Hollern/NCEP 3/99 Added code to print TRACKOB reports * C* R. Hollern/NCEP 8/00 Removed code to print the raw report * C* C. Caruso Magee/NCEP 02/02 Rename DOCW to DROC. * C* C. Caruso Magee/NCEP 03/02 Add code to separately print current * C* depth/direction/speed and counter. * C* J. Ator/NCEP 2/06 Clean up * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'btcmn.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 C* Print averaging periods for TRACKOB parameters. C IF ( rivals ( irntrk ) .gt. 0 ) THEN C WRITE ( UNIT = logmsg, FMT = '( 6A10 )' ) + rimnem ( irntrk ), + rimnem ( iravgp (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:60), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 4F10.1 )' ) + rivals ( irntrk ), + rivals ( iravgp (1) ) , rivals ( iravgp (2) ), + rivals ( iravgp (3) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:60), ierwlg ) C END IF C C* Print depth, temperature, and salinity from a bathy, trackob, C* or tesac report. 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:40), 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:40), 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:40), + ierwlg ) END DO END IF C END IF C C* Print depth, direction, and speed of current from a bathy, C* trackob, or tesac report. 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