! !$$$ subprogram documentation block ! . . . . ! ABSTRACT: ! This file collects subroutines related to cloud analysis in ADAS (CAPS) ! ! PROGRAM HISTORY LOG: ! 2009-01-20 Hu Add NCO document block ! ! ! input argument list: ! ! output argument list: ! ! USAGE: ! INPUT FILES: ! ! OUTPUT FILES: ! ! REMARKS: ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE: Linux cluster (WJET) ! !$$$ ! !_____________________________________________________________________ ! ! !################################################################## !################################################################## !###### ###### !###### FUNCTION RH_TO_CLDCV ###### !###### ###### !################################################################## !################################################################## ! FUNCTION rh_to_cldcv(rh,hgt) ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Obtain first guess cloud cover field from relative humidity. ! ! ! AUTHOR: Jian Zhang ! 07/95 ! ! MODIFICATION HISTORY ! ! 04/08/97 J. Zhang ! Added the empirical relationship between RH and ! cloud cover used by Koch et al. (1997). ! Reference: ! Reference: ! Koch, S.E., A. Aksakal, and J.T. McQueen, 1997: ! The influence of mesoscale humidity and evapotranspiration ! fields on a model forecast of a cold-frontal squall line. ! Mon. Wea. Rev., Vol.125, 384-409 ! 09/10/97 J. Zhang ! Modified the empirical relationship between cloud ! fraction and relative humidity from quadratic ! to one-fourth-power. ! ! !----------------------------------------------------------------------- ! ! INPUT: ! rh ! relative humidity ! hgt ! height (AGL) ! ! OUTPUT: ! rh_to_cld_cv ! cloud fractional cover value ! ! LOCAL: ! rh0 ! the critical RH value that seperate clear ! air condition and cloudy condition ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! use kinds, only: r_single,i_kind,r_kind IMPLICIT NONE INTEGER(i_kind) :: rh2cform PARAMETER (rh2cform=2) REAL(r_kind), intent(in) :: rh,hgt REAL(r_kind) :: rh_to_cldcv REAL(r_kind) :: rh0 ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! IF(rh2cform == 1) THEN ! !----------------------------------------------------------------------- ! ! A quadratic relationship between relative humidity and cloud ! fractional cover. ! !----------------------------------------------------------------------- ! IF (hgt < 600.0_r_kind) THEN rh0 = 0.9_r_kind ELSE IF (hgt < 1500.0_r_kind) THEN rh0 = 0.8_r_kind ELSE IF (hgt < 2500.0_r_kind) THEN rh0 = 0.6_r_kind ELSE rh0 = 0.5_r_kind END IF IF (rh < rh0) THEN rh_to_cldcv = 0.0_r_kind ELSE rh_to_cldcv = (rh - rh0)/(1.0_r_kind - rh0) rh_to_cldcv = rh_to_cldcv*rh_to_cldcv END IF ELSE IF(rh2cform == 2) THEN ! !----------------------------------------------------------------------- ! ! A quadratic relationship between relative humidity and cloud ! fractional cover with fixed rh0=0.75 ! !----------------------------------------------------------------------- ! ! IF (rh < 0.75_r_kind) THEN rh_to_cldcv = 0.0_r_kind ELSE rh_to_cldcv = 16._r_kind*(rh - 0.75_r_kind)*(rh - 0.75_r_kind) END IF ELSE ! !-----------------------------------------------------------------------! ! A modified version of the sqrt relationship between ! relative humidity and cloud fractional cover used in Eta model. ! !----------------------------------------------------------------------- ! IF (hgt < 600._r_kind) THEN rh0 = 0.8_r_kind ELSE rh0 = 0.75_r_kind END IF IF (rh < rh0) THEN rh_to_cldcv = 0.0_r_kind ELSE rh_to_cldcv = 1.0_r_kind - SQRT((1.0_r_kind - rh)/(1.0_r_kind - rh0)) END IF END IF RETURN END FUNCTION rh_to_cldcv ! ! !################################################################## !################################################################## !###### ###### !###### FUNCTION F_ES ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! FUNCTION f_es( p, t ) ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Calculate the saturation specific humidity using enhanced Teten's ! formula. ! !----------------------------------------------------------------------- ! ! AUTHOR: Yuhe Liu ! 01/08/1998 ! ! MODIFICATION HISTORY: ! !----------------------------------------------------------------------- ! ! INPUT : ! ! p Pressure (Pascal) ! t Temperature (K) ! ! OUTPUT: ! ! f_es Saturation water vapor pressure (Pa) ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! IMPLICIT NONE REAL :: p ! Pressure (Pascal) REAL :: t ! Temperature (K) REAL :: f_es ! Saturation water vapor pressure (Pa) ! !----------------------------------------------------------------------- ! ! Function f_es and inline directive for Cray PVP ! !----------------------------------------------------------------------- ! REAL :: f_esl, f_esi !fpp$ expand (f_esl) !fpp$ expand (f_esi) !!dir$ inline always f_esl, f_esi !*$* inline routine (f_esl, f_esi) ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! IF ( t >= 273.15 ) THEN ! for water f_es = f_esl( p,t ) ELSE ! for ice f_es = f_esi( p,t ) END IF RETURN END FUNCTION f_es ! !----------------------------------------------------------------------- ! ! Calculate the saturation water vapor over liquid water using ! enhanced Teten's formula. ! !----------------------------------------------------------------------- ! FUNCTION f_esl( p, t ) IMPLICIT NONE ! constant REAL :: satfwa, satfwb PARAMETER ( satfwa = 1.0007 ) PARAMETER ( satfwb = 3.46E-8 ) ! for p in Pa REAL :: satewa, satewb, satewc PARAMETER ( satewa = 611.21 ) ! es in Pa PARAMETER ( satewb = 17.502 ) PARAMETER ( satewc = 32.18 ) REAL :: p ! Pressure (Pascal) REAL :: t ! Temperature (K) REAL :: f_esl ! Saturation water vapor pressure over liquid water REAL :: f ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! f = satfwa + satfwb * p f_esl = f * satewa * EXP( satewb*(t-273.15)/(t-satewc) ) RETURN END FUNCTION f_esl ! !----------------------------------------------------------------------- ! ! Calculate the saturation water vapor over ice using enhanced ! Teten's formula. ! !----------------------------------------------------------------------- ! FUNCTION f_esi( p, t ) IMPLICIT NONE ! REAL :: satfia, satfib PARAMETER ( satfia = 1.0003 ) PARAMETER ( satfib = 4.18E-8 ) ! for p in Pa REAL :: sateia, sateib, sateic PARAMETER ( sateia = 611.15 ) ! es in Pa PARAMETER ( sateib = 22.452 ) PARAMETER ( sateic = 0.6 ) REAL :: p ! Pressure (Pascal) REAL :: t ! Temperature (K) REAL :: f_esi ! Saturation water vapor pressure over ice (Pa) REAL :: f ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! f = satfia + satfib * p f_esi = f * sateia * EXP( sateib*(t-273.15)/(t-sateic) ) RETURN END FUNCTION f_esi ! ! !################################################################## !################################################################## !###### ###### !###### FUNCTION F_QVSAT ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! FUNCTION f_qvsat( p, t ) ! !----------------------------------------------------------------------- ! ! PURPOSE: ! ! Calculate the saturation specific humidity using enhanced Teten's ! formula. ! !----------------------------------------------------------------------- ! ! AUTHOR: Yuhe Liu ! 01/08/1998 ! ! MODIFICATION HISTORY: ! !----------------------------------------------------------------------- ! ! INPUT : ! ! p Pressure (Pascal) ! t Temperature (K) ! ! OUTPUT: ! ! f_qvsat Saturation water vapor specific humidity (kg/kg). ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! ! Variable Declarations. ! !----------------------------------------------------------------------- ! IMPLICIT NONE REAL :: p ! Pressure (Pascal) REAL :: t ! Temperature (K) REAL :: f_qvsat ! Saturation water vapor specific humidity (kg/kg) ! !----------------------------------------------------------------------- ! ! Include files: ! !----------------------------------------------------------------------- ! ! REAL :: rd ! Gas constant for dry air (m**2/(s**2*K)) PARAMETER( rd = 287.0 ) REAL :: rv ! Gas constant for water vapor (m**2/(s**2*K)). PARAMETER( rv = 461.0 ) REAL :: rddrv PARAMETER( rddrv = rd/rv ) ! !----------------------------------------------------------------------- ! ! Function f_es and inline directive for Cray PVP ! !----------------------------------------------------------------------- ! REAL :: f_es ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! Beginning of executable code... ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! f_qvsat = rddrv * f_es(p,t) / (p-(1.0-rddrv)*f_es(p,t)) RETURN END FUNCTION f_qvsat SUBROUTINE getdays(nday,iyear,imonth,iday) use kinds, only: i_kind implicit none ! INTEGER(i_kind), intent(in) :: iyear,imonth,iday INTEGER(i_kind), intent(out) :: nday ! nday=0 if(imonth==1) then nday=iday elseif(imonth==2) then nday=31+iday elseif(imonth==3) then nday=59+iday elseif(imonth==4) then nday=90+iday elseif(imonth==5) then nday=120+iday elseif(imonth==6) then nday=151+iday elseif(imonth==7) then nday=181+iday elseif(imonth==8) then nday=212+iday elseif(imonth==9) then nday=243+iday elseif(imonth==10) then nday=273+iday elseif(imonth==11) then nday=304+iday elseif(imonth==12) then nday=334+iday endif if(mod(iyear,4) == 0 .and. imonth > 2 ) nday=nday+1 END SUBROUTINE getdays