var/da/da_ssmi/da_epsalt_adj.inc

   1 subroutine da_epsalt_adj(f,t,ssw,ADJ_t, ADJ_epsr, ADJ_epsi)
   2
   3    implicit none
   4
   5    !---------------------------------------------------------------------------
   6    ! Purpose: TBD
   7    ! Output: ADJ_t      (ssw is treated as a constant now)
   8    ! Input: ADJ_epsr, ADJ_epsi, epsr, epsi
   9    !---------------------------------------------------------------------------
  10
  11    real, intent(in)    :: f, t
  12    real, intent(inout) :: ADJ_t
  13    real, intent(inout) :: ssw
  14    real, intent(in)    :: ADJ_epsr, ADJ_epsi
  15
  16    complex :: cdum1,cdum2,cdum3
  17    complex :: ADJ_cdum1,ADJ_cdum2,ADJ_cdum3
  18    real    :: ssw2,ssw3,t2,t3,es,a,esnew,tau,b,sig,taunew
  19    real    :: delt,delt2,beta,signew,om,d1,d2
  20    real    :: ADJ_t2,ADJ_t3,ADJ_es,ADJ_a,ADJ_esnew,ADJ_tau,ADJ_b,ADJ_taunew
  21    real    :: ADJ_delt,ADJ_delt2,ADJ_beta,ADJ_signew
  22    real    :: ADJ_d1,ADJ_d2
  23
  24    if (trace_use) call da_trace_entry("da_epsalt_adj")
  25
  26    ssw2=0.0
  27    ssw3=0.0
  28    t2=0.0
  29    t3=0.0
  30    es=0.0
  31    a=0.0
  32    esnew=0.0
  33    tau=0.0
  34    b=0.0
  35    sig=0.0
  36    taunew=0.0
  37    delt=0.0
  38    delt2=0.0
  39    beta=0.0
  40    signew=0.0
  41    om=0.0
  42    d1=0.0
  43    d2=0.0
  44    ADJ_t2=0.0
  45    ADJ_t3=0.0
  46    ADJ_es=0.0
  47    ADJ_a=0.0
  48    ADJ_esnew=0.0
  49    ADJ_tau=0.0
  50    ADJ_b=0.0
  51    ADJ_taunew=0.0
  52    ADJ_delt=0.0
  53    ADJ_delt2=0.0
  54    ADJ_beta=0.0
  55    ADJ_signew=0.0
  56    ADJ_d1=0.0
  57    ADJ_d2=0.0
  58
  59    if (ssw .lt. 0.0) ssw = 32.54
  60
  61    ssw2     = ssw*ssw
  62    ssw3     = ssw2*ssw
  63    t2     = t*t
  64    t3     = t2*t
  65    es     = 87.134 - 1.949e-1*t - 1.276e-2*t2 + 2.491e-4*t3
  66    a      = 1.0 + 1.613e-5*ssw*t - 3.656e-3*ssw + 3.21e-5*ssw2 - &
  67             4.232e-7*ssw3
  68    esnew  = es*a
  69
  70    tau    = 1.768e-11 - 6.086e-13*t + 1.104e-14*t2 - 8.111e-17*t3
  71    b      = 1.0 + 2.282e-5*ssw*t - 7.638e-4*ssw - 7.760e-6*ssw2 + &
  72             1.105e-8*ssw3
  73    taunew = tau*b
  74
  75    sig    = ssw*(0.182521 - 1.46192e-3*ssw + 2.09324e-5*ssw2 - &
  76             1.28205e-7*ssw3)
  77    delt   = 25.0 - t
  78    delt2  = delt*delt
  79    beta   =   2.033e-2 + 1.266e-4*delt      + 2.464e-6*delt2       &
  80             - ssw*(1.849e-5 - 2.551e-7*delt + 2.551e-8*delt2)
  81    signew  =   sig*exp(-beta*delt)
  82
  83    om  = 2.0e9*pi*f
  84    cdum1  = cmplx(0.0,om*taunew)
  85    cdum2  = cmplx(0.0,signew/(om*8.854e-12))
  86
  87    cdum3  = 4.9 + (esnew-4.9)/(1.0 + cdum1) - cdum2
  88
  89    ADJ_cdum3  = ADJ_epsr + ADJ_epsi *(0.0,1.0)
  90    ADJ_esnew  =   REAL(ADJ_cdum3/((1.0,0.0) + cdum1))
  91    ADJ_cdum1  = - ADJ_cdum3*(esnew-4.9)/((1.0 + cdum1)*(1.0 + cdum1))
  92    ADJ_cdum2  = - ADJ_cdum3
  93
  94
  95    ADJ_signew = -aimag(ADJ_cdum2/(om*8.854e-12))
  96
  97    ADJ_taunew = om*(-aimag(ADJ_cdum1))
  98
  99    ADJ_beta   = - signew*ADJ_signew*delt
 100    ADJ_delt   = - signew*beta*ADJ_signew
 101
 102    ADJ_delt   =   1.266e-4*ADJ_beta     + ADJ_delt
 103    ADJ_delt2  =   2.464e-6*ADJ_beta
 104    ADJ_delt   =   ssw*2.551e-7*ADJ_beta + ADJ_delt
 105    ADJ_delt2  = - ssw*2.551e-8*ADJ_beta + ADJ_delt2
 106
 107    ADJ_delt   = 2.0*delt*ADJ_delt2 + ADJ_delt
 108
 109    ADJ_t      =  - ADJ_delt + ADJ_t
 110
 111    ADJ_tau    = ADJ_taunew*b
 112    ADJ_b      = tau*ADJ_taunew
 113
 114    ADJ_t      = 2.282e-5*ssw*ADJ_b  + ADJ_t
 115
 116    ADJ_t      = - 6.086e-13*ADJ_tau + ADJ_t
 117    ADJ_t2     =   1.104e-14*ADJ_tau
 118    ADJ_t3     = - 8.111e-17*ADJ_tau
 119
 120    ADJ_es     = ADJ_esnew*a
 121    ADJ_a      = es*ADJ_esnew
 122    ADJ_t      = 1.613e-5*ssw*ADJ_a  + ADJ_t
 123    ADJ_t      = - 1.949e-1*ADJ_es   + ADJ_t
 124    ADJ_t2     = - 1.276e-2*ADJ_es   + ADJ_t2
 125    ADJ_t3     =   2.491e-4*ADJ_es   + ADJ_t3
 126
 127    ADJ_t2     = ADJ_t3*t     + ADJ_t2
 128    ADJ_t      = t2*ADJ_t3    + ADJ_t
 129    ADJ_t      = 2.0*t*ADJ_t2  + ADJ_t
 130
 131    if (trace_use) call da_trace_exit("da_epsalt_adj")
 132
 133 end subroutine da_epsalt_adj
 134
 135