SUBROUTINE SF_TDIM ( idur, cxtcod, celcod, ctscod,
+ cimn, td, ctdu, iret )
C************************************************************************
C* SF_TDIM *
C* *
C* This subroutine translates the SHEF duration, extremum and element *
C* codes associated with a particular observation into an actual time *
C* duration and interface mnemonic. *
C* *
C* SF_TDIM ( IDUR, CXTCOD, CELCOD, CTSCOD, CIMN, TD, CTDU, IRET ) *
C* *
C* Input parameters: *
C* IDUR INTEGER SHEF duration code *
C* CXTCOD CHAR* SHEF extremum code *
C* CELCOD CHAR* SHEF element code *
C* CTSCOD CHAR* SHEF type/source code *
C* *
C* Output parameters: *
C* CIMN CHAR* Interface mnemonic *
C* TD REAL Time duration applying to CIMN *
C* CTDU CHAR*2 Units of TD: *
C* 'MO' = months *
C* 'HR' = hours *
C* 'MI' = minutes *
C* IRET INTEGER Return code: *
C* 0 = normal return *
C* -1 = could not determine CIMN *
C* and/or TD *
C** *
C* Log: *
C* J. Ator/NCEP 04/05 *
C* J. Ator/NCEP 11/09 Add WACN to interface output *
C* S. Guan/NCEP 08/11 Decode HM height of tide *
C* J. Ator/NCEP 02/14 Add DCHG and FLWR to interface output *
C* J. Ator/NCEP 08/14 Add ctscod to call argument list *
C* M. Weiss/NCEP 05/20 Added logic to process the parameter *
C* code for water velocity (WVIRG) and *
C* elevation of a natural lake (HLIRG) to *
C* accomodate stations BRKQ6 and YNTN6. *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'BRIDGE.PRM'
INCLUDE 'sfcmn.cmn'
C*
CHARACTER*(*) cxtcod, celcod, ctscod, cimn, ctdu
C*
INCLUDE 'ERMISS.FNC'
C-----------------------------------------------------------------------
iret = -1
C
cimn = ' '
td = RMISSD
ctdu = 'HR'
C
IF ( cxtcod .eq. 'Z' ) THEN
C
C* Check for a duration within the SHEF duration code.
C
IF ( idur .lt. 2000 ) THEN
td = FLOAT ( MOD ( idur, 1000 ) )
IF ( idur .lt. 1000 ) THEN
ctdu = 'MI'
END IF
ELSE IF ( idur .lt. 3000 ) THEN
td = FLOAT ( MOD ( idur, 2000 ) ) * 24.
ELSE IF ( idur .lt. 4000 ) THEN
td = FLOAT ( MOD ( idur, 3000 ) )
ctdu = 'MO'
ELSE IF ( idur .eq. 5004 ) THEN
CALL SF_5004 ( nmin, ier504 )
IF ( ier504 .ne. 0 ) THEN
RETURN
END IF
td = FLOAT ( nmin )
ctdu = 'MI'
END IF
ELSE
C
C* Check for a duration within the SHEF extremum code.
C
IF ( cxtcod .eq. 'M' ) THEN
td = 168.
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'N' ) THEN
td = 24.
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'F' ) THEN
td = 1.
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'G' ) THEN
td = 3.
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'H' ) THEN
td = 6.
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'P' ) THEN
td = 12.
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'I' ) THEN
td = 18.
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'L' ) THEN
td = 1.
ctdu = 'MO'
cimn(1:2) = 'MN'
ELSE IF ( cxtcod .eq. 'W' ) THEN
td = 168.
cimn(1:2) = 'MX'
ELSE IF ( cxtcod .eq. 'X' ) THEN
td = 24.
cimn(1:2) = 'MX'
ELSE IF ( cxtcod .eq. 'D' ) THEN
td = 1.
cimn(1:2) = 'MX'
ELSE IF ( cxtcod .eq. 'E' ) THEN
td = 3.
cimn(1:2) = 'MX'
ELSE IF ( cxtcod .eq. 'R' ) THEN
td = 6.
cimn(1:2) = 'MX'
ELSE IF ( cxtcod .eq. 'Y' ) THEN
td = 12.
cimn(1:2) = 'MX'
ELSE IF ( cxtcod .eq. 'S' ) THEN
td = 18.
cimn(1:2) = 'MX'
ELSE IF ( cxtcod .eq. 'V' ) THEN
td = 1.
ctdu = 'MO'
cimn(1:2) = 'MX'
END IF
C
END IF
C
IF ( ERMISS ( td ) ) THEN
WRITE ( UNIT = logmsg, FMT = '( 3A, I4 )' )
+ ' unable to determine duration from cxtcod ',
+ cxtcod, ' and idur ', idur
CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
RETURN
END IF
C
C* Construct the interface mnemonic. The interface mnemonic
C* will consist of between 4 and 7 alphabetic characters as
C* follows:
C* (1) (optional) "MX" or "MN" as the first 2 characters,
C* if and only if it is a maximum or minimum value
C* based on the SHEF extremum code
C* (2) 4 characters based on the SHEF element code
C* (3) (optional) 1 character SHEF source code, if and only
C* if it is a forecast value based on the SHEF type code
C
IF ( cimn(1:1) .eq. 'M' ) THEN
ipt = 3
ELSE
ipt = 1
END IF
IF ( celcod .eq. 'PP' ) THEN
C
C* Total precipitation (in inches).
C
cimn(ipt:ipt+3) = 'TPCI'
C
ELSE IF ( celcod .eq. 'PC' ) THEN
C
C* Total precipitation (in inches) that has accumulated in
C* the gauge (i.e. current gauge reading). Since such data
C* values are unaccompanied by a true duration, it will be
C* up to the end-user to locate the previous corresponding
C* report in the database and then subtract in order to
C* determine the incremental precipitation amount and
C* corresponding duration.
C
cimn(ipt:ipt+3) = 'TPCI'
td = RMISSD
C
ELSE IF ( celcod .eq. 'PT' ) THEN
C
C* Type of precipitation (SHEF Code Table 17).
C
cimn(ipt:ipt+3) = 'SHPT'
C
ELSE IF ( ( celcod .eq. 'HG' ) .or. ! RSHM
+ ( celcod .eq. 'HM' ) .or. ! TLLW
+ ( celcod .eq. 'HL' ) .or. ! TERC
+ ( celcod .eq. 'HP' ) ) THEN !
C
C* Height (in feet).
C
C* Observation Parameter Codes
C* parcod(1:5) parcod(1:2) parcod(4:5) Interface Mnem parcod(6:6)
C* HGIRG celcod=HG ctscod=RG cimn = HGTG cxtcod=Z
C* HMIRG celcod=HM ctscod=RG cimn = HGTM ""
C* NEW HLIRG celcod=HL ctscod=RG cimn = HGTL ""
C* HPIRG celcod=HP ctscod=RG cimn = HGTP ""
C
C* Forecast Parameter Codes
C* parcod(1:5) parcod(1:2) parcod(4:5) Interface Mnem parcod(6:6)
C* HGIFF celcod=HG ctscod=FF cimn = HGTGF ""
C* HMIFF celcod=HM ctscod=FF HGTMF ""
C* NEW HLIFF celcod=HL ctscod=FF HGTLF ""
C* Note: HLIFF not present in SHEF ingest files
C* HPIFF celcod=HP ctscod=FF HGTPF ""
C* HGIFE celcod=HG ctscod=FE cimn = HGTGE ""
C* HGIFZ celcod=HG ctscod=FZ cimn = HGTGZ ""
C
cimn(ipt:ipt+2) = 'HGT' ! cimn(1:3)
cimn(ipt+3:ipt+3) = celcod(2:2) ! cimn(4:4)
IF ( ctscod(1:1) .eq. 'F' ) ! parcod(4:4)
+ cimn(ipt+4:ipt+4) = ctscod(2:2) ! cimn(5:5)
C
ELSE IF ( celcod .eq. 'WV' ) THEN ! River Current
C
C* Speed of current (in feet/second).
C
C* Observation Parameter Code
C* parcod(1:5) parcod(1:2) parcod(4:5) Interface Mnem parcod(6:6)
C* NEW WVIRG celcod=WV ctscod=RG cimn = WVLV cxtcod=Z
C
C* Forecast Parameter Code
C* parcod(1:5) parcod(1:2) parcod(4:5) Interface Mnem parcod(6:6)
C* NEW WVIFF celcod=WV ctscod=FF cimn = WVLVF ""
C* Note: WVIFF not present in SHEF ingest files
C
cimn(ipt:ipt+2) = 'WVL' ! cimn(1:3)
cimn(ipt+3:ipt+3) = celcod(2:2) ! cimn(4:4)
IF ( ctscod(1:1) .eq. 'F' ) ! parcod(4:4)
+ cimn(ipt+4:ipt+4) = ctscod(2:2) ! cimn(5:5)
C
ELSE IF ( ( celcod .eq. 'QI' ) .or.
+ ( celcod .eq. 'QR' ) .or.
+ ( celcod .eq. 'QT' ) ) THEN
C
C* Discharge (in 1000s of cubic feet per second).
C
cimn(ipt:ipt+2) = 'DCH'
cimn(ipt+3:ipt+3) = celcod(2:2)
IF ( ctscod(1:1) .eq. 'F' )
+ cimn(ipt+4:ipt+4) = ctscod(2:2)
C
ELSE IF ( celcod .eq. 'GS' ) THEN
C
C* State of the ground (SHEF Code Table 18).
C
cimn(ipt:ipt+3) = 'SOGR'
C
ELSE IF ( celcod .eq. 'SD' ) THEN
C
C* Total snow depth (in inches).
C
cimn(ipt:ipt+3) = 'SNOW'
C
ELSE IF ( celcod .eq. 'SF' ) THEN
C
C* Depth of fresh snow (in inches).
C
cimn(ipt:ipt+3) = 'SNEW'
C
ELSE IF ( celcod .eq. 'SW' ) THEN
C
C* Water equivalent of snow (in inches).
C
cimn(ipt:ipt+3) = 'WEQS'
C
ELSE IF ( celcod .eq. 'TA' ) THEN
C
C* Dry bulb temperature (in Fahrenheit).
C
cimn(ipt:ipt+3) = 'TMPF'
C
ELSE IF ( celcod .eq. 'TM' ) THEN
C
C* Wet bulb temperature (in Fahrenheit).
C
cimn(ipt:ipt+3) = 'TMWF'
C
ELSE IF ( celcod .eq. 'TD' ) THEN
C
C* Dew point temperature (in Fahrenheit).
C
cimn(ipt:ipt+3) = 'DWPF'
C
ELSE IF ( celcod .eq. 'TW' ) THEN
C
C* Water temperature (in Fahrenheit).
C
cimn(ipt:ipt+3) = 'WTMF'
C
ELSE IF ( celcod .eq. 'WC' ) THEN
C
C* Water conductivity (in microSiemens per cm).
C
cimn(ipt:ipt+3) = 'WACN'
C
ELSE IF ( celcod .eq. 'TS' ) THEN
C
C* Soil temperature (in Fahrenheit).
C
cimn(ipt:ipt+3) = 'STMF'
C
ELSE IF ( ( celcod .eq. 'TB' ) .or.
+ ( celcod .eq. 'TV' ) ) THEN
C
C* Combined soil temperature and depth (in format DDD.TTT,
C* where TTT is soil temperature in degrees Fahrenheit at
C* depth DDD inches below the surface).
C
cimn(ipt:ipt+3) = 'CSTD'
C
ELSE IF ( celcod .eq. 'XR' ) THEN
C
C* Relative humidity (in percent).
C
cimn(ipt:ipt+3) = 'RELH'
C
ELSE IF ( celcod .eq. 'UD' ) THEN
C
C* Wind direction (in degrees).
C
cimn(ipt:ipt+3) = 'DRCT'
C
ELSE IF ( celcod .eq. 'US' ) THEN
C
C* Wind speed (in miles per hour).
C
cimn(ipt:ipt+3) = 'SMPH'
C
ELSE IF ( celcod .eq. 'UG' ) THEN
C
C* Wind gust speed at time of observation (in miles per hour).
C
cimn(ipt:ipt+3) = 'GMPH'
C
ELSE IF ( celcod .eq. 'UR' ) THEN
C
C* Peak wind direction (in degrees). Note that such data
C* values are supposed to be reported in tens of degrees
C* according to the documentation; however, in reality,
C* they are almost always reported in whole degrees!(?)
C
cimn(ipt:ipt+3) = 'PWDR'
C
ELSE IF ( celcod .eq. 'UP' ) THEN
C
C* Peak wind speed (in miles per hour).
C
cimn(ipt:ipt+3) = 'PMPH'
C
ELSE IF ( celcod .eq. 'UQ' ) THEN
C
C* Combined wind direction and speed (in format SSS.SDDD,
C* where SSS.S is speed in miles per hour and DDD is direction
C* in degrees).
C
cimn(ipt:ipt+3) = 'CWDS'
C
ELSE IF ( celcod .eq. 'PA' ) THEN
C
C* Pressure. These data values are supposed to be reported
C* in inches (of mercury); however, in reality, they are often
C* reported in millibars.
C
cimn(ipt:ipt+3) = 'PRSI'
C
ELSE IF ( celcod .eq. 'PL' ) THEN
C
C* MSL pressure. These data values are supposed to be reported
C* in inches (of mercury); however, in reality, they are often
C* reported in millibars.
C
cimn(ipt:ipt+3) = 'PMSI'
C
ELSE IF ( celcod .eq. 'XW' ) THEN
C
C* Present weather.
C
cimn(ipt:ipt+3) = 'WWMO'
C
ELSE IF ( celcod .eq. 'XP' ) THEN
C
C* Past weather.
C
cimn(ipt:ipt+3) = 'PWWM'
C
ELSE IF ( celcod .eq. 'XC' ) THEN
C
C* Total sky cover amount (in tenths).
C
cimn(ipt:ipt+3) = 'CLAM'
C
ELSE IF ( celcod .eq. 'XV' ) THEN
C
C* Horizontal visiblity (in miles).
C
cimn(ipt:ipt+3) = 'VSBY'
C
ELSE IF ( celcod .eq. 'RA' ) THEN
C
C* Albedo.
C
cimn(ipt:ipt+3) = 'ALBD'
C
ELSE IF ( celcod .eq. 'RT' ) THEN
C
C* Total sunshine (in hours).
C
cimn(ipt:ipt+3) = 'TOSH'
C
ELSE
logmsg = ' unknown element code ' // celcod
CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
RETURN
END IF
C
iret = 0
C*
RETURN
END