var/da/da_ssmi/da_spemiss_adj.inc

   1 subroutine da_spemiss_adj(f,tk,theta,ssw,ev,eh, ADJ_tk,ADJ_ev,ADJ_eh)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    !------------------------------------------------------------------------
  10    ! Output :: ADJ_tk
  11    ! Input  :: ADJ_ev, ADJ_eh
  12    !------------------------------------------------------------------------
  13
  14    real, intent(in ) :: f, tk, theta, ADJ_ev,ADJ_eh
  15    real, intent(inout) :: ssw
  16    real, intent(inout) :: ADJ_tk
  17    real, intent(out)   :: ev, eh
  18
  19    real   epsr,epsi,ADJ_epsr,ADJ_epsi
  20
  21    real      tc,costh,sinth,rthet
  22    complex   etav,etah,eps,cterm1v,cterm1h,cterm2,cterm3v,cterm3h,epsnew
  23    complex   ADJ_etav,ADJ_eps,ADJ_cterm1v,ADJ_cterm2,ADJ_cterm3v
  24    complex   ADJ_cterm3h,ADJ_epsnew
  25    real      tmp1r,tmp1i,tmp2r,tmp2i,tmp0r,tmp0i,rnorm
  26    real      ADJ_tc,ADJ_tmp0r,ADJ_tmp0i,ADJ_rnorm,ADJ_tmp1r
  27    real      ADJ_tmp1i,ADJ_tmp2r,ADJ_tmp2i
  28
  29    if (trace_use) call da_trace_entry("da_spemiss_adj")
  30
  31    epsr=0.0
  32    epsi=0.0
  33    ADJ_epsr=0.0
  34    ADJ_epsi=0.0
  35    ev=0.0
  36    eh=0.0
  37    tc=0.0
  38    costh=0.0
  39    sinth=0.0
  40    rthet=0.0
  41    tmp1r=0.0
  42    tmp1i=0.0
  43    tmp2r=0.0
  44    tmp2i=0.0
  45    tmp0r=0.0
  46    tmp0i=0.0
  47    rnorm=0.0
  48    ADJ_tc=0.0
  49    ADJ_tmp0r=0.0
  50    ADJ_tmp0i=0.0
  51    ADJ_rnorm=0.0
  52    ADJ_tmp1r=0.0
  53    ADJ_tmp1i=0.0
  54    ADJ_tmp2r=0.0
  55    ADJ_tmp2i=0.0
  56
  57    tc     =      tk - t_kelvin
  58
  59    call epsalt(f,tc,ssw,epsr,epsi)
  60
  61    eps     =  cmplx(epsr,epsi)
  62    etav    =  eps
  63    etah    =  (1.0,0.0)
  64    rthet   =  theta*0.017453292
  65    costh   =  cos(rthet)
  66    sinth   =  sin(rthet)
  67    sinth   =  sinth*sinth
  68    cterm1v   =  etav*costh
  69    cterm1h   =  etah*costh
  70    epsnew   =  eps - sinth
  71    cterm2   =  csqrt(epsnew)
  72
  73    cterm3v   =  (cterm1v - cterm2)/(cterm1v + cterm2)
  74    cterm3h   =  (cterm1h - cterm2)/(cterm1h + cterm2)
  75    tmp1r   =  real(cterm3v)
  76    tmp1i   = -aimag(cterm3v)
  77    ! ev   =  1.0 - (tmp1r*tmp1r+tmp1i*tmp1i)
  78
  79    tmp2r   =  real(cterm3h)
  80    tmp2i   = -aimag(cterm3h)
  81    ! eh   =  1.0 - (tmp2r*tmp2r+tmp2i*tmp2i)
  82
  83    ADJ_tmp2r   = - 2.0*tmp2r*ADJ_eh
  84    ADJ_tmp2i   = - 2.0*tmp2i*ADJ_eh
  85
  86    ADJ_cterm3h =  ADJ_tmp2r + ADJ_tmp2i*(0.0,1.0)
  87
  88    ADJ_tmp1r   = - 2.0*tmp1r*ADJ_ev
  89    ADJ_tmp1i   = - 2.0*tmp1i*ADJ_ev
  90
  91    ADJ_cterm3v =  ADJ_tmp1r + ADJ_tmp1i*(0.0,1.0)
  92
  93    ADJ_cterm2  = - ADJ_cterm3h/(cterm1h + cterm2)
  94    ADJ_cterm2  = - cterm3h*ADJ_cterm3h/(cterm1h + cterm2) + ADJ_cterm2
  95
  96    ADJ_cterm1v =   ADJ_cterm3v/(cterm1v + cterm2)
  97    ADJ_cterm2  = - ADJ_cterm3v/(cterm1v + cterm2) + ADJ_cterm2
  98    ADJ_cterm1v = - cterm3v*ADJ_cterm3v/(cterm1v + cterm2) + ADJ_cterm1v
  99    ADJ_cterm2  = - cterm3v*ADJ_cterm3v/(cterm1v + cterm2) + ADJ_cterm2
 100
 101    if (cabs(epsnew) .gt. 0.0) then
 102       ADJ_epsnew  = ADJ_cterm2*0.5/cterm2
 103    else
 104       ADJ_epsnew  =  0.0
 105    end if
 106
 107    ADJ_eps     =  ADJ_epsnew
 108
 109    ADJ_etav    =  ADJ_cterm1v*costh
 110
 111    ADJ_eps     =  ADJ_etav + ADJ_eps
 112
 113    ADJ_epsr    =  real(ADJ_eps)
 114    ADJ_epsi    =  -aimag(ADJ_eps)
 115    ADJ_tc      =  0.0
 116    call da_epsalt_adj(f,tc,ssw,ADJ_tc, ADJ_epsr, ADJ_epsi)
 117
 118    ADJ_tk      =  ADJ_tc + ADJ_tk
 119
 120    if (trace_use) call da_trace_exit("da_spemiss_adj")
 121
 122 end subroutine da_spemiss_adj
 123
 124