SUBROUTINE UA_PMPR ( field, prsdat, nprs, iret ) C************************************************************************ C* UA_PMPR * C* * C* This subroutine decodes a pilot mandatory level pressure group of * C* the form 44NPP or 55NPP. * C* * C* UA_PMPR ( FIELD, PRSDAT, NPRS, IRET ) * C* * C* Input parameters: * C* FIELD CHAR* Pilot mandatory level * C* pressure group * C* * C* Output parameters: * C* PRSDAT (NPRS) REAL Pilot mandatory level pressures * C* NPRS INTEGER Number of pilot mandatory level * C* pressures * C* IRET INTEGER Return code: * C* 0 = normal return * C* -1 = pilot mandatory level * C* pressure group was bad * C** * C* Log: * C* J. Ator/NCEP 03/96 * C* J. Ator/NCEP 12/97 New interface format, style changes * C* J. Ator/NCEP 12/98 Initialize manlev via DATA statement * C* J. Ator/NCEP 10/99 Clean up function declarations * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* REAL prsdat ( * ) C* CHARACTER*(*) field C* CHARACTER manlev ( 11, 2 )*2 DATA manlev + / '00', '92', '85', '70', '50', '40', + '30', '25', '20', '15', '10', + '70', '50', '30', '20', '10', + '07', '05', '03', '02', '01', 'xx'/ C------------------------------------------------------------------------ C C* Initialize variables. C iret = 0 nprs = 0 IF ( prttyp .eq. AA ) THEN imxlev = 11 iaacc = 1 ELSE imxlev = 10 iaacc = 2 END IF C C* Check that the first two characters of the group are '44' C* or '55'. C IF ( ( field (1:2) .ne. '44' ) .and. + ( field (1:2) .ne. '55' ) ) THEN iret = -1 RETURN END IF C C* Determine the first mandatory level in the sequence. C ifmlv = 0 DO ilev = 1, imxlev IF ( field (4:5) .eq. manlev ( ilev, iaacc ) ) THEN ifmlv = ilev END IF END DO IF ( ifmlv .eq. 0 ) THEN iret = -1 RETURN END IF C C* Determine the number of mandatory levels in the sequence. C CALL ST_INTG ( field (3:3), inmlv, ier ) IF ( ( ier .ne. 0 ) .or. + ( inmlv .lt. 1 ) .or. ( inmlv .gt. 3 ) ) THEN iret = -1 RETURN END IF C C* Compute the pressures for all mandatory levels in the sequence. C DO ilev = ifmlv, ( ifmlv + inmlv - 1 ) IF ( ilev .le. imxlev ) THEN CALL UA_PRS2 ( manlev ( ilev, iaacc ), pres, ier ) IF ( ier .eq. 0 ) THEN nprs = nprs + 1 prsdat ( nprs ) = pres END IF END IF END DO C* RETURN END