SUBROUTINE AF_DHDO ( report, lenr, iret ) C************************************************************************ C* AF_DHDO * C* * C* This subroutine decodes an HDOBB report. * C* * C* AF_DHDO ( REPORT, LENR, CBORG, IRET ) * C* * C* Input parameters: * C* REPORT CHAR* AIREP report * C* LENR INTEGER Length of REPORT * C* * C* Output parameters: * C* RIVALS (IRDWPC) REAL Dewpoint Temp in Celcius * C* IRET INTEGER Return code * C* 0 = normal return * C* * C** * C* Log: * C* J. Cahoon/NCEP 10/11 Creation * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'afcmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C----------------------------------------------------------------------- iret = 0 irptr = 1 C C* First field of the report is the hhmmss field C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 6 ) THEN C C* Decode and store the time (i.e. hour/minute/second) data. C CALL AF_HHMM ( field (1:4), iertim ) CALL ST_INTG ( field (5:6), iseco, ier ) IF ( ier .eq. 0 ) THEN rivals ( irseco ) = iseco END IF ELSE IF ( lenf .eq. 2 ) THEN RETURN ELSE iidind = IMISSD END IF C C* Get the Latitude Group C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 5 ) THEN CALL AF_SLAT ( field (1:4), field (5:5), iesrslt ) END IF C C* Get and decode the Longitude Group C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 6 ) THEN CALL AF_SLON ( field (1:5), field (6:6), iersln ) END IF C C* Get and decode the air pressure C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 4 ) THEN CALL ST_INTG ( field (1:4), ipres, ier ) IF ( ier .eq. 0 ) THEN IF ( FLOAT (ipres) .lt. 100 ) THEN pradd = 1000 ELSE pradd = 0 END IF pres = ( FLOAT (ipres) ) / 10 + pradd rivals ( irpres ) = pres END IF END IF C C* Get and decode the GPH C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 5 ) THEN CALL ST_INTG ( field (1:5), igphm, ier ) IF ( ier .eq. 0 ) THEN rivals ( irgphm ) = igphm END IF END IF C C* Get the surface pressure C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) C C* Get and decode the air temp C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 4 ) THEN IF ( field (2:3) .ne. '//' ) THEN CALL AF_TMPC ( field (1:1), field (2:4), iertmp ) END IF END IF C C* Get and decode dewpoint C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 4 ) THEN IF ( field (1:1) .eq. '+' ) THEN rmult = 1.0 ELSE IF ( field (1:1) .eq. '-' ) THEN rmult = -1.0 END IF CALL ST_INTG ( field (2:4), itmpc, ier ) IF ( ier. eq. 0 ) THEN dwpc = ( FLOAT ( itmpc) * rmult ) / 10.0 rivals ( irdwpc ) = dwpc END IF END IF C C* Get and decode wind direction and speed C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 6 ) THEN CALL AF_WIND ( field (1:3), field (4:6), ierwnd ) END IF C C* Get and decode peak 10s avg wind speed in kt C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 3 ) THEN CALL ST_INTG ( field (1:3), ipkwd, ier ) IF ( ier .eq. 0 ) THEN rivals ( irpkwd ) = ipkwd END IF END IF C C* Get the peak 10s avg surface wind speed from SFMR in kt C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) C C* Get and decode SFMR derived rain rate in mm hr-1 C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 3 ) THEN CALL ST_INTG ( field (1:3), isfmr, ier ) IF ( ier .eq. 0 ) THEN rivals ( irsfmr ) = isfmr END IF END IF C C* Get and decode the quality control flags C CALL AF_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .eq. 2 ) THEN CALL ST_INTG ( field (1:1), ihdsp, ier ) IF ( ier .eq. 0 ) THEN rivals ( irhdsp ) = ihdsp END IF CALL ST_INTG ( field (2:2), ihdsm, ier ) IF ( ier .eq. 0 ) THEN rivals ( irhdsm ) = ihdsm END IF END IF C* RETURN END