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