da_spemiss_adj.inc
References to this file elsewhere.
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