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