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