chem/module_mosaic_csuesat.F

   1 !**********************************************************************************
   2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
   3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
   4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
   5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
   6 !
   7 ! MOSAIC module: see module_mosaic_driver.F for references and terms of use
   8 !**********************************************************************************
   9       module module_mosaic_csuesat
  10
  11 !-----------------------------------------------------------------------
  12
  13       implicit none
  14
  15       integer, parameter :: nebins=149, nebinsi=110
  16
  17       real, save :: estbar(nebins+1), esitbar(nebinsi+1)
  18
  19       real, save :: tmin = -1.0
  20       real, save :: tmini = -1.0
  21
  22
  23
  24       contains
  25
  26
  27
  28 !-----------------------------------------------------------------------
  29 !   following funcs from pegasus file csuesat01.f (timestamp = 09-apr-2002)
  30 !-----------------------------------------------------------------------
  31 !   file csuesat01.f - from stratcld.F,v on 8-oct-97
  32 !   routines and common blocks renamed to allow running either
  33 !       standalone gchm or coupled gchm-ccm2
  34 !-----------------------------------------------------------------------
  35
  36
  37 !-----------------------------------------------------------------------
  38       real function esat_gchm( t )
  39
  40 !     saturation vapor pressure (dynes/cm2) with respect to water
  41
  42       real t
  43       real av
  44       integer it
  45
  46       if (tmin .lt. 0.0) then
  47         call init_csuesat
  48       endif
  49
  50       it=max0(1,min0(ifix(t-tmin),nebins))
  51       av=amax1(amin1(t-tmin-float(it),1.),0.)
  52       esat_gchm=estbar(it)*(1.-av)+estbar(it+1)*av
  53       return
  54       end function esat_gchm
  55
  56
  57 !-----------------------------------------------------------------------
  58       real function esati_gchm( t )
  59
  60 !     saturation vapor pressure (dynes/cm2) with respect to ice
  61
  62       real t
  63       real av
  64       integer it
  65
  66       if (tmin .lt. 0.0) then
  67         call init_csuesat
  68       endif
  69
  70       it=max0(1,min0(ifix(t-tmini),nebinsi))
  71       av=amax1(amin1(t-tmini-float(it),1.),0.)
  72       esati_gchm=esitbar(it)*(1.-av)+esitbar(it+1)*av
  73       return
  74       end function esati_gchm
  75
  76
  77 !-----------------------------------------------------------------------
  78       subroutine init_csuesat
  79
  80 !     calculate table of saturation vapor pressure (dynes/cm2) with respect
  81 !     to water(estbar) and ice (esitbar)
  82
  83       integer jd, k
  84       real a0, a2, a3, a3dtf, a4, a5, a6, arg, ax
  85       real t, tf, tinver, z1, z2
  86
  87       a0=5.75185606e10
  88       ax=-20.947031
  89       a2=-3.56654
  90       a3=-2.018890949
  91       tf=273.16
  92       a3dtf=a3/tf
  93       tmini=163.
  94       t=tmini
  95
  96       do 3 k=1,nebinsi+1
  97       t=t+1.
  98       tinver=1./t
  99       arg=ax*tf*tinver+a2*alog(tf*tinver)+a3*t/tf
 100       esitbar(k)=a0*exp(arg)*1.e3
 101 3     continue
 102
 103       a0=7.95357242e+10
 104       ax=-18.1972839
 105       a2=5.02808
 106       a3=-70242.1852
 107       a4=-26.1205253
 108       a5=58.0691913
 109       a6=-8.03945282
 110       tf=373.16
 111       tmin=163.
 112       t=tmin
 113
 114       do 4 jd=1,nebins+1
 115       t=t+1.
 116       z1=exp(a4*t/tf)
 117       z2=exp(a6*tf/t)
 118       arg=ax*tf/t+a2*alog(tf/t)+a3*z1+a5*z2
 119 4     estbar(jd)=a0*exp(arg)*1.e3
 120
 121       return
 122       end subroutine init_csuesat
 123
 124
 125 !-----------------------------------------------------------------------
 126       end module module_mosaic_csuesat