var/da/da_ssmi/da_sigma_v_tl.inc

   1 subroutine da_sigma_v_tl(ifreq,p0,wv,hwv,ta,gamma,sigma_v,                &
   2                            TGL_p0,TGL_wv,TGL_hwv,TGL_ta,TGL_gamma,TGL_sigma_v)
   3
   4    !---------------------------------------------------------------------------
   5    ! Purpose : TBD
   6    ! Input             : TGL_p0, TGL_wv, TGL_hwv, TGL_ta, TGL_gamma
   7    ! Output            : TGL_sigma_v
   8    ! Output base field : sigma_v
   9    !---------------------------------------------------------------------------
  10
  11    implicit none
  12
  13    integer, intent(in) :: ifreq
  14    real, intent(in  ):: p0,wv,hwv,ta,gamma  ! base field
  15    real, intent(in  ):: TGL_p0,TGL_wv,TGL_hwv,TGL_ta,TGL_gamma
  16    real, intent(out ):: TGL_sigma_v,sigma_v
  17
  18    real wvc, wvcor(4)
  19    real TGL_wvc
  20
  21    real voh1,otbar1,pbar1
  22    real term21,term31,term41,term51,term61
  23    real a11,a21,a31,a41,a51,a61
  24    real TGL_voh1,TGL_otbar1,TGL_pbar1
  25    real TGL_term21,TGL_term31,TGL_term41,TGL_term51,TGL_term61
  26
  27    real voh2,otbar2,pbar2
  28    real term22,term32,term42,term52,term62
  29    real a12,a22,a32,a42,a52,a62
  30    real TGL_voh2,TGL_otbar2,TGL_pbar2
  31    real TGL_term22,TGL_term32,TGL_term42,TGL_term52,TGL_term62
  32
  33    real voh3,otbar3,pbar3
  34    real term23,term33,term43,term53,term63
  35    real a13,a23,a33,a43,a53,a63
  36    real TGL_voh3,TGL_otbar3,TGL_pbar3
  37    real TGL_term23,TGL_term33,TGL_term43,TGL_term53,TGL_term63
  38
  39    real voh4,otbar4,pbar4
  40    real term24,term34,term44,term54,term64
  41    real a14,a24,a34,a44,a54,a64
  42    real TGL_voh4,TGL_otbar4,TGL_pbar4
  43    real TGL_term24,TGL_term34,TGL_term44,TGL_term54,TGL_term64
  44
  45    real const1,const2,const3,const4
  46    real h1,h2,h3,h4
  47
  48    real sigv, TGL_sigv
  49
  50    data const1,const2,const3,const4/0.6,2.8,0.2,0.2/
  51    data h1,h2,h3,h4/5.0,4.9,6.8,6.4/
  52
  53    data a11,a21,a31,a41,a51,a61/-.13747e-2,-.43061e-4, .14618e+1,  &
  54      .25101e-3, .14635e-1,-.18588e+3/
  55    data a12,a22,a32,a42,a52,a62/ .22176e-1,-.32367e-4,-.10840e-4,  &
  56      -.63578e-1, .16988e-7,-.29824e+2/
  57    data a13,a23,a33,a43,a53,a63/-.10566e-2,-.12906e-3, .56975e+0,  &
  58       .10828e-8,-.17551e-7, .48601e-1/
  59    data a14,a24,a34,a44,a54,a64/-.60808e-2,-.70936e-3, .28721e+1,  &
  60       .42636e-8,-.82910e-7, .26166e+0/
  61
  62    ! data wvcor/1.01,0.95,1.06,0.92/
  63    data wvcor/1.02,0.98,1.02,0.88/
  64
  65    if (trace_use) call da_trace_entry("da_sigma_v_tl")
  66
  67    ! use modified water vapor value to correct for errors in theoretical absorption
  68
  69    wvc     = wv*wvcor(ifreq)
  70    TGL_wvc = TGL_wv*wvcor(ifreq)
  71
  72    if (ifreq==1) then
  73       pbar1 = p0/(1.0 + hwv/h1)
  74       TGL_pbar1  = TGL_p0/(1.0 + hwv/h1)-pbar1*TGL_hwv/(h1*(1.0 + hwv/h1))
  75       voh1       = wv/hwv
  76       TGL_voh1   = TGL_wv/hwv-voh1*TGL_hwv/hwv
  77       term21     = a21*voh1
  78       TGL_term21 = a21*TGL_voh1
  79       otbar1     =  1.0/(ta - const1*gamma*hwv)
  80       TGL_otbar1 = -otbar1*otbar1*(TGL_ta-const1*gamma*TGL_hwv - const1*TGL_gamma*hwv)
  81       term31     = a31*otbar1
  82       TGL_term31 = a31*TGL_otbar1
  83       term61     = a61*otbar1*otbar1
  84       TGL_term61 = 2.0*a61*otbar1*TGL_otbar1
  85       term41     = a41*pbar1*otbar1
  86       TGL_term41 = a41*(TGL_pbar1*otbar1+pbar1*TGL_otbar1)
  87       term51     = a51*voh1*otbar1
  88       TGL_term51 = a51*(TGL_voh1*otbar1+voh1*TGL_otbar1)
  89       sigv       = a11 + term21 + term31 + term41 + term51 + term61
  90       TGL_sigv   = TGL_term21+TGL_term31+TGL_term41+TGL_term51+TGL_term61
  91
  92    else if (ifreq==2) then
  93       pbar2      = p0/(1.0 + hwv/h2)
  94       TGL_pbar2  = TGL_p0/(1.0 + hwv/h2)-pbar2*TGL_hwv/h2/(1.0 + hwv/h2)
  95       term22     = a22*pbar2
  96       TGL_term22 = a22*TGL_pbar2
  97       term52     = a52*pbar2*pbar2
  98       TGL_term52 = 2.0*a52*pbar2*TGL_pbar2
  99       voh2       = wv/hwv
 100       TGL_voh2   = TGL_wv/hwv-voh2*TGL_hwv/hwv
 101       term32     = a32*voh2
 102       TGL_term32 = a32*TGL_voh2
 103       otbar2     = 1.0/(ta - const2*gamma*hwv)
 104       TGL_otbar2 = -otbar2*otbar2*(TGL_ta-const2*gamma*TGL_hwv &
 105                                            -const2*TGL_gamma*hwv)
 106       term42     = a42*otbar2
 107       TGL_term42 = a42*TGL_otbar2
 108       term62     = a62*otbar2*otbar2
 109       TGL_term62 = 2.0*a62*otbar2*TGL_otbar2
 110       sigv       = a12 + term22 + term32 + term42 + term52 + term62
 111       TGL_sigv   = TGL_term22 + TGL_term32 + TGL_term42 + TGL_term52 + TGL_term62
 112
 113    else if (ifreq == 3) then
 114       pbar3      = p0/(1.0 + hwv/h3)
 115       TGL_pbar3  = TGL_p0/(1.0 + hwv/h3)-pbar3*TGL_hwv/h3/(1.0 + hwv/h3)
 116       term43     = a43*pbar3*pbar3
 117       TGL_term43 = 2.0*a43*pbar3*TGL_pbar3
 118       voh3       = wv/hwv
 119       TGL_voh3   = TGL_wv/hwv-voh3*TGL_hwv/hwv
 120       term23     = a23*voh3
 121       TGL_term23 = a23*TGL_voh3
 122       otbar3     = 1.0/(ta - const3*gamma*hwv)
 123       TGL_otbar3 = -otbar3*otbar3*(TGL_ta-const3*gamma*TGL_hwv &
 124                                         -const3*TGL_gamma*hwv)
 125       term33     = a33*otbar3
 126       TGL_term33 = a33*TGL_otbar3
 127       term53     = a53*pbar3*voh3
 128       TGL_term53 = a53*(TGL_pbar3*voh3+pbar3*TGL_voh3)
 129       term63     = a63*otbar3*voh3
 130       TGL_term63 = a63*(TGL_otbar3*voh3+otbar3*TGL_voh3)
 131       sigv       = a13 + term23 + term33 + term43 + term53 + term63
 132       TGL_sigv   = TGL_term23 + TGL_term33 + TGL_term43 + TGL_term53 + TGL_term63
 133    else if (ifreq == 4) then
 134       pbar4      = p0/(1.0 + hwv/h4)
 135       TGL_pbar4  = TGL_p0/(1.0 + hwv/h4)-pbar4*TGL_hwv/h4/(1.0 + hwv/h4)
 136       term44     = a44*pbar4*pbar4
 137       TGL_term44 = 2.0*a44*pbar4*TGL_pbar4
 138       voh4       = wv/hwv
 139       TGL_voh4   = TGL_wv/hwv-voh4*TGL_hwv/hwv
 140       term24     = a24*voh4
 141       TGL_term24 = a24*TGL_voh4
 142       otbar4     = 1.0/(ta - const4*gamma*hwv)
 143       TGL_otbar4 = -otbar4*otbar4*(TGL_ta-const4*gamma*TGL_hwv -const4*TGL_gamma*hwv)
 144       term34     = a34*otbar4
 145       TGL_term34 = a34*TGL_otbar4
 146       term54     = a54*pbar4*voh4
 147       TGL_term54 = a54*(TGL_pbar4*voh4+pbar4*TGL_voh4)
 148       term64     = a64*otbar4*voh4
 149       TGL_term64 = a64*(TGL_otbar4*voh4+otbar4*TGL_voh4)
 150       sigv       = a14 + term24 + term34 + term44 + term54 + term64
 151       TGL_sigv   = TGL_term24 + TGL_term34 + TGL_term44 + TGL_term54 + TGL_term64
 152    else
 153       sigv     = 0.0
 154       TGL_sigv = 0.0
 155    end if
 156
 157    sigma_v     = sigv*wvc
 158    TGL_sigma_v = TGL_sigv*wvc+sigv*TGL_wvc
 159
 160    if (trace_use) call da_trace_exit("da_sigma_v_tl")
 161
 162 end subroutine da_sigma_v_tl
 163
 164