SUBROUTINE MA_IFPT ( rimnem, cimnem, iret ) C************************************************************************ C* MA_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* MA_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* D. Kidwell/NCEP 10/97 Adapted from AF_IFPT * C* D. Kidwell/NCEP 5/98 Call DC_IFPC, DC_IFPR, 'MA' -> 'DC' in * C* WLOG calls * C* D. Kidwell/NCEP 10/98 Added intf mnemonics to calling sequence* C* R. Hollern/NCEP 1/99 Set verbosity level to 3 * C* R. Hollern/NCEP 7/99 Got report obs time from interface array* C* R. Hollern/NCEP 11/99 Modified cloud data print logic. Added * C* supplementary wind data print logic. * C* Added the precipitation print logic. * C* R. Hollern/NCEP 11/99 Removed the logic to print drifting * C* buoy data * C* R. Hollern/NCEP 2/00 Removed the code to print raw report * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'macmn.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 cloud level data. C IF ( rivals ( irnclo ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 6A10 )' ) + rimnem ( irnclo ), + rimnem ( irvsso (1) ), rimnem ( irclam (1) ), + rimnem ( ircltp (1) ), rimnem ( irhocb (1) ), + rimnem ( ircsec (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:60), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 6F10.2 )' ) + rivals ( irnclo ), + rivals ( irvsso (1) ), rivals ( irclam (1) ), + rivals ( ircltp (1) ), rivals ( irhocb (1) ), + rivals ( ircsec (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:60), ierwlg ) IF ( rivals ( irnclo ) .gt. 1 ) THEN DO jj = 2, rivals ( irnclo ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 5F10.2 )' ) + rivals ( irvsso ( jj ) ), rivals ( irclam ( jj ) ), + rivals ( ircltp ( jj ) ), rivals ( irhocb ( jj ) ), + rivals ( ircsec ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:60), + ierwlg ) END DO END IF END IF C C* Print the precipitation data. C IF ( rivals ( irnpcv ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 3A10 )' ) + rimnem ( irnpcv ), + rimnem ( irpprd (1) ), rimnem ( irpamt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 3F10.2 )' ) + rivals ( irnpcv ), + rivals ( irpprd (1) ), rivals ( irpamt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), ierwlg ) IF ( rivals ( irnpcv ) .gt. 1 ) THEN DO jj = 2, rivals ( irnpcv ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 2F10.2 )' ) + rivals ( irpprd ( jj ) ), rivals ( irpamt ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:30), + ierwlg ) END DO END IF END IF C C* Print the supplementary wind data. C IF ( rivals ( irnspw ) .gt. 0 ) THEN WRITE ( UNIT = logmsg, FMT = '( 4A10 )' ) + rimnem ( irnspw ), + rimnem ( irspwp (1) ), rimnem ( irspws (1) ), + rimnem ( irspwt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 4F10.2 )' ) + rivals ( irnspw ), + rivals ( irspwp (1) ), rivals ( irspws (1) ), + rivals ( irspwt (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), ierwlg ) IF ( rivals ( irnspw ) .gt. 1 ) THEN DO jj = 2, rivals ( irnspw ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 4F10.2 )' ) + rivals ( irspwp ( jj ) ), rivals ( irspws ( jj ) ), + rivals ( irspwt ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:40), + ierwlg ) END DO END IF END IF C C* Print continuous wind data. C IF ( rivals ( irncwd ) .gt. 0 ) THEN C WRITE ( UNIT = logmsg, FMT = '( 4A10 )' ) + rimnem ( irncwd ), + rimnem ( irtpmi (1) ), + rimnem ( irwdrc (1) ), rimnem ( irwdsc (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 4F10.2 )' ) + rivals ( irncwd ), + rivals ( irtpmi (1) ), + rivals ( irwdrc (1) ), rivals ( irwdsc (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) C IF ( rivals ( irncwd ) .gt. 1 ) THEN DO jj = 2, rivals ( irncwd ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 3F10.2 )' ) + rivals ( irtpmi ( jj ) ), + rivals ( irwdrc ( jj ) ), rivals ( irwdsc ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) END DO END IF C END IF C C* Print wave data. C IF ( rivals ( irnswv ) .gt. 0 ) THEN C WRITE ( UNIT = logmsg, FMT = '( 4A10 )' ) + rimnem ( irnswv ), + rimnem ( irdosw (1) ), + rimnem ( irposw (1) ), rimnem ( irhosw (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) WRITE ( UNIT = logmsg, FMT = '( 4F10.2 )' ) + rivals ( irnswv ), + rivals ( irdosw (1) ), + rivals ( irposw (1) ), rivals ( irhosw (1) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) C IF ( rivals ( irnswv ) .gt. 1 ) THEN DO jj = 2, rivals ( irnswv ) WRITE ( UNIT = logmsg, + FMT = '( 10X, 3F10.2 )' ) + rivals ( irdosw ( jj ) ), + rivals ( irposw ( jj ) ), rivals ( irhosw ( jj ) ) CALL DC_WLOG ( loglvl, 'DC', 2, logmsg (1:50), ierwlg ) END DO END IF C END IF C* RETURN END