SUBROUTINE UA_NPD1 ( report, lenr, irptr, iret ) C************************************************************************ C* UA_NPD1 * C* * C* This subroutine decodes 61616 national practice data. * C* * C* UA_NPD1 ( REPORT, LENR, IRPTR, IRET ) * C* * C* Input parameters: * C* REPORT CHAR* Report * C* LENR INTEGER Length of REPORT * C* * C* Input and output parameters: * C* IRPTR INTEGER Pointer within REPORT * C* * C* Output parameters: * C* CIVALS (ICSTID) CHAR* Station ID * C* IRET INTEGER Return code: * C* 0 = normal return * C* -1 = critical error in REPORT * C* or reached end of REPORT * C** * C* Log: * C* J. Ator/NCEP 03/96 * C* J. Ator/NCEP 12/97 New interface format, style changes * C* J. Ator/NCEP 03/98 Decode STID from U.S. DROP reports * C* J. Ator/NCEP 10/98 Don't decode STID for U.S. DROP reports * C* from WMO "second header" line * C* J. Ator/NCEP 10/99 Clean up function declarations * C* J. Ator/NCEP 01/01 Decode STID from U.K. DROP reports * C* C. Caruso Magee/NCEP 04/07 Add 'UK' to columns 7 and 8 of UK stid * C* J. Ator/NCEP 02/10 Decode STID from French DROP reports * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER dpid*8, coun*2 C------------------------------------------------------------------------ iret = 0 C C* Retrieve the country ID from the interface arrays. C coun = civals ( iccoun ) (1:2) C C* Based upon the country ID, decode the 61616 national practice C* data. C IF ( ( coun .eq. 'JP' ) .or. + ( coun .eq. 'SD' ) .or. + ( coun .eq. 'KO' ) ) THEN CALL UA_AWDD ( report, lenr, irptr, iret ) ELSE IF ( ( ( coun .eq. 'US' ) .or. ( coun .eq. 'UK' ) + .or. ( coun .eq. 'FR' ) ) .and. + ( stntyp .eq. DROP ) .and. + ( irptr .lt. lenr ) ) THEN C C* Decode and store the dropwinsonde ID. C CALL ST_NXTS ( report, irptr, lenr, npids, lnpids, + NNPIDS, ipt1, inpid, iernxt ) IF ( iernxt .eq. 0 ) THEN iend = ipt1 - 1 ELSE iend = lenr END IF CALL DC_CRID ( report ( irptr : iend ), + dpid, ndpid, ierdpd ) IF ( ierdpd .eq. 0 ) THEN civals ( icstid ) = ' ' civals ( icstid ) = dpid ( 1 : ndpid ) IF ( ( coun .eq. 'UK' ) .or. + ( coun .eq. 'FR' ) ) THEN civals ( icstid )(7:8) = coun END IF END IF irptr = iend + 1 ELSE logmsg = 'national' CALL DC_WLOG ( 2, 'UA', 3, logmsg, ierwlg ) END IF C* RETURN END