phys/module_cam_gffgch.F

   1 #define WRF_PORT
   2 #define MODAL_AERO
   3 ! Updated to CESM1.0.3 (CAM5.1.01) by Balwinder.Singh@pnnl.gov
   4 !------------------------------------------------------------------------
   5 ! Based on gffgch.F90 from CAM
   6 ! Ported to WRF by William.Gustafson@pnl.gov, Nov. 2009
   7 !------------------------------------------------------------------------
   8
   9 #ifdef WRF_PORT
  10 module module_cam_gffgch
  11
  12   implicit none
  13
  14   private
  15   public gffgch
  16
  17 contains
  18 #endif
  19
  20 subroutine gffgch(t       ,es      ,itype   )
  21 !-----------------------------------------------------------------------
  22 !
  23 ! Purpose:
  24 ! Computes saturation vapor pressure over water and/or over ice using
  25 ! Goff & Gratch (1946) relationships.
  26 ! <Say what the routine does>
  27 !
  28 ! Method:
  29 ! T (temperature), and itype are input parameters, while es (saturation
  30 ! vapor pressure) is an output parameter.  The input parameter itype
  31 ! serves two purposes: a value of zero indicates that saturation vapor
  32 ! pressures over water are to be returned (regardless of temperature),
  33 ! while a value of one indicates that saturation vapor pressures over
  34 ! ice should be returned when t is less than freezing degrees.  If itype
  35 ! is negative, its absolute value is interpreted to define a temperature
  36 ! transition region below freezing in which the returned
  37 ! saturation vapor pressure is a weighted average of the respective ice
  38 ! and water value.  That is, in the temperature range 0 => -itype
  39 ! degrees c, the saturation vapor pressures are assumed to be a weighted
  40 ! average of the vapor pressure over supercooled water and ice (all
  41 ! water at 0 c; all ice at -itype c).  Maximum transition range => 40 c
  42 !
  43 ! Author: J. Hack
  44 !
  45 !-----------------------------------------------------------------------
  46    use shr_kind_mod, only: r8 => shr_kind_r8
  47    use physconst,    only: tmelt
  48 #ifdef WRF_PORT
  49    use module_cam_support, only: endrun, &
  50                                  iulog
  51 #else
  52    use abortutils,   only: endrun
  53    use cam_logfile,  only: iulog
  54 #endif
  55
  56    implicit none
  57 !------------------------------Arguments--------------------------------
  58 !
  59 ! Input arguments
  60 !
  61    real(r8), intent(in) :: t          ! Temperature
  62 !
  63 ! Output arguments
  64 !
  65    integer, intent(inout) :: itype   ! Flag for ice phase and associated transition
  66
  67    real(r8), intent(out) :: es         ! Saturation vapor pressure
  68 !
  69 !---------------------------Local variables-----------------------------
  70 !
  71    real(r8) e1         ! Intermediate scratch variable for es over water
  72    real(r8) e2         ! Intermediate scratch variable for es over water
  73    real(r8) eswtr      ! Saturation vapor pressure over water
  74    real(r8) f          ! Intermediate scratch variable for es over water
  75    real(r8) f1         ! Intermediate scratch variable for es over water
  76    real(r8) f2         ! Intermediate scratch variable for es over water
  77    real(r8) f3         ! Intermediate scratch variable for es over water
  78    real(r8) f4         ! Intermediate scratch variable for es over water
  79    real(r8) f5         ! Intermediate scratch variable for es over water
  80    real(r8) ps         ! Reference pressure (mb)
  81    real(r8) t0         ! Reference temperature (freezing point of water)
  82    real(r8) term1      ! Intermediate scratch variable for es over ice
  83    real(r8) term2      ! Intermediate scratch variable for es over ice
  84    real(r8) term3      ! Intermediate scratch variable for es over ice
  85    real(r8) tr         ! Transition range for es over water to es over ice
  86    real(r8) ts         ! Reference temperature (boiling point of water)
  87    real(r8) weight     ! Intermediate scratch variable for es transition
  88    integer itypo   ! Intermediate scratch variable for holding itype
  89 !
  90 !-----------------------------------------------------------------------
  91 !
  92 ! Check on whether there is to be a transition region for es
  93 !
  94    if (itype < 0) then
  95       tr    = abs(real(itype,r8))
  96       itypo = itype
  97       itype = 1
  98    else
  99       tr    = 0.0_r8
 100       itypo = itype
 101    end if
 102    if (tr > 40.0_r8) then
 103       write(iulog,900) tr
 104 #ifdef WRF_PORT
 105       call wrf_message(iulog)
 106 #endif
 107       call endrun ('GFFGCH')                ! Abnormal termination
 108    end if
 109 !
 110    if(t < (tmelt - tr) .and. itype == 1) go to 10
 111 !
 112 ! Water
 113 !
 114    ps = 1013.246_r8
 115    ts = 373.16_r8
 116    e1 = 11.344_r8*(1.0_r8 - t/ts)
 117    e2 = -3.49149_r8*(ts/t - 1.0_r8)
 118    f1 = -7.90298_r8*(ts/t - 1.0_r8)
 119    f2 = 5.02808_r8*log10(ts/t)
 120    f3 = -1.3816_r8*(10.0_r8**e1 - 1.0_r8)/10000000.0_r8
 121    f4 = 8.1328_r8*(10.0_r8**e2 - 1.0_r8)/1000.0_r8
 122    f5 = log10(ps)
 123    f  = f1 + f2 + f3 + f4 + f5
 124    es = (10.0_r8**f)*100.0_r8
 125    eswtr = es
 126 !
 127    if(t >= tmelt .or. itype == 0) go to 20
 128 !
 129 ! Ice
 130 !
 131 10 continue
 132    t0    = tmelt
 133    term1 = 2.01889049_r8/(t0/t)
 134    term2 = 3.56654_r8*log(t0/t)
 135    term3 = 20.947031_r8*(t0/t)
 136    es    = 575.185606e10_r8*exp(-(term1 + term2 + term3))
 137 !
 138    if (t < (tmelt - tr)) go to 20
 139 !
 140 ! Weighted transition between water and ice
 141 !
 142    weight = min((tmelt - t)/tr,1.0_r8)
 143    es = weight*es + (1.0_r8 - weight)*eswtr
 144 !
 145 20 continue
 146    itype = itypo
 147    return
 148 !
 149 900 format('GFFGCH: FATAL ERROR ******************************',/, &
 150            'TRANSITION RANGE FOR WATER TO ICE SATURATION VAPOR', &
 151            ' PRESSURE, TR, EXCEEDS MAXIMUM ALLOWABLE VALUE OF', &
 152            ' 40.0 DEGREES C',/, ' TR = ',f7.2)
 153 !
 154 end subroutine gffgch
 155 #ifdef WRF_PORT
 156 end module module_cam_gffgch
 157 #endif