var/da/da_ssmi/da_sigma_v_adj.inc

   1 subroutine da_sigma_v_adj(ifreq,p0,wv,hwv,ta,gamma,sigv,                   &
   2                            ADJ_p0,ADJ_wv,ADJ_hwv,ADJ_ta,ADJ_gamma,ADJ_sigma_v)
   3
   4    !-----------------------------------------------------------------------
   5    ! Purpose: TBD
   6    ! output: ADJ_p0, ADJ_wv, ADJ_hwv, ADJ_ta, ADJ_gamma
   7    ! input: ADJ_sigma_v
   8    !-----------------------------------------------------------------------
   9
  10    implicit none
  11
  12    integer, intent(in)    :: ifreq
  13    real,    intent(in)    :: p0,wv,hwv,ta,gamma  ! base field
  14    real,    intent(inout) :: ADJ_p0,ADJ_wv,ADJ_hwv,ADJ_ta,ADJ_gamma
  15    real,    intent(in)    :: ADJ_sigma_v
  16    real,    intent(out)   :: sigv
  17
  18    real :: wvc, wvcor(4)
  19    real :: ADJ_wvc
  20
  21    real :: voh1,otbar1,pbar1
  22    real :: term21,term31,term41,term51,term61
  23    real :: a11,a21,a31,a41,a51,a61
  24    real :: ADJ_voh1,ADJ_otbar1,ADJ_pbar1
  25    real :: ADJ_term21,ADJ_term31,ADJ_term41,ADJ_term51,ADJ_term61
  26
  27    real :: voh2,otbar2,pbar2
  28    real :: term22,term32,term42,term52,term62
  29    real :: a12,a22,a32,a42,a52,a62
  30    real :: ADJ_voh2,ADJ_otbar2,ADJ_pbar2
  31    real :: ADJ_term22,ADJ_term32,ADJ_term42,ADJ_term52,ADJ_term62
  32
  33    real :: voh3,otbar3,pbar3
  34    real :: term23,term33,term43,term53,term63
  35    real :: a13,a23,a33,a43,a53,a63
  36    real :: ADJ_voh3,ADJ_otbar3,ADJ_pbar3
  37    real :: ADJ_term23,ADJ_term33,ADJ_term43,ADJ_term53,ADJ_term63
  38
  39    real :: voh4,otbar4,pbar4
  40    real :: term24,term34,term44,term54,term64
  41    real :: a14,a24,a34,a44,a54,a64
  42    real :: ADJ_voh4,ADJ_otbar4,ADJ_pbar4
  43    real :: ADJ_term24,ADJ_term34,ADJ_term44,ADJ_term54,ADJ_term64
  44
  45    real :: const1,const2,const3,const4
  46    real :: h1,h2,h3,h4
  47
  48    real :: ADJ_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_adj")
  66
  67    ! use modified water vapor value to correct for errors in theoretical absorption
  68
  69    wvc        = 0.0
  70    ADJ_wvc    = 0.0
  71    voh1       = 0.0
  72    otbar1     = 0.0
  73    pbar1      = 0.0
  74    term21     = 0.0
  75    term31     = 0.0
  76    term41     = 0.0
  77    term51     = 0.0
  78    term61     = 0.0
  79    ADJ_voh1   = 0.0
  80    ADJ_otbar1 = 0.0
  81    ADJ_pbar1  = 0.0
  82    ADJ_term21 = 0.0
  83    ADJ_term31 = 0.0
  84    ADJ_term41 = 0.0
  85    ADJ_term51 = 0.0
  86    ADJ_term61 = 0.0
  87
  88    voh2       = 0.0
  89    otbar2     = 0.0
  90    pbar2      = 0.0
  91    term22     = 0.0
  92    term32     = 0.0
  93    term42     = 0.0
  94    term52     = 0.0
  95    term62     = 0.0
  96    ADJ_voh2   = 0.0
  97    ADJ_otbar2 = 0.0
  98    ADJ_pbar2  = 0.0
  99    ADJ_term22 = 0.0
 100    ADJ_term32 = 0.0
 101    ADJ_term42 = 0.0
 102    ADJ_term52 = 0.0
 103    ADJ_term62 = 0.0
 104
 105    voh3       = 0.0
 106    otbar3     = 0.0
 107    pbar3      = 0.0
 108    term23     = 0.0
 109    term33     = 0.0
 110    term43     = 0.0
 111    term53     = 0.0
 112    term63     = 0.0
 113    ADJ_voh3   = 0.0
 114    ADJ_otbar3 = 0.0
 115    ADJ_pbar3  = 0.0
 116    ADJ_term23 = 0.0
 117    ADJ_term33 = 0.0
 118    ADJ_term43 = 0.0
 119    ADJ_term53 = 0.0
 120    ADJ_term63 = 0.0
 121
 122    voh4       = 0.0
 123    otbar4     = 0.0
 124    pbar4      = 0.0
 125    term24     = 0.0
 126    term34     = 0.0
 127    term44     = 0.0
 128    term54     = 0.0
 129    term64     = 0.0
 130    ADJ_voh4   = 0.0
 131    ADJ_otbar4 = 0.0
 132    ADJ_pbar4  = 0.0
 133    ADJ_term24 = 0.0
 134    ADJ_term34 = 0.0
 135    ADJ_term44 = 0.0
 136    ADJ_term54 = 0.0
 137    ADJ_term64 = 0.0
 138
 139    sigv     = 0.0
 140    ADJ_sigv = 0.0
 141
 142    wvc = wv*wvcor(ifreq)
 143
 144    if (ifreq == 1) then
 145       pbar1  = p0/(1.0 + hwv/h1)
 146       voh1   = wv/hwv
 147       term21 = a21*voh1
 148       otbar1 =  1.0/(ta - const1*gamma*hwv)
 149       term31 = a31*otbar1
 150       term61 = a61*otbar1*otbar1
 151       term41 = a41*pbar1*otbar1
 152       term51 = a51*voh1*otbar1
 153       sigv   = a11 + term21 + term31 + term41 + term51 + term61
 154    else if (ifreq == 2) then
 155       pbar2  = p0/(1.0 + hwv/h2)
 156       term22 = a22*pbar2
 157       term52 = a52*pbar2*pbar2
 158       voh2   = wv/hwv
 159       term32 = a32*voh2
 160       otbar2 = 1.0/(ta - const2*gamma*hwv)
 161       term42 = a42*otbar2
 162       term62 = a62*otbar2*otbar2
 163       sigv   = a12 + term22 + term32 + term42 + term52 + term62
 164    else if (ifreq==3) then
 165       pbar3  = p0/(1.0 + hwv/h3)
 166       term43 = a43*pbar3*pbar3
 167       voh3   = wv/hwv
 168       term23 = a23*voh3
 169       otbar3 = 1.0/(ta - const3*gamma*hwv)
 170       term33 = a33*otbar3
 171       term53 = a53*pbar3*voh3
 172       term63 = a63*otbar3*voh3
 173       sigv   = a13 + term23 + term33 + term43 + term53 + term63
 174    else if (ifreq == 4) then
 175       pbar4  = p0/(1.0 + hwv/h4)
 176       term44 = a44*pbar4*pbar4
 177       voh4   = wv/hwv
 178       term24 = a24*voh4
 179       otbar4 = 1.0/(ta - const4*gamma*hwv)
 180       term34 = a34*otbar4
 181       term54 = a54*pbar4*voh4
 182       term64 = a64*otbar4*voh4
 183       sigv   = a14 + term24 + term34 + term44 + term54 + term64
 184    else
 185       sigv = 0.0
 186    end if
 187
 188    ADJ_sigv = ADJ_sigma_v*wvc
 189    ADJ_wvc  = sigv*ADJ_sigma_v
 190
 191    if (ifreq == 1) then
 192       ADJ_term21 = ADJ_sigv
 193       ADJ_term31 = ADJ_sigv
 194       ADJ_term41 = ADJ_sigv
 195       ADJ_term51 = ADJ_sigv
 196       ADJ_term61 = ADJ_sigv
 197
 198       ADJ_voh1   = a51*ADJ_term51*otbar1
 199       ADJ_otbar1 = a51*voh1*ADJ_term51
 200
 201       ADJ_pbar1  = a41*ADJ_term41*otbar1
 202       ADJ_otbar1 = a41*pbar1*ADJ_term41 + ADJ_otbar1
 203       ADJ_otbar1 = 2.0*a61*otbar1*ADJ_term61 + ADJ_otbar1
 204
 205       ADJ_otbar1 = a31*ADJ_term31 + ADJ_otbar1
 206
 207       ADJ_ta    = -otbar1*otbar1*ADJ_otbar1  + ADJ_ta
 208       ADJ_hwv   = otbar1*otbar1*const1*gamma*ADJ_otbar1  + ADJ_hwv
 209       ADJ_gamma = otbar1*otbar1*const1*ADJ_otbar1*hwv  + ADJ_gamma
 210
 211       ADJ_voh1  = a21*ADJ_term21 + ADJ_voh1
 212
 213       ADJ_wv    = ADJ_voh1/hwv  + ADJ_wv
 214       ADJ_hwv   = -voh1*ADJ_voh1/hwv + ADJ_hwv
 215
 216       ADJ_p0    = ADJ_pbar1/(1.0 + hwv/h1)  + ADJ_p0
 217       ADJ_hwv   = -pbar1*ADJ_pbar1/(h1*(1.0 + hwv/h1)) + ADJ_hwv
 218    else if (ifreq==2) then
 219       ADJ_term22 = ADJ_sigv
 220       ADJ_term32 = ADJ_sigv
 221       ADJ_term42 = ADJ_sigv
 222       ADJ_term52 = ADJ_sigv
 223       ADJ_term62 = ADJ_sigv
 224
 225       ADJ_otbar2 = 2.0*a62*otbar2*ADJ_term62
 226
 227       ADJ_otbar2 = a42*ADJ_term42 + ADJ_otbar2
 228
 229       ADJ_ta     = -otbar2*otbar2*ADJ_otbar2  + ADJ_ta
 230       ADJ_hwv    =  otbar2*otbar2*const2*gamma*ADJ_otbar2 + ADJ_hwv
 231       ADJ_gamma  =  otbar2*otbar2*const2*ADJ_otbar2*hwv + ADJ_gamma
 232
 233       ADJ_voh2   = a32*ADJ_term32
 234
 235       ADJ_wv     = ADJ_voh2/hwv + ADJ_wv
 236       ADJ_hwv    = -voh2*ADJ_voh2/hwv + ADJ_hwv
 237
 238       ADJ_pbar2  = 2.0*a52*pbar2*ADJ_term52
 239
 240       ADJ_pbar2  = a22*ADJ_term22 + ADJ_pbar2
 241
 242       ADJ_p0     = ADJ_pbar2/(1.0 + hwv/h2) + ADJ_p0
 243       ADJ_hwv    = -pbar2*ADJ_pbar2/h2/(1.0 + hwv/h2) + ADJ_hwv
 244    else if (ifreq==3) then
 245       ADJ_term23 = ADJ_sigv
 246       ADJ_term33 = ADJ_sigv
 247       ADJ_term43 = ADJ_sigv
 248       ADJ_term53 = ADJ_sigv
 249       ADJ_term63 = ADJ_sigv
 250
 251       ADJ_otbar3 = a63*ADJ_term63*voh3
 252       ADJ_voh3   = a63*otbar3*ADJ_term63
 253
 254       ADJ_pbar3  = a53*ADJ_term53*voh3
 255       ADJ_voh3   = a53*pbar3*ADJ_term53 + ADJ_voh3
 256
 257       ADJ_otbar3 = a33*ADJ_term33 + ADJ_otbar3
 258
 259       ADJ_ta     = -otbar3*otbar3*ADJ_otbar3 + ADJ_ta
 260       ADJ_hwv    =  otbar3*otbar3*const3*gamma*ADJ_otbar3 + ADJ_hwv
 261       ADJ_gamma  =  otbar3*otbar3*const3*ADJ_otbar3*hwv + ADJ_gamma
 262
 263       ADJ_voh3   = a23*ADJ_term23 + ADJ_voh3
 264
 265       ADJ_wv     = ADJ_voh3/hwv  + ADJ_wv
 266       ADJ_hwv    = -voh3*ADJ_voh3/hwv + ADJ_hwv
 267
 268       ADJ_pbar3 = 2.0*a43*pbar3*ADJ_term43 + ADJ_pbar3
 269
 270       ADJ_p0    = ADJ_pbar3/(1.0 + hwv/h3) + ADJ_p0
 271       ADJ_hwv   = -pbar3*ADJ_pbar3/h3/(1.0 + hwv/h3) + ADJ_hwv
 272    else if (ifreq == 4) then
 273       ADJ_term24 = ADJ_sigv
 274       ADJ_term34 = ADJ_sigv
 275       ADJ_term44 = ADJ_sigv
 276       ADJ_term54 = ADJ_sigv
 277       ADJ_term64 = ADJ_sigv
 278
 279       ADJ_otbar4 = a64*ADJ_term64*voh4
 280       ADJ_voh4   = a64*otbar4*ADJ_term64
 281
 282       ADJ_pbar4  = a54*ADJ_term54*voh4
 283       ADJ_voh4   = a54*pbar4*ADJ_term54 + ADJ_voh4
 284
 285       ADJ_otbar4 = a34*ADJ_term34 + ADJ_otbar4
 286
 287       ADJ_ta     = -otbar4*otbar4*ADJ_otbar4  + ADJ_ta
 288       ADJ_hwv    =  otbar4*otbar4*const4*gamma*ADJ_otbar4 + ADJ_hwv
 289       ADJ_gamma  =  otbar4*otbar4*const4*ADJ_otbar4*hwv + ADJ_gamma
 290
 291       ADJ_voh4   = a24*ADJ_term24 + ADJ_voh4
 292
 293       ADJ_wv     = ADJ_voh4/hwv + ADJ_wv
 294       ADJ_hwv    = -voh4*ADJ_voh4/hwv + ADJ_hwv
 295
 296       ADJ_pbar4  = 2.0*a44*pbar4*ADJ_term44 + ADJ_pbar4
 297
 298       ADJ_p0     = ADJ_pbar4/(1.0 + hwv/h4) + ADJ_p0
 299       ADJ_hwv    = -pbar4*ADJ_pbar4/h4/(1.0 + hwv/h4) + ADJ_hwv
 300    end if
 301
 302    ADJ_wv  = ADJ_wvc*wvcor(ifreq) + ADJ_wv
 303
 304    if (trace_use) call da_trace_exit("da_sigma_v_adj")
 305
 306 end subroutine da_sigma_v_adj
 307
 308