The requested changes are too big and content was truncated. Show full diff
| This diff has been collapsed as it changes many lines, (520 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,520 | |||||
|
|
1 | ! -*- f90 -*- | |||
|
|
2 | ! Note: the context of this file is case sensitive. | |||
|
|
3 | ||||
|
|
4 | python module fdjac2__user__routines | |||
|
|
5 | interface fdjac2_user_interface | |||
|
|
6 | subroutine fcn(m,n,x,wa,iflag) ! in :full_profile_profile:lmdif1.f:fdjac2:unknown_interface | |||
|
|
7 | integer, optional,check(len(wa)>=m),depend(wa) :: m=len(wa) | |||
|
|
8 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
9 | real dimension(n) :: x | |||
|
|
10 | real dimension(m) :: wa | |||
|
|
11 | integer :: iflag | |||
|
|
12 | end subroutine fcn | |||
|
|
13 | end interface fdjac2_user_interface | |||
|
|
14 | end python module fdjac2__user__routines | |||
|
|
15 | python module lmdif__user__routines | |||
|
|
16 | interface lmdif_user_interface | |||
|
|
17 | subroutine fcn(m,n,x,fvec,iflag) ! in :full_profile_profile:lmdif1.f:lmdif:unknown_interface | |||
|
|
18 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
19 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
20 | real dimension(n) :: x | |||
|
|
21 | real dimension(m) :: fvec | |||
|
|
22 | integer :: iflag | |||
|
|
23 | end subroutine fcn | |||
|
|
24 | end interface lmdif_user_interface | |||
|
|
25 | end python module lmdif__user__routines | |||
|
|
26 | python module full_profile_profile ! in | |||
|
|
27 | interface ! in :full_profile_profile | |||
|
|
28 | subroutine profile(acf_sum,acf_err,power,en,alag,thb2,bfm2,ote,ete,oti,eti,oph,eph,ophe,ephe,range2,ut,nhts,nacf,ibits,acf_avg_real,status) ! in :full_profile_profile:full_profile_profile.f | |||
|
|
29 | complex dimension(4,nhts,ibits) :: acf_sum | |||
|
|
30 | real dimension(nhts,ibits),depend(nhts,ibits) :: acf_err | |||
|
|
31 | real dimension(nhts),depend(nhts) :: power | |||
|
|
32 | real dimension(nhts),depend(nhts) :: en | |||
|
|
33 | real dimension(ibits),depend(ibits) :: alag | |||
|
|
34 | real dimension(nhts),depend(nhts) :: thb2 | |||
|
|
35 | real dimension(nhts),depend(nhts) :: bfm2 | |||
|
|
36 | real dimension(nacf),depend(nacf) :: ote | |||
|
|
37 | real dimension(nacf),depend(nacf) :: ete | |||
|
|
38 | real dimension(nacf),depend(nacf) :: oti | |||
|
|
39 | real dimension(nacf),depend(nacf) :: eti | |||
|
|
40 | real dimension(nacf),depend(nacf) :: oph | |||
|
|
41 | real dimension(nacf),depend(nacf) :: eph | |||
|
|
42 | real dimension(nacf),depend(nacf) :: ophe | |||
|
|
43 | real dimension(nacf),depend(nacf) :: ephe | |||
|
|
44 | real dimension(nhts),depend(nhts) :: range2 | |||
|
|
45 | real :: ut | |||
|
|
46 | integer, optional,check(shape(acf_sum,1)==nhts),depend(acf_sum) :: nhts=shape(acf_sum,1) | |||
|
|
47 | integer :: nacf | |||
|
|
48 | integer, optional,check(shape(acf_sum,2)==ibits),depend(acf_sum) :: ibits=shape(acf_sum,2) | |||
|
|
49 | real dimension(nhts,ibits),depend(nhts,ibits), :: acf_avg_real | |||
|
|
50 | real dimension(1) :: status | |||
|
|
51 | real :: chi2 | |||
|
|
52 | real dimension(91) :: densp | |||
|
|
53 | real dimension(91) :: tep | |||
|
|
54 | real dimension(91) :: trp | |||
|
|
55 | real dimension(91) :: tip | |||
|
|
56 | real dimension(91) :: hfp | |||
|
|
57 | real dimension(91) :: hefp | |||
|
|
58 | real dimension(91) :: altp | |||
|
|
59 | real :: r0 | |||
|
|
60 | real :: dr | |||
|
|
61 | real :: wl | |||
|
|
62 | real dimension(16,91) :: plag | |||
|
|
63 | real dimension(16,91) :: plag_errors | |||
|
|
64 | real :: sconst | |||
|
|
65 | real dimension(91) :: edensp | |||
|
|
66 | real dimension(91) :: etep | |||
|
|
67 | real dimension(91) :: etip | |||
|
|
68 | real dimension(91) :: ehfp | |||
|
|
69 | real dimension(91) :: ehefp | |||
|
|
70 | real dimension(85) :: bfld_prof | |||
|
|
71 | real dimension(85) :: alpha_prof | |||
|
|
72 | integer :: imode | |||
|
|
73 | real :: uttime | |||
|
|
74 | real dimension(34) :: ta | |||
|
|
75 | real dimension(30,5) :: bcoef | |||
|
|
76 | real :: te | |||
|
|
77 | real dimension(10) :: ti | |||
|
|
78 | real dimension(10) :: fi | |||
|
|
79 | real :: ven | |||
|
|
80 | real dimension(10) :: vin | |||
|
|
81 | real :: alpha | |||
|
|
82 | real :: dens | |||
|
|
83 | real :: bfld | |||
|
|
84 | integer :: nion | |||
|
|
85 | integer dimension(10) :: wi | |||
|
|
86 | real :: ak | |||
|
|
87 | common /chisq/ chi2 | |||
|
|
88 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
89 | common /data/ plag,plag_errors | |||
|
|
90 | common /sys/ sconst | |||
|
|
91 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
92 | common /mag/ bfld_prof,alpha_prof | |||
|
|
93 | common /mode/ imode | |||
|
|
94 | common /utime/ uttime | |||
|
|
95 | common /spline/ ta,bcoef | |||
|
|
96 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
97 | end subroutine profile | |||
|
|
98 | subroutine grid ! in :full_profile_profile:full_profile_profile.f | |||
|
|
99 | real dimension(34) :: ta | |||
|
|
100 | real dimension(30,5) :: bcoef | |||
|
|
101 | real dimension(91) :: densp | |||
|
|
102 | real dimension(91) :: tep | |||
|
|
103 | real dimension(91) :: trp | |||
|
|
104 | real dimension(91) :: tip | |||
|
|
105 | real dimension(91) :: hfp | |||
|
|
106 | real dimension(91) :: hefp | |||
|
|
107 | real dimension(91) :: altp | |||
|
|
108 | real :: r0 | |||
|
|
109 | real :: dr | |||
|
|
110 | real :: wl | |||
|
|
111 | real dimension(16,91) :: plag | |||
|
|
112 | real dimension(16,91) :: plag_errors | |||
|
|
113 | real :: sconst | |||
|
|
114 | real dimension(91) :: edensp | |||
|
|
115 | real dimension(91) :: etep | |||
|
|
116 | real dimension(91) :: etip | |||
|
|
117 | real dimension(91) :: ehfp | |||
|
|
118 | real dimension(91) :: ehefp | |||
|
|
119 | real :: te | |||
|
|
120 | real dimension(10) :: ti | |||
|
|
121 | real dimension(10) :: fi | |||
|
|
122 | real :: ven | |||
|
|
123 | real dimension(10) :: vin | |||
|
|
124 | real :: alpha | |||
|
|
125 | real :: dens | |||
|
|
126 | real :: bfld | |||
|
|
127 | integer :: nion | |||
|
|
128 | integer dimension(10) :: wi | |||
|
|
129 | real :: ak | |||
|
|
130 | real :: chi2 | |||
|
|
131 | real :: uttime | |||
|
|
132 | common /spline/ ta,bcoef | |||
|
|
133 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
134 | common /data/ plag,plag_errors | |||
|
|
135 | common /sys/ sconst | |||
|
|
136 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
137 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
138 | common /chisq/ chi2 | |||
|
|
139 | common /utime/ uttime | |||
|
|
140 | end subroutine grid | |||
|
|
141 | subroutine propagate(xe) ! in :full_profile_profile:full_profile_profile.f | |||
|
|
142 | real dimension(150) :: xe | |||
|
|
143 | real dimension(91) :: densp | |||
|
|
144 | real dimension(91) :: tep | |||
|
|
145 | real dimension(91) :: trp | |||
|
|
146 | real dimension(91) :: tip | |||
|
|
147 | real dimension(91) :: hfp | |||
|
|
148 | real dimension(91) :: hefp | |||
|
|
149 | real dimension(91) :: altp | |||
|
|
150 | real :: r0 | |||
|
|
151 | real :: dr | |||
|
|
152 | real :: wl | |||
|
|
153 | real dimension(16,91) :: plag | |||
|
|
154 | real dimension(16,91) :: plag_errors | |||
|
|
155 | real :: sconst | |||
|
|
156 | real dimension(91) :: edensp | |||
|
|
157 | real dimension(91) :: etep | |||
|
|
158 | real dimension(91) :: etip | |||
|
|
159 | real dimension(91) :: ehfp | |||
|
|
160 | real dimension(91) :: ehefp | |||
|
|
161 | real dimension(34) :: ta | |||
|
|
162 | real dimension(30,5) :: bcoef | |||
|
|
163 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
164 | common /data/ plag,plag_errors | |||
|
|
165 | common /sys/ sconst | |||
|
|
166 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
167 | common /spline/ ta,bcoef | |||
|
|
168 | end subroutine propagate | |||
|
|
169 | subroutine fcn_lpreg(m,n,x,fvec,iflag) ! in :full_profile_profile:full_profile_profile.f | |||
|
|
170 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
171 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
172 | real dimension(n) :: x | |||
|
|
173 | real dimension(m) :: fvec | |||
|
|
174 | integer :: iflag | |||
|
|
175 | real dimension(34) :: ta | |||
|
|
176 | real dimension(30,5) :: bcoef | |||
|
|
177 | real dimension(91) :: densp | |||
|
|
178 | real dimension(91) :: tep | |||
|
|
179 | real dimension(91) :: trp | |||
|
|
180 | real dimension(91) :: tip | |||
|
|
181 | real dimension(91) :: hfp | |||
|
|
182 | real dimension(91) :: hefp | |||
|
|
183 | real dimension(91) :: altp | |||
|
|
184 | real :: r0 | |||
|
|
185 | real :: dr | |||
|
|
186 | real :: wl | |||
|
|
187 | real dimension(16,91) :: plag | |||
|
|
188 | real dimension(16,91) :: plag_errors | |||
|
|
189 | real :: sconst | |||
|
|
190 | real dimension(91) :: edensp | |||
|
|
191 | real dimension(91) :: etep | |||
|
|
192 | real dimension(91) :: etip | |||
|
|
193 | real dimension(91) :: ehfp | |||
|
|
194 | real dimension(91) :: ehefp | |||
|
|
195 | real :: te | |||
|
|
196 | real dimension(10) :: ti | |||
|
|
197 | real dimension(10) :: fi | |||
|
|
198 | real :: ven | |||
|
|
199 | real dimension(10) :: vin | |||
|
|
200 | real :: alpha | |||
|
|
201 | real :: dens | |||
|
|
202 | real :: bfld | |||
|
|
203 | integer :: nion | |||
|
|
204 | integer dimension(10) :: wi | |||
|
|
205 | real :: ak | |||
|
|
206 | real :: chi2 | |||
|
|
207 | real :: uttime | |||
|
|
208 | common /spline/ ta,bcoef | |||
|
|
209 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
210 | common /data/ plag,plag_errors | |||
|
|
211 | common /sys/ sconst | |||
|
|
212 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
213 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
214 | common /chisq/ chi2 | |||
|
|
215 | common /utime/ uttime | |||
|
|
216 | end subroutine fcn_lpreg | |||
|
|
217 | subroutine get_scale(plag2) ! in :full_profile_profile:full_profile_profile.f | |||
|
|
218 | real dimension(16,75) :: plag2 | |||
|
|
219 | real dimension(91) :: densp | |||
|
|
220 | real dimension(91) :: tep | |||
|
|
221 | real dimension(91) :: trp | |||
|
|
222 | real dimension(91) :: tip | |||
|
|
223 | real dimension(91) :: hfp | |||
|
|
224 | real dimension(91) :: hefp | |||
|
|
225 | real dimension(91) :: altp | |||
|
|
226 | real :: r0 | |||
|
|
227 | real :: dr | |||
|
|
228 | real :: wl | |||
|
|
229 | real dimension(16,91) :: plag | |||
|
|
230 | real dimension(16,91) :: plag_errors | |||
|
|
231 | real :: sconst | |||
|
|
232 | real dimension(91) :: edensp | |||
|
|
233 | real dimension(91) :: etep | |||
|
|
234 | real dimension(91) :: etip | |||
|
|
235 | real dimension(91) :: ehfp | |||
|
|
236 | real dimension(91) :: ehefp | |||
|
|
237 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
238 | common /data/ plag,plag_errors | |||
|
|
239 | common /sys/ sconst | |||
|
|
240 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
241 | end subroutine get_scale | |||
|
|
242 | function enorm(n,x) ! in :full_profile_profile:lmdif1.f | |||
|
|
243 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
244 | real dimension(n) :: x | |||
|
|
245 | real :: enorm | |||
|
|
246 | end function enorm | |||
|
|
247 | subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa) ! in :full_profile_profile:lmdif1.f | |||
|
|
248 | use fdjac2__user__routines | |||
|
|
249 | external fcn | |||
|
|
250 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
251 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
252 | real dimension(n) :: x | |||
|
|
253 | real dimension(m) :: fvec | |||
|
|
254 | real dimension(ldfjac,n),depend(n) :: fjac | |||
|
|
255 | integer, optional,check(shape(fjac,0)==ldfjac),depend(fjac) :: ldfjac=shape(fjac,0) | |||
|
|
256 | integer :: iflag | |||
|
|
257 | real :: epsfcn | |||
|
|
258 | real dimension(m),depend(m) :: wa | |||
|
|
259 | end subroutine fdjac2 | |||
|
|
260 | subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn,diag,mode,factor,nprint,info,nfev,fjac,ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) ! in :full_profile_profile:lmdif1.f | |||
|
|
261 | use lmdif__user__routines | |||
|
|
262 | external fcn | |||
|
|
263 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
264 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
265 | real dimension(n) :: x | |||
|
|
266 | real dimension(m) :: fvec | |||
|
|
267 | real :: ftol | |||
|
|
268 | real :: xtol | |||
|
|
269 | real :: gtol | |||
|
|
270 | integer :: maxfev | |||
|
|
271 | real :: epsfcn | |||
|
|
272 | real dimension(n),depend(n) :: diag | |||
|
|
273 | integer :: mode | |||
|
|
274 | real :: factor | |||
|
|
275 | integer :: nprint | |||
|
|
276 | integer :: info | |||
|
|
277 | integer :: nfev | |||
|
|
278 | real dimension(ldfjac,n),depend(n) :: fjac | |||
|
|
279 | integer, optional,check(shape(fjac,0)==ldfjac),depend(fjac) :: ldfjac=shape(fjac,0) | |||
|
|
280 | integer dimension(n),depend(n) :: ipvt | |||
|
|
281 | real dimension(n),depend(n) :: qtf | |||
|
|
282 | real dimension(n),depend(n) :: wa1 | |||
|
|
283 | real dimension(n),depend(n) :: wa2 | |||
|
|
284 | real dimension(n),depend(n) :: wa3 | |||
|
|
285 | real dimension(m),depend(m) :: wa4 | |||
|
|
286 | end subroutine lmdif | |||
|
|
287 | subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag,wa1,wa2) ! in :full_profile_profile:lmdif1.f | |||
|
|
288 | integer, optional,check(shape(r,1)==n),depend(r) :: n=shape(r,1) | |||
|
|
289 | real dimension(ldr,n) :: r | |||
|
|
290 | integer, optional,check(shape(r,0)==ldr),depend(r) :: ldr=shape(r,0) | |||
|
|
291 | integer dimension(n),depend(n) :: ipvt | |||
|
|
292 | real dimension(n),depend(n) :: diag | |||
|
|
293 | real dimension(n),depend(n) :: qtb | |||
|
|
294 | real :: delta | |||
|
|
295 | real :: par | |||
|
|
296 | real dimension(n),depend(n) :: x | |||
|
|
297 | real dimension(n),depend(n) :: sdiag | |||
|
|
298 | real dimension(n),depend(n) :: wa1 | |||
|
|
299 | real dimension(n),depend(n) :: wa2 | |||
|
|
300 | end subroutine lmpar | |||
|
|
301 | subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) ! in :full_profile_profile:lmdif1.f | |||
|
|
302 | integer :: m | |||
|
|
303 | integer, optional,check(shape(a,1)==n),depend(a) :: n=shape(a,1) | |||
|
|
304 | real dimension(lda,n) :: a | |||
|
|
305 | integer, optional,check(shape(a,0)==lda),depend(a) :: lda=shape(a,0) | |||
|
|
306 | logical :: pivot | |||
|
|
307 | integer dimension(lipvt) :: ipvt | |||
|
|
308 | integer, optional,check(len(ipvt)>=lipvt),depend(ipvt) :: lipvt=len(ipvt) | |||
|
|
309 | real dimension(n),depend(n) :: rdiag | |||
|
|
310 | real dimension(n),depend(n) :: acnorm | |||
|
|
311 | real dimension(n),depend(n) :: wa | |||
|
|
312 | end subroutine qrfac | |||
|
|
313 | subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) ! in :full_profile_profile:lmdif1.f | |||
|
|
314 | integer, optional,check(shape(r,1)==n),depend(r) :: n=shape(r,1) | |||
|
|
315 | real dimension(ldr,n) :: r | |||
|
|
316 | integer, optional,check(shape(r,0)==ldr),depend(r) :: ldr=shape(r,0) | |||
|
|
317 | integer dimension(n),depend(n) :: ipvt | |||
|
|
318 | real dimension(n),depend(n) :: diag | |||
|
|
319 | real dimension(n),depend(n) :: qtb | |||
|
|
320 | real dimension(n),depend(n) :: x | |||
|
|
321 | real dimension(n),depend(n) :: sdiag | |||
|
|
322 | real dimension(n),depend(n) :: wa | |||
|
|
323 | end subroutine qrsolv | |||
|
|
324 | function spmpar(i) ! in :full_profile_profile:lmdif1.f | |||
|
|
325 | integer :: i | |||
|
|
326 | real :: spmpar | |||
|
|
327 | end function spmpar | |||
|
|
328 | function cdtr1(depth) ! in :full_profile_profile:fitacf.f | |||
|
|
329 | real :: depth | |||
|
|
330 | real :: cdtr1 | |||
|
|
331 | end function cdtr1 | |||
|
|
332 | function czte1(zlag,tr) ! in :full_profile_profile:fitacf.f | |||
|
|
333 | real :: zlag | |||
|
|
334 | real :: tr | |||
|
|
335 | real :: czte1 | |||
|
|
336 | end function czte1 | |||
|
|
337 | subroutine fcn(m,n,x,fvec,iflag) ! in :full_profile_profile:fitacf.f | |||
|
|
338 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
339 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
340 | real dimension(n) :: x | |||
|
|
341 | real dimension(m) :: fvec | |||
|
|
342 | integer :: iflag | |||
|
|
343 | real :: te | |||
|
|
344 | real dimension(10) :: ti | |||
|
|
345 | real dimension(10) :: fi | |||
|
|
346 | real :: ven | |||
|
|
347 | real dimension(10) :: vin | |||
|
|
348 | real :: alpha | |||
|
|
349 | real :: dens | |||
|
|
350 | real :: bfld | |||
|
|
351 | integer :: nion | |||
|
|
352 | integer dimension(10) :: wi | |||
|
|
353 | real :: ak | |||
|
|
354 | real dimension(100) :: tau | |||
|
|
355 | real dimension(100) :: rho | |||
|
|
356 | real dimension(100) :: sigma2 | |||
|
|
357 | real dimension(10) :: params | |||
|
|
358 | integer dimension(10) :: ifit | |||
|
|
359 | real :: chisq | |||
|
|
360 | real dimension(10000) :: ev | |||
|
|
361 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
362 | common /fitter/ tau,rho,sigma2,params,ifit | |||
|
|
363 | common /errs/ chisq | |||
|
|
364 | common /trans/ ev | |||
|
|
365 | end subroutine fcn | |||
|
|
366 | function cj_ion(theta,psi) ! in :full_profile_profile:fitacf.f | |||
|
|
367 | real :: theta | |||
|
|
368 | real :: psi | |||
|
|
369 | complex :: cj_ion | |||
|
|
370 | end function cj_ion | |||
|
|
371 | function cj_electron(theta,phi,psi,alpha) ! in :full_profile_profile:fitacf.f | |||
|
|
372 | real :: theta | |||
|
|
373 | real :: phi | |||
|
|
374 | real :: psi | |||
|
|
375 | real :: alpha | |||
|
|
376 | integer :: imode | |||
|
|
377 | complex :: cj_electron | |||
|
|
378 | common /mode/ imode | |||
|
|
379 | end function cj_electron | |||
|
|
380 | function y_ion(theta,psi) ! in :full_profile_profile:fitacf.f | |||
|
|
381 | real :: theta | |||
|
|
382 | real :: psi | |||
|
|
383 | complex :: y_ion | |||
|
|
384 | end function y_ion | |||
|
|
385 | function y_electron(theta,phi,psi,alpha) ! in :full_profile_profile:fitacf.f | |||
|
|
386 | real :: theta | |||
|
|
387 | real :: phi | |||
|
|
388 | real :: psi | |||
|
|
389 | real :: alpha | |||
|
|
390 | complex :: y_electron | |||
|
|
391 | end function y_electron | |||
|
|
392 | function spect1(omega) ! in :full_profile_profile:fitacf.f | |||
|
|
393 | real :: omega | |||
|
|
394 | real :: te | |||
|
|
395 | real dimension(10) :: ti | |||
|
|
396 | real dimension(10) :: fi | |||
|
|
397 | real :: ven | |||
|
|
398 | real dimension(10) :: vin | |||
|
|
399 | real :: alpha | |||
|
|
400 | real :: dens | |||
|
|
401 | real :: bfld | |||
|
|
402 | integer :: nion | |||
|
|
403 | integer dimension(10) :: wi | |||
|
|
404 | real :: ak | |||
|
|
405 | integer :: imode | |||
|
|
406 | real :: spect1 | |||
|
|
407 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
408 | common /mode/ imode | |||
|
|
409 | end function spect1 | |||
|
|
410 | subroutine acf2(wl,tau,te1,ti1,fi1,ven1,vin1,wi1,nion1,alpha1,dens1,bfld1,acf) ! in :full_profile_profile:fitacf.f | |||
|
|
411 | real :: wl | |||
|
|
412 | real :: tau | |||
|
|
413 | real :: te1 | |||
|
|
414 | real dimension(nion1) :: ti1 | |||
|
|
415 | real dimension(nion1),depend(nion1) :: fi1 | |||
|
|
416 | real :: ven1 | |||
|
|
417 | real dimension(nion1),depend(nion1) :: vin1 | |||
|
|
418 | integer dimension(nion1),depend(nion1) :: wi1 | |||
|
|
419 | integer, optional,check(len(ti1)>=nion1),depend(ti1) :: nion1=len(ti1) | |||
|
|
420 | real :: alpha1 | |||
|
|
421 | real :: dens1 | |||
|
|
422 | real :: bfld1 | |||
|
|
423 | real :: acf | |||
|
|
424 | real :: te | |||
|
|
425 | real dimension(10) :: ti | |||
|
|
426 | real dimension(10) :: fi | |||
|
|
427 | real :: ven | |||
|
|
428 | real dimension(10) :: vin | |||
|
|
429 | real :: alpha | |||
|
|
430 | real :: dens | |||
|
|
431 | real :: bfld | |||
|
|
432 | integer :: nion | |||
|
|
433 | integer dimension(10) :: wi | |||
|
|
434 | real :: ak | |||
|
|
435 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
436 | end subroutine acf2 | |||
|
|
437 | subroutine gaussq(tau,acf) ! in :full_profile_profile:fitacf.f | |||
|
|
438 | real :: tau | |||
|
|
439 | real :: acf | |||
|
|
440 | real :: te | |||
|
|
441 | real dimension(10) :: ti | |||
|
|
442 | real dimension(10) :: fi | |||
|
|
443 | real :: ven | |||
|
|
444 | real dimension(10) :: vin | |||
|
|
445 | real :: alpha | |||
|
|
446 | real :: dens | |||
|
|
447 | real :: bfld | |||
|
|
448 | integer :: nion | |||
|
|
449 | integer dimension(10) :: wi | |||
|
|
450 | real :: ak | |||
|
|
451 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
452 | end subroutine gaussq | |||
|
|
453 | subroutine lagp(plag,wl,r0,dr,nl,nrange) ! in :full_profile_profile:lagp.f | |||
|
|
454 | real dimension(nl,nrange) :: plag | |||
|
|
455 | real :: wl | |||
|
|
456 | real :: r0 | |||
|
|
457 | real :: dr | |||
|
|
458 | integer, optional,check(shape(plag,0)==nl),depend(plag) :: nl=shape(plag,0) | |||
|
|
459 | integer, optional,check(shape(plag,1)==nrange),depend(plag) :: nrange=shape(plag,1) | |||
|
|
460 | real :: te | |||
|
|
461 | real dimension(10) :: ti | |||
|
|
462 | real dimension(10) :: fi | |||
|
|
463 | real :: ven | |||
|
|
464 | real dimension(10) :: vin | |||
|
|
465 | real :: alpha | |||
|
|
466 | real :: dens | |||
|
|
467 | real :: bfld | |||
|
|
468 | integer :: nion | |||
|
|
469 | integer dimension(10) :: wi | |||
|
|
470 | real :: ak | |||
|
|
471 | real dimension(34) :: ta | |||
|
|
472 | real dimension(30,5) :: bcoef | |||
|
|
473 | real dimension(85) :: bfld_prof | |||
|
|
474 | real dimension(85) :: alpha_prof | |||
|
|
475 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
476 | common /spline/ ta,bcoef | |||
|
|
477 | common /mag/ bfld_prof,alpha_prof | |||
|
|
478 | end subroutine lagp | |||
|
|
479 | function atanh(x) ! in :full_profile_profile:lagp.f | |||
|
|
480 | real :: x | |||
|
|
481 | real :: atanh | |||
|
|
482 | end function atanh | |||
|
|
483 | subroutine get_spline(alt,dens,te,ti,hf,hef) ! in :full_profile_profile:lagp.f | |||
|
|
484 | real :: alt | |||
|
|
485 | real :: dens | |||
|
|
486 | real :: te | |||
|
|
487 | real :: ti | |||
|
|
488 | real :: hf | |||
|
|
489 | real :: hef | |||
|
|
490 | real dimension(34) :: ta | |||
|
|
491 | real dimension(30,5) :: bcoef | |||
|
|
492 | common /spline/ ta,bcoef | |||
|
|
493 | end subroutine get_spline | |||
|
|
494 | function bvalue(t,bcoef,n,k,x,jderiv) ! in :full_profile_profile:lagp.f | |||
|
|
495 | real dimension(n+k),depend(n,k) :: t | |||
|
|
496 | real dimension(n) :: bcoef | |||
|
|
497 | integer, optional,check(len(bcoef)>=n),depend(bcoef) :: n=len(bcoef) | |||
|
|
498 | integer :: k | |||
|
|
499 | real :: x | |||
|
|
500 | integer :: jderiv | |||
|
|
501 | real :: bvalue | |||
|
|
502 | end function bvalue | |||
|
|
503 | subroutine interv(xt,lxt,x,left,mflag) ! in :full_profile_profile:lagp.f | |||
|
|
504 | real dimension(lxt) :: xt | |||
|
|
505 | integer, optional,check(len(xt)>=lxt),depend(xt) :: lxt=len(xt) | |||
|
|
506 | real :: x | |||
|
|
507 | integer :: left | |||
|
|
508 | integer :: mflag | |||
|
|
509 | end subroutine interv | |||
|
|
510 | function r1mach(i) ! in :full_profile_profile:r1mach.f | |||
|
|
511 | integer :: i | |||
|
|
512 | integer :: cray1 | |||
|
|
513 | real :: r1mach | |||
|
|
514 | common /d8mach/ cray1 | |||
|
|
515 | end function r1mach | |||
|
|
516 | end interface | |||
|
|
517 | end python module full_profile_profile | |||
|
|
518 | ||||
|
|
519 | ! This file was auto-generated with f2py (version:2). | |||
|
|
520 | ! See http://cens.ioc.ee/projects/f2py2e/ | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | float **array2(int m, int n){ | |||
|
|
2 | ||||
|
|
3 | int i,j; | |||
|
|
4 | float **temp; | |||
|
|
5 | ||||
|
|
6 | temp=(float **)malloc(sizeof(double)*m); | |||
|
|
7 | ||||
|
|
8 | temp[0]=(float *)malloc(sizeof(double)*m*n); | |||
|
|
9 | for(j=1;j<m;j++){ | |||
|
|
10 | temp[j]=temp[j-1]+n; | |||
|
|
11 | } | |||
|
|
12 | ||||
|
|
13 | return temp; | |||
|
|
14 | } | |||
|
|
15 | ||||
|
|
16 | ||||
|
|
17 | float ***array3(int m, int n, int l){ | |||
|
|
18 | ||||
|
|
19 | int i,j; | |||
|
|
20 | float ***temp; | |||
|
|
21 | ||||
|
|
22 | temp=(float ***)malloc(sizeof(double)*m); | |||
|
|
23 | temp[0]=(float **)malloc(sizeof(double)*m*n); | |||
|
|
24 | for(j=1;j<m;j++){ | |||
|
|
25 | temp[j]=temp[j-1]+n; | |||
|
|
26 | } | |||
|
|
27 | temp[0][0]=(float *)malloc(sizeof(double)*l*n*m);; | |||
|
|
28 | for(j=0;j<m;j++) | |||
|
|
29 | for(i=0;i<n;i++){ | |||
|
|
30 | temp[j][i]=temp[0][0]+ l*(i+n*j); | |||
|
|
31 | } | |||
|
|
32 | return temp; | |||
|
|
33 | } | |||
|
|
34 | ||||
|
|
35 | fcomplex **carray2(int m, int n){ | |||
|
|
36 | ||||
|
|
37 | int i,j; | |||
|
|
38 | fcomplex **temp; | |||
|
|
39 | ||||
|
|
40 | temp=(fcomplex **)malloc(sizeof(fcomplex)*m); | |||
|
|
41 | ||||
|
|
42 | temp[0]=(fcomplex *)malloc(sizeof(fcomplex)*m*n); | |||
|
|
43 | for(j=1;j<m;j++){ | |||
|
|
44 | temp[j]=temp[j-1]+n; | |||
|
|
45 | } | |||
|
|
46 | ||||
|
|
47 | return temp; | |||
|
|
48 | } | |||
|
|
49 | ||||
|
|
50 | ||||
|
|
51 | fcomplex ***carray3(int m, int n, int l){ | |||
|
|
52 | ||||
|
|
53 | int i,j; | |||
|
|
54 | fcomplex ***temp; | |||
|
|
55 | ||||
|
|
56 | temp=(fcomplex ***)malloc(sizeof(fcomplex)*m); | |||
|
|
57 | temp[0]=(fcomplex **)malloc(sizeof(fcomplex)*m*n); | |||
|
|
58 | for(j=1;j<m;j++){ | |||
|
|
59 | temp[j]=temp[j-1]+n; | |||
|
|
60 | } | |||
|
|
61 | temp[0][0]=(fcomplex *)malloc(sizeof(fcomplex)*l*n*m);; | |||
|
|
62 | for(j=0;j<m;j++) | |||
|
|
63 | for(i=0;i<n;i++){ | |||
|
|
64 | temp[j][i]=temp[0][0]+ l*(i+n*j); | |||
|
|
65 | } | |||
|
|
66 | return temp; | |||
|
|
67 | } | |||
| @@ -0,0 +1,3 | |||||
|
|
1 | parameter(nfield=85) ! should be nrange+10 or more | |||
|
|
2 | real bfld_prof(nfield),alpha_prof(nfield) | |||
|
|
3 | common/mag/bfld_prof,alpha_prof | |||
| This diff has been collapsed as it changes many lines, (676 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,676 | |||||
|
|
1 | subroutine geobfield(tm,r,theta,phi,br,bt,bp,b) | |||
|
|
2 | c*****evaluate bfield at geocentric coords r,theta,phi | |||
|
|
3 | c and return components of field in r,theta and phi directions | |||
|
|
4 | c and magnitude | |||
|
|
5 | c*****theta and phi are in radians, r is in km, b is in gauss | |||
|
|
6 | c =============================================================== | |||
|
|
7 | c | |||
|
|
8 | c essentially, this is an adaptation of igrfdemo. it interpolates | |||
|
|
9 | c smoothly between the coefficients from 1945 to 1985. | |||
|
|
10 | c | |||
|
|
11 | c subroutines: | |||
|
|
12 | c getshc, interpshc, extrapshc, shval3 | |||
|
|
13 | c | |||
|
|
14 | c igrfdemo is due to: | |||
|
|
15 | c a. zunde | |||
|
|
16 | c usgs, ms 964, box 25046 federal center, denver, co 80225 | |||
|
|
17 | c | |||
|
|
18 | c =============================================================== | |||
|
|
19 | character*8 filmod(17) | |||
|
|
20 | c character*31 fqual | |||
|
|
21 | dimension gh1(220), gh2(220), gha(224), ext(3), dtemod(17) | |||
|
|
22 | data ext /3*0./ | |||
|
|
23 | data filmod / 'dgrf45', 'dgrf50', | |||
|
|
24 | 1 'dgrf55', 'dgrf60', 'dgrf65', | |||
|
|
25 | 2 'dgrf70', 'dgrf75', 'dgrf80', | |||
|
|
26 | 3 'dgrf85', 'dgrf90', 'dgrf95', | |||
|
|
27 | 4 'dgrf00', 'dgrf05', 'dgrf10', | |||
|
|
28 | 5 'dgrf15', 'igrf20', 'igrf20s'/ | |||
|
|
29 | c data fqual/"/usr/local/lib/faraday/bfmodel/"/ | |||
|
|
30 | data dtemod / 1945., 1950., 1955., 1960., | |||
|
|
31 | 1 1965., 1970., 1975., 1980., 1985., 1990., 1995., 2000., | |||
|
|
32 | 2 2005.,2010.,2015.,2020.,2025./ | |||
|
|
33 | data iu/98/,ndt/17/ | |||
|
|
34 | c data a2/40680925./, b2/40408588./ | |||
|
|
35 | data a2/40680631.6/, b2/40408296.0/ ! updated 2010 | |||
|
|
36 | c | |||
|
|
37 | data rtd/57.29577951/ | |||
|
|
38 | data tmp/0./,lp/0/ | |||
|
|
39 | character(1024) :: fqual_temp | |||
|
|
40 | character(:), allocatable :: fqual | |||
|
|
41 | call get_path(fqual_temp) | |||
|
|
42 | c write(*,*) "L_BEF: ", fqual_temp, "L_BEF_end" | |||
|
|
43 | fqual = TRIM(fqual_temp) | |||
|
|
44 | c write(*,*) "L: ", fqual, "L_end" | |||
|
|
45 | ||||
|
|
46 | flat=90. - theta*rtd | |||
|
|
47 | flon=rtd*phi | |||
|
|
48 | c*****if previous time is not equal to current time | |||
|
|
49 | if(tm .ne. tmp)then | |||
|
|
50 | l=0 | |||
|
|
51 | C for i=1,ndt | |||
|
|
52 | DO 1010 i=1,ndt | |||
|
|
53 | C exit for if(tm .lt. dtemod(i)) | |||
|
|
54 | if(tm .lt. dtemod(i)) GO TO 1011 | |||
|
|
55 | l=i | |||
|
|
56 | C end for | |||
|
|
57 | 1010 CONTINUE | |||
|
|
58 | 1011 CONTINUE | |||
|
|
59 | c write(*,-)tm,l | |||
|
|
60 | if(l .eq. 0)then | |||
|
|
61 | write(*,fmt='(" geobfield: time is before earliest model.")') | |||
|
|
62 | stop | |||
|
|
63 | end if | |||
|
|
64 | if(l .eq. ndt)then | |||
|
|
65 | l=l-1 | |||
|
|
66 | write(*,fmt='(" geobfield: warning - extrapolating beyond ", | |||
|
|
67 | 1 "last set of coefficients.")') | |||
|
|
68 | end if | |||
|
|
69 | if(l .ne. lp)then | |||
|
|
70 | c*********if previous epoch not the same, read in new coefs | |||
|
|
71 | c write(*,fmt='(" read coefs"))') | |||
|
|
72 | c write(*,*) "filmod", fqual//filmod(l) | |||
|
|
73 | call getshc2 (iu, fqual//filmod(l), nmax1, erad, gh1, ier) | |||
|
|
74 | c write(*,*) "AA: ", ier, filmod(l) | |||
|
|
75 | if(ier .ne. 0)then | |||
|
|
76 | write(*,fmt='(" geobfield: read error=",i2," on ",a)') | |||
|
|
77 | 1 ier,filmod(l) | |||
|
|
78 | stop | |||
|
|
79 | end if | |||
|
|
80 | ||||
|
|
81 | call getshc2 (iu, fqual//filmod(l+1), nmax2, erad, gh2, ier) | |||
|
|
82 | if(ier .ne. 0)then | |||
|
|
83 | write(*,fmt='(" geobfield: read error=",i2," on ",a)') | |||
|
|
84 | 1 ier,filmod(l+1) | |||
|
|
85 | stop | |||
|
|
86 | end if | |||
|
|
87 | end if | |||
|
|
88 | if (l .lt. ndt-1) then | |||
|
|
89 | call interpshc (tm, dtemod(l), nmax1, gh1, dtemod(l+1), | |||
|
|
90 | 1 nmax2, gh2, nmax, gha) | |||
|
|
91 | c write(*,fmt='(" interpolate"))') | |||
|
|
92 | else | |||
|
|
93 | call extrapshc (tm, dtemod(l), nmax1, gh1, nmax2, | |||
|
|
94 | 1 gh2, nmax, gha) | |||
|
|
95 | c write(*,fmt='(" extrapolate"))') | |||
|
|
96 | end if | |||
|
|
97 | end if | |||
|
|
98 | c tmp=tm | |||
|
|
99 | c lp=l | |||
|
|
100 | call shval3(2,flat,flon,r,erad,a2,b2,nmax,gha,0,ext,x,y,z) | |||
|
|
101 | br=-z/100000. | |||
|
|
102 | bp=y/100000. | |||
|
|
103 | bt=-x/100000. | |||
|
|
104 | b=sqrt(br**2 + bp**2 + bt**2) | |||
|
|
105 | ||||
|
|
106 | C write(*,*)flat,flon,r,erad,a2,b2,nmax,gha,ext | |||
|
|
107 | C write(*,*)tm,r,theta,phi,br,bt,bp,b | |||
|
|
108 | return | |||
|
|
109 | end | |||
|
|
110 | c | |||
|
|
111 | subroutine convrt(i, gdlat, gdalt, gclat, rkm) | |||
|
|
112 | ||||
|
|
113 | c convrt converts between geodetic and geocentric coordinates. the | |||
|
|
114 | c reference geoid is that adopted by the iau in 1964. a=6378.16, | |||
|
|
115 | c b=6356.7746, f=1/298.25. the equations for conversion from | |||
|
|
116 | c geocentric to geodetic are from astron. j., vol 66, 1961, p. 15. | |||
|
|
117 | ||||
|
|
118 | c i=1 geodetic to geocentric | |||
|
|
119 | c i=2 geocentric to geodetic | |||
|
|
120 | c gdlat geodetic latitude (degrees) | |||
|
|
121 | c gdalt altitude above geoid (km) | |||
|
|
122 | c gclat geocentric latitude (degrees) | |||
|
|
123 | c rkm geocentric radial distance (km) | |||
|
|
124 | c | |||
|
|
125 | c data a/6378.16/, ab2/1.0067397/, ep2/.0067397/ | |||
|
|
126 | c update 2010 | |||
|
|
127 | data a/6378.137/, ab2/1.0067396/, ep2/.0067396/ | |||
|
|
128 | data dtr/.0174532925199/ | |||
|
|
129 | ||||
|
|
130 | if (i .eq. 1) then | |||
|
|
131 | ||||
|
|
132 | c .....geodetic to geocentric..... | |||
|
|
133 | ||||
|
|
134 | gdl = dtr*gdlat | |||
|
|
135 | sinlat = sin(gdl) | |||
|
|
136 | coslat = cos(gdl) | |||
|
|
137 | sl2 = sinlat*sinlat | |||
|
|
138 | cl2 = ab2*coslat | |||
|
|
139 | cl2 = cl2*cl2 | |||
|
|
140 | sinbet = sinlat/sqrt(sl2+cl2) | |||
|
|
141 | sb2 = amin1(sinbet*sinbet, 1.) | |||
|
|
142 | cosbet = sqrt(1. - sb2) | |||
|
|
143 | rgeoid = a/sqrt(1. + ep2*sb2) | |||
|
|
144 | x = rgeoid*cosbet + gdalt*coslat | |||
|
|
145 | y = rgeoid*sinbet + gdalt*sinlat | |||
|
|
146 | rkm = sqrt(x*x + y*y) | |||
|
|
147 | gclat = atan2(y,x)/dtr | |||
|
|
148 | return | |||
|
|
149 | ||||
|
|
150 | else if (i .eq. 2) then | |||
|
|
151 | ||||
|
|
152 | c .....geocentric to geodetic..... | |||
|
|
153 | ||||
|
|
154 | rer = rkm/a | |||
|
|
155 | a2 = ((-1.4127348e-8/rer + .94339131e-8)/rer + | |||
|
|
156 | 1 .33523288e-2)/rer | |||
|
|
157 | a4 = (((-1.2545063e-10/rer + .11760996e-9)/rer + | |||
|
|
158 | 1 .11238084e-4)/rer - .2814244e-5)/rer | |||
|
|
159 | a6 = ((54.939685e-9/rer - 28.301730e-9)/rer + | |||
|
|
160 | 1 3.5435979e-9)/rer | |||
|
|
161 | a8 = (((320./rer - 252.)/rer + 64.)/rer - 5.) | |||
|
|
162 | 1 /rer*0.98008304e-12 | |||
|
|
163 | gcl = dtr*gclat | |||
|
|
164 | ccl = cos(gcl) | |||
|
|
165 | scl = sin(gcl) | |||
|
|
166 | s2cl = 2.*scl*ccl | |||
|
|
167 | c2cl = 2.*ccl*ccl - 1. | |||
|
|
168 | s4cl = 2.*s2cl*c2cl | |||
|
|
169 | c4cl = 2.*c2cl*c2cl - 1. | |||
|
|
170 | s8cl = 2.*s4cl*c4cl | |||
|
|
171 | s6cl = s2cl*c4cl + c2cl*s4cl | |||
|
|
172 | dltcl = s2cl*a2 + s4cl*a4 + s6cl*a6 + s8cl*a8 | |||
|
|
173 | gdlat = gclat + dltcl/dtr | |||
|
|
174 | gdalt = rkm - a/sqrt(1.+ep2*scl*scl) | |||
|
|
175 | return | |||
|
|
176 | ||||
|
|
177 | end if | |||
|
|
178 | end | |||
|
|
179 | c | |||
|
|
180 | subroutine getshc2 (iu, fspec, nmax, erad, gh, ier) | |||
|
|
181 | ||||
|
|
182 | c =============================================================== | |||
|
|
183 | c | |||
|
|
184 | c version 1.01 | |||
|
|
185 | c | |||
|
|
186 | c reads spherical harmonic coefficients from the specified | |||
|
|
187 | c file into an array. | |||
|
|
188 | c | |||
|
|
189 | c input: | |||
|
|
190 | c iu - logical unit number | |||
|
|
191 | c fspec - file specification | |||
|
|
192 | c | |||
|
|
193 | c output: | |||
|
|
194 | c nmax - maximum degree and order of model | |||
|
|
195 | c erad - earth's radius associated with the spherical | |||
|
|
196 | c harmonic coefficients, in the same units as | |||
|
|
197 | c elevation | |||
|
|
198 | c gh - schmidt quasi-normal internal spherical | |||
|
|
199 | c harmonic coefficients | |||
|
|
200 | c ier - error number: = 0, no error | |||
|
|
201 | c = -2, records out of order | |||
|
|
202 | c = fortran run-time error number | |||
|
|
203 | c | |||
|
|
204 | c a. zunde | |||
|
|
205 | c usgs, ms 964, box 25046 federal center, denver, co 80225 | |||
|
|
206 | c | |||
|
|
207 | c =============================================================== | |||
|
|
208 | ||||
|
|
209 | character fspec*(*) | |||
|
|
210 | dimension gh(*) | |||
|
|
211 | ||||
|
|
212 | c --------------------------------------------------------------- | |||
|
|
213 | c open coefficient file. read past first header record. | |||
|
|
214 | c read degree and order of model and earth's radius. | |||
|
|
215 | c --------------------------------------------------------------- | |||
|
|
216 | ||||
|
|
217 | ||||
|
|
218 | open (iu, file=fspec, status='old', iostat=ier, err=999 ) | |||
|
|
219 | ||||
|
|
220 | ||||
|
|
221 | read (iu, *, iostat=ier, err=999) | |||
|
|
222 | read (iu, *, iostat=ier, err=999) nmax, erad | |||
|
|
223 | ||||
|
|
224 | ||||
|
|
225 | c --------------------------------------------------------------- | |||
|
|
226 | c read the coefficient file, arranged as follows: | |||
|
|
227 | c | |||
|
|
228 | c n m g h | |||
|
|
229 | c ---------------------- | |||
|
|
230 | c / 1 0 gh(1) - | |||
|
|
231 | c / 1 1 gh(2) gh(3) | |||
|
|
232 | c / 2 0 gh(4) - | |||
|
|
233 | c / 2 1 gh(5) gh(6) | |||
|
|
234 | c nmax*(nmax+3)/2 / 2 2 gh(7) gh(8) | |||
|
|
235 | c records \ 3 0 gh(9) - | |||
|
|
236 | c \ . . . . | |||
|
|
237 | c \ . . . . | |||
|
|
238 | c nmax*(nmax+2) \ . . . . | |||
|
|
239 | c elements in gh \ nmax nmax . . | |||
|
|
240 | c | |||
|
|
241 | c n and m are, respectively, the degree and order of the | |||
|
|
242 | c coefficient. | |||
|
|
243 | c --------------------------------------------------------------- | |||
|
|
244 | ||||
|
|
245 | i = 0 | |||
|
|
246 | C for nn = 1, nmax | |||
|
|
247 | DO 1010 nn = 1, nmax | |||
|
|
248 | C for mm = 0, nn | |||
|
|
249 | DO 1020 mm = 0, nn | |||
|
|
250 | read (iu, *, iostat=ier, err=999) n, m, g, h | |||
|
|
251 | c write(*,*) n,m,g,h,nn,nmax,mm,ier | |||
|
|
252 | if (nn .ne. n .or. mm .ne. m) then | |||
|
|
253 | ier = -2 | |||
|
|
254 | goto 999 | |||
|
|
255 | endif | |||
|
|
256 | i = i + 1 | |||
|
|
257 | gh(i) = g | |||
|
|
258 | if (m .ne. 0) then | |||
|
|
259 | i = i + 1 | |||
|
|
260 | gh(i) = h | |||
|
|
261 | endif | |||
|
|
262 | C end for | |||
|
|
263 | 1020 CONTINUE | |||
|
|
264 | 1021 CONTINUE | |||
|
|
265 | C end for | |||
|
|
266 | 1010 CONTINUE | |||
|
|
267 | 1011 CONTINUE | |||
|
|
268 | ||||
|
|
269 | 999 close (iu) | |||
|
|
270 | ||||
|
|
271 | return | |||
|
|
272 | end | |||
|
|
273 | c | |||
|
|
274 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bfieldsr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||
|
|
275 | c | |||
|
|
276 | subroutine interpshc (date, dte1, nmax1, gh1, dte2, | |||
|
|
277 | 1 nmax2, gh2, nmax, gh) | |||
|
|
278 | ||||
|
|
279 | c =============================================================== | |||
|
|
280 | c | |||
|
|
281 | c version 1.01 | |||
|
|
282 | c | |||
|
|
283 | c interpolates linearly, in time, between two spherical | |||
|
|
284 | c harmonic models. | |||
|
|
285 | c | |||
|
|
286 | c input: | |||
|
|
287 | c date - date of resulting model (in decimal year) | |||
|
|
288 | c dte1 - date of earlier model | |||
|
|
289 | c nmax1 - maximum degree and order of earlier model | |||
|
|
290 | c gh1 - schmidt quasi-normal internal spherical | |||
|
|
291 | c harmonic coefficients of earlier model | |||
|
|
292 | c dte2 - date of later model | |||
|
|
293 | c nmax2 - maximum degree and order of later model | |||
|
|
294 | c gh2 - schmidt quasi-normal internal spherical | |||
|
|
295 | c harmonic coefficients of later model | |||
|
|
296 | c | |||
|
|
297 | c output: | |||
|
|
298 | c gh - coefficients of resulting model | |||
|
|
299 | c nmax - maximum degree and order of resulting model | |||
|
|
300 | c | |||
|
|
301 | c a. zunde | |||
|
|
302 | c usgs, ms 964, box 25046 federal center, denver, co 80225 | |||
|
|
303 | c | |||
|
|
304 | c =============================================================== | |||
|
|
305 | ||||
|
|
306 | dimension gh1(*), gh2(*), gh(*) | |||
|
|
307 | ||||
|
|
308 | c --------------------------------------------------------------- | |||
|
|
309 | c the coefficients (gh) of the resulting model, at date | |||
|
|
310 | c date, are computed by linearly interpolating between the | |||
|
|
311 | c coefficients of the earlier model (gh1), at date dte1, | |||
|
|
312 | c and those of the later model (gh2), at date dte2. if one | |||
|
|
313 | c model is smaller than the other, the interpolation is | |||
|
|
314 | c performed with the missing coefficients assumed to be 0. | |||
|
|
315 | c --------------------------------------------------------------- | |||
|
|
316 | ||||
|
|
317 | factor = (date - dte1) / (dte2 - dte1) | |||
|
|
318 | ||||
|
|
319 | if (nmax1 .eq. nmax2) then | |||
|
|
320 | k = nmax1 * (nmax1 + 2) | |||
|
|
321 | nmax = nmax1 | |||
|
|
322 | else if (nmax1 .gt. nmax2) then | |||
|
|
323 | k = nmax2 * (nmax2 + 2) | |||
|
|
324 | l = nmax1 * (nmax1 + 2) | |||
|
|
325 | C for i = k + 1, l | |||
|
|
326 | DO 1010 i = k + 1, l | |||
|
|
327 | gh(i) = gh1(i) + factor * (-gh1(i)) | |||
|
|
328 | C end for | |||
|
|
329 | 1010 CONTINUE | |||
|
|
330 | 1011 CONTINUE | |||
|
|
331 | nmax = nmax1 | |||
|
|
332 | else | |||
|
|
333 | k = nmax1 * (nmax1 + 2) | |||
|
|
334 | l = nmax2 * (nmax2 + 2) | |||
|
|
335 | C for i = k + 1, l | |||
|
|
336 | DO 1020 i = k + 1, l | |||
|
|
337 | gh(i) = factor * gh2(i) | |||
|
|
338 | C end for | |||
|
|
339 | 1020 CONTINUE | |||
|
|
340 | 1021 CONTINUE | |||
|
|
341 | nmax = nmax2 | |||
|
|
342 | endif | |||
|
|
343 | ||||
|
|
344 | C for i = 1, k | |||
|
|
345 | DO 1030 i = 1, k | |||
|
|
346 | gh(i) = gh1(i) + factor * (gh2(i) - gh1(i)) | |||
|
|
347 | C end for | |||
|
|
348 | 1030 CONTINUE | |||
|
|
349 | 1031 CONTINUE | |||
|
|
350 | ||||
|
|
351 | return | |||
|
|
352 | end | |||
|
|
353 | c | |||
|
|
354 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bfieldsr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||
|
|
355 | c | |||
|
|
356 | subroutine extrapshc (date, dte1, nmax1, gh1, nmax2, | |||
|
|
357 | 1 gh2, nmax, gh) | |||
|
|
358 | ||||
|
|
359 | c =============================================================== | |||
|
|
360 | c | |||
|
|
361 | c version 1.01 | |||
|
|
362 | c | |||
|
|
363 | c extrapolates linearly a spherical harmonic model with a | |||
|
|
364 | c rate-of-change model. | |||
|
|
365 | c | |||
|
|
366 | c input: | |||
|
|
367 | c date - date of resulting model (in decimal year) | |||
|
|
368 | c dte1 - date of base model | |||
|
|
369 | c nmax1 - maximum degree and order of base model | |||
|
|
370 | c gh1 - schmidt quasi-normal internal spherical | |||
|
|
371 | c harmonic coefficients of base model | |||
|
|
372 | c nmax2 - maximum degree and order of rate-of-change | |||
|
|
373 | c model | |||
|
|
374 | c gh2 - schmidt quasi-normal internal spherical | |||
|
|
375 | c harmonic coefficients of rate-of-change model | |||
|
|
376 | c | |||
|
|
377 | c output: | |||
|
|
378 | c gh - coefficients of resulting model | |||
|
|
379 | c nmax - maximum degree and order of resulting model | |||
|
|
380 | c | |||
|
|
381 | c a. zunde | |||
|
|
382 | c usgs, ms 964, box 25046 federal center, denver, co 80225 | |||
|
|
383 | c | |||
|
|
384 | c =============================================================== | |||
|
|
385 | ||||
|
|
386 | dimension gh1(*), gh2(*), gh(*) | |||
|
|
387 | ||||
|
|
388 | c --------------------------------------------------------------- | |||
|
|
389 | c the coefficients (gh) of the resulting model, at date | |||
|
|
390 | c date, are computed by linearly extrapolating the coef- | |||
|
|
391 | c ficients of the base model (gh1), at date dte1, using | |||
|
|
392 | c those of the rate-of-change model (gh2), at date dte2. if | |||
|
|
393 | c one model is smaller than the other, the extrapolation is | |||
|
|
394 | c performed with the missing coefficients assumed to be 0. | |||
|
|
395 | c --------------------------------------------------------------- | |||
|
|
396 | ||||
|
|
397 | factor = (date - dte1) | |||
|
|
398 | ||||
|
|
399 | if (nmax1 .eq. nmax2) then | |||
|
|
400 | k = nmax1 * (nmax1 + 2) | |||
|
|
401 | nmax = nmax1 | |||
|
|
402 | else if (nmax1 .gt. nmax2) then | |||
|
|
403 | k = nmax2 * (nmax2 + 2) | |||
|
|
404 | l = nmax1 * (nmax1 + 2) | |||
|
|
405 | C for i = k + 1, l | |||
|
|
406 | DO 1010 i = k + 1, l | |||
|
|
407 | gh(i) = gh1(i) | |||
|
|
408 | C end for | |||
|
|
409 | 1010 CONTINUE | |||
|
|
410 | 1011 CONTINUE | |||
|
|
411 | nmax = nmax1 | |||
|
|
412 | else | |||
|
|
413 | k = nmax1 * (nmax1 + 2) | |||
|
|
414 | l = nmax2 * (nmax2 + 2) | |||
|
|
415 | C for i = k + 1, l | |||
|
|
416 | DO 1020 i = k + 1, l | |||
|
|
417 | gh(i) = factor * gh2(i) | |||
|
|
418 | C end for | |||
|
|
419 | 1020 CONTINUE | |||
|
|
420 | 1021 CONTINUE | |||
|
|
421 | nmax = nmax2 | |||
|
|
422 | endif | |||
|
|
423 | ||||
|
|
424 | C for i = 1, k | |||
|
|
425 | DO 1030 i = 1, k | |||
|
|
426 | gh(i) = gh1(i) + factor * gh2(i) | |||
|
|
427 | C end for | |||
|
|
428 | 1030 CONTINUE | |||
|
|
429 | 1031 CONTINUE | |||
|
|
430 | ||||
|
|
431 | return | |||
|
|
432 | end | |||
|
|
433 | c | |||
|
|
434 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bfieldsr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||
|
|
435 | c | |||
|
|
436 | subroutine shval3 (igdgc, flat, flon, elev, erad, a2, b2, | |||
|
|
437 | 1 nmax, gh, iext, ext, x, y, z) | |||
|
|
438 | ||||
|
|
439 | c ================================================================ | |||
|
|
440 | c | |||
|
|
441 | c version 1.01 | |||
|
|
442 | c | |||
|
|
443 | c calculates field components from spherical harmonic (sh) | |||
|
|
444 | c models. | |||
|
|
445 | c | |||
|
|
446 | c input: | |||
|
|
447 | c igdgc - indicates coordinate system used; set equal to | |||
|
|
448 | c 1 if geodetic, 2 if geocentric | |||
|
|
449 | c flat - north latitude, in degrees | |||
|
|
450 | c flon - east longitude, in degrees | |||
|
|
451 | c elev - elevation above mean sea level (igdgc=1), or | |||
|
|
452 | c radial distance from earth's center (igdgc=2) | |||
|
|
453 | c erad - value of earth's radius associated with the sh | |||
|
|
454 | c coefficients, in same units as elev | |||
|
|
455 | c a2,b2 - squares of semi-major and semi-minor axes of | |||
|
|
456 | c the reference spheroid used for transforming | |||
|
|
457 | c between geodetic and geocentric coordinates or | |||
|
|
458 | c components | |||
|
|
459 | c nmax - maximum degree and order of coefficients | |||
|
|
460 | c gh - schmidt quasi-normal internal spherical | |||
|
|
461 | c harmonic coefficients | |||
|
|
462 | c iext - external coefficients flag (= 0 if none) | |||
|
|
463 | c ext - the three 1st-degree external coefficients | |||
|
|
464 | c (not used if iext = 0) | |||
|
|
465 | c | |||
|
|
466 | c output: | |||
|
|
467 | c x - northward component | |||
|
|
468 | c y - eastward component | |||
|
|
469 | c z - vertically-downward component | |||
|
|
470 | c | |||
|
|
471 | c based on subroutine "igrf" by d. r. barraclough and | |||
|
|
472 | c s. r. c. malin, report no. 71/1, institute of geological | |||
|
|
473 | c sciences, u.k. | |||
|
|
474 | c | |||
|
|
475 | c norman w. peddie, u.s. geological survey, mail stop 964, | |||
|
|
476 | c federal center, box 25046, denver, colorado 80225 | |||
|
|
477 | c | |||
|
|
478 | c ================================================================ | |||
|
|
479 | ||||
|
|
480 | c the required sizes of the arrays used in this subroutine | |||
|
|
481 | c depend on the value of nmax. the minimum dimensions | |||
|
|
482 | c needed are indicated in the table below. (note that this | |||
|
|
483 | c version is dimensioned for nmax of 14 or less). | |||
|
|
484 | c | |||
|
|
485 | c minimum dimension | |||
|
|
486 | c -------------------------- | |||
|
|
487 | c nmax | |||
|
|
488 | dimension sl(14), cl(14) | |||
|
|
489 | c (nmax * (nmax + 3)) / 2 | |||
|
|
490 | dimension p(119), q(119) | |||
|
|
491 | c nmax * (nmax + 2) | |||
|
|
492 | dimension gh(224) | |||
|
|
493 | c 3 | |||
|
|
494 | dimension ext(3) | |||
|
|
495 | ||||
|
|
496 | c ================================================================ | |||
|
|
497 | ||||
|
|
498 | parameter (dtr = .01745329) | |||
|
|
499 | ||||
|
|
500 | r = elev | |||
|
|
501 | slat = sin (flat * dtr) | |||
|
|
502 | if (90. - flat .lt. .001) then | |||
|
|
503 | c 300 ft from n. pole | |||
|
|
504 | aa = 89.999 | |||
|
|
505 | else if (90. + flat .lt. .001) then | |||
|
|
506 | c 300 ft from s. pole | |||
|
|
507 | aa = -89.999 | |||
|
|
508 | else | |||
|
|
509 | aa = flat | |||
|
|
510 | endif | |||
|
|
511 | clat = cos (aa * dtr) | |||
|
|
512 | sl(1) = sin (flon * dtr) | |||
|
|
513 | cl(1) = cos (flon * dtr) | |||
|
|
514 | x = 0. | |||
|
|
515 | y = 0. | |||
|
|
516 | z = 0. | |||
|
|
517 | sd = 0. | |||
|
|
518 | cd = 1. | |||
|
|
519 | n = 0 | |||
|
|
520 | l = 1 | |||
|
|
521 | m = 1 | |||
|
|
522 | npq = (nmax * (nmax + 3)) / 2 | |||
|
|
523 | ||||
|
|
524 | if (igdgc .eq. 1) then | |||
|
|
525 | aa = a2 * clat * clat | |||
|
|
526 | bb = b2 * slat * slat | |||
|
|
527 | cc = aa + bb | |||
|
|
528 | dd = sqrt (cc) | |||
|
|
529 | r = sqrt (elev * (elev + 2. * dd) | |||
|
|
530 | 1 + (a2 * aa + b2 * bb) / cc) | |||
|
|
531 | cd = (elev + dd) / r | |||
|
|
532 | sd = (a2 - b2) / dd * slat * clat / r | |||
|
|
533 | ||||
|
|
534 | aa = slat | |||
|
|
535 | slat = slat * cd - clat * sd | |||
|
|
536 | clat = clat * cd + aa * sd | |||
|
|
537 | endif | |||
|
|
538 | ||||
|
|
539 | ratio = erad / r | |||
|
|
540 | ||||
|
|
541 | aa = sqrt (3.) | |||
|
|
542 | p(1) = 2. * slat | |||
|
|
543 | p(2) = 2. * clat | |||
|
|
544 | p(3) = 4.5 * slat * slat - 1.5 | |||
|
|
545 | p(4) = 3. * aa * clat * slat | |||
|
|
546 | q(1) = -clat | |||
|
|
547 | q(2) = slat | |||
|
|
548 | q(3) = -3. * clat * slat | |||
|
|
549 | q(4) = aa * (slat * slat - clat * clat) | |||
|
|
550 | ||||
|
|
551 | C for k = 1, npq | |||
|
|
552 | DO 1010 k = 1, npq | |||
|
|
553 | if (n .lt. m) then | |||
|
|
554 | m = 0 | |||
|
|
555 | n = n + 1 | |||
|
|
556 | rr = ratio**(n + 2) | |||
|
|
557 | fn = n | |||
|
|
558 | endif | |||
|
|
559 | fm = m | |||
|
|
560 | if (k .ge. 5) then | |||
|
|
561 | if (m .eq. n) then | |||
|
|
562 | aa = sqrt (1. - .5 / fm) | |||
|
|
563 | j = k - n - 1 | |||
|
|
564 | p(k) = (1. + 1. / fm) * aa * clat * p(j) | |||
|
|
565 | q(k) = aa * (clat * q(j) + slat / fm * p(j)) | |||
|
|
566 | sl(m) = sl(m-1) * cl(1) + cl(m-1) * sl(1) | |||
|
|
567 | cl(m) = cl(m-1) * cl(1) - sl(m-1) * sl(1) | |||
|
|
568 | else | |||
|
|
569 | aa = sqrt (fn * fn - fm * fm) | |||
|
|
570 | bb = sqrt ((fn - 1.)**2 - fm * fm) / aa | |||
|
|
571 | cc = (2. * fn - 1.) / aa | |||
|
|
572 | i = k - n | |||
|
|
573 | j = k - 2 * n + 1 | |||
|
|
574 | p(k) = (fn + 1.) * (cc * slat / fn * p(i) - bb | |||
|
|
575 | 1 / (fn - 1.) * p(j)) | |||
|
|
576 | q(k) = cc * (slat * q(i) - clat / fn * p(i)) | |||
|
|
577 | 1 - bb * q(j) | |||
|
|
578 | endif | |||
|
|
579 | endif | |||
|
|
580 | ||||
|
|
581 | aa = rr * gh(l) | |||
|
|
582 | ||||
|
|
583 | if (m .eq. 0) then | |||
|
|
584 | x = x + aa * q(k) | |||
|
|
585 | z = z - aa * p(k) | |||
|
|
586 | l = l + 1 | |||
|
|
587 | else | |||
|
|
588 | bb = rr * gh(l+1) | |||
|
|
589 | cc = aa * cl(m) + bb * sl(m) | |||
|
|
590 | x = x + cc * q(k) | |||
|
|
591 | z = z - cc * p(k) | |||
|
|
592 | if (clat .gt. 0.) then | |||
|
|
593 | y = y + (aa * sl(m) - bb * cl(m)) * fm * p(k) | |||
|
|
594 | 1 / ((fn + 1.) * clat) | |||
|
|
595 | else | |||
|
|
596 | y = y + (aa * sl(m) - bb * cl(m)) * q(k) | |||
|
|
597 | 1 * slat | |||
|
|
598 | endif | |||
|
|
599 | l = l + 2 | |||
|
|
600 | endif | |||
|
|
601 | m = m + 1 | |||
|
|
602 | C end for | |||
|
|
603 | 1010 CONTINUE | |||
|
|
604 | 1011 CONTINUE | |||
|
|
605 | ||||
|
|
606 | if (iext .ne. 0) then | |||
|
|
607 | aa = ext(2) * cl(1) + ext(3) * sl(1) | |||
|
|
608 | x = x - ext(1) * clat + aa * slat | |||
|
|
609 | y = y + ext(2) * sl(1) - ext(3) * cl(1) | |||
|
|
610 | z = z + ext(1) * slat + aa * clat | |||
|
|
611 | endif | |||
|
|
612 | ||||
|
|
613 | aa = x | |||
|
|
614 | x = x * cd + z * sd | |||
|
|
615 | z = z * cd - aa * sd | |||
|
|
616 | ||||
|
|
617 | ||||
|
|
618 | return | |||
|
|
619 | end | |||
|
|
620 | c | |||
|
|
621 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ bfieldsr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |||
|
|
622 | c | |||
|
|
623 | subroutine dihf (x, y, z, d, i, h, f) | |||
|
|
624 | ||||
|
|
625 | c =============================================================== | |||
|
|
626 | c | |||
|
|
627 | c version 1.01 | |||
|
|
628 | c | |||
|
|
629 | c computes the geomagnetic elements d, i, h, and f from | |||
|
|
630 | c x, y, and z. | |||
|
|
631 | c | |||
|
|
632 | c input: | |||
|
|
633 | c x - northward component | |||
|
|
634 | c y - eastward component | |||
|
|
635 | c z - vertically-downward component | |||
|
|
636 | c | |||
|
|
637 | c output: | |||
|
|
638 | c d - declination | |||
|
|
639 | c i - inclination | |||
|
|
640 | c h - horizontal intensity | |||
|
|
641 | c f - total intensity | |||
|
|
642 | c | |||
|
|
643 | c a. zunde | |||
|
|
644 | c usgs, ms 964, box 25046 federal center, denver, co 80225 | |||
|
|
645 | c | |||
|
|
646 | c =============================================================== | |||
|
|
647 | ||||
|
|
648 | real i | |||
|
|
649 | parameter ( sn = 0.0001 ) | |||
|
|
650 | ||||
|
|
651 | c --------------------------------------------------------------- | |||
|
|
652 | c if d and i cannot be determined, set equal to 999.0. | |||
|
|
653 | c --------------------------------------------------------------- | |||
|
|
654 | ||||
|
|
655 | h2 = x*x + y*y | |||
|
|
656 | h = sqrt (h2) | |||
|
|
657 | f = sqrt (h2 + z*z) | |||
|
|
658 | if (f .lt. sn) then | |||
|
|
659 | d = 999. | |||
|
|
660 | i = 999. | |||
|
|
661 | else | |||
|
|
662 | i = atan2 (z, h) | |||
|
|
663 | if (h .lt. sn) then | |||
|
|
664 | d = 999. | |||
|
|
665 | else | |||
|
|
666 | hpx = h + x | |||
|
|
667 | if (hpx .lt. sn) then | |||
|
|
668 | d = 180. | |||
|
|
669 | else | |||
|
|
670 | d = 2. * atan2 (y, hpx) | |||
|
|
671 | endif | |||
|
|
672 | endif | |||
|
|
673 | endif | |||
|
|
674 | ||||
|
|
675 | return | |||
|
|
676 | end | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | dgrf00 | |||
|
|
2 | 13 6371.2 2000.0 | |||
|
|
3 | 1 0 -29619.40 0.00 0.00 0.00 DGRF2000 1 | |||
|
|
4 | 1 1 -1728.20 5186.10 0.00 0.00 DGRF2000 2 | |||
|
|
5 | 2 0 -2267.70 0.00 0.00 0.00 DGRF2000 3 | |||
|
|
6 | 2 1 3068.40 -2481.60 0.00 0.00 DGRF2000 4 | |||
|
|
7 | 2 2 1670.90 -458.00 0.00 0.00 DGRF2000 5 | |||
|
|
8 | 3 0 1339.60 0.00 0.00 0.00 DGRF2000 6 | |||
|
|
9 | 3 1 -2288.00 -227.60 0.00 0.00 DGRF2000 7 | |||
|
|
10 | 3 2 1252.10 293.40 0.00 0.00 DGRF2000 8 | |||
|
|
11 | 3 3 714.50 -491.10 0.00 0.00 DGRF2000 9 | |||
|
|
12 | 4 0 932.30 0.00 0.00 0.00 DGRF2000 10 | |||
|
|
13 | 4 1 786.80 272.60 0.00 0.00 DGRF2000 11 | |||
|
|
14 | 4 2 250.00 -231.90 0.00 0.00 DGRF2000 12 | |||
|
|
15 | 4 3 -403.00 119.80 0.00 0.00 DGRF2000 13 | |||
|
|
16 | 4 4 111.30 -303.80 0.00 0.00 DGRF2000 14 | |||
|
|
17 | 5 0 -218.80 0.00 0.00 0.00 DGRF2000 15 | |||
|
|
18 | 5 1 351.40 43.80 0.00 0.00 DGRF2000 16 | |||
|
|
19 | 5 2 222.30 171.90 0.00 0.00 DGRF2000 17 | |||
|
|
20 | 5 3 -130.40 -133.10 0.00 0.00 DGRF2000 18 | |||
|
|
21 | 5 4 -168.60 -39.30 0.00 0.00 DGRF2000 19 | |||
|
|
22 | 5 5 -12.90 106.30 0.00 0.00 DGRF2000 20 | |||
|
|
23 | 6 0 72.30 0.00 0.00 0.00 DGRF2000 21 | |||
|
|
24 | 6 1 68.20 -17.40 0.00 0.00 DGRF2000 22 | |||
|
|
25 | 6 2 74.20 63.70 0.00 0.00 DGRF2000 23 | |||
|
|
26 | 6 3 -160.90 65.10 0.00 0.00 DGRF2000 24 | |||
|
|
27 | 6 4 -5.90 -61.20 0.00 0.00 DGRF2000 25 | |||
|
|
28 | 6 5 16.90 0.70 0.00 0.00 DGRF2000 26 | |||
|
|
29 | 6 6 -90.40 43.80 0.00 0.00 DGRF2000 27 | |||
|
|
30 | 7 0 79.00 0.00 0.00 0.00 DGRF2000 28 | |||
|
|
31 | 7 1 -74.00 -64.60 0.00 0.00 DGRF2000 29 | |||
|
|
32 | 7 2 0.00 -24.20 0.00 0.00 DGRF2000 30 | |||
|
|
33 | 7 3 33.30 6.20 0.00 0.00 DGRF2000 31 | |||
|
|
34 | 7 4 9.10 24.00 0.00 0.00 DGRF2000 32 | |||
|
|
35 | 7 5 6.90 14.80 0.00 0.00 DGRF2000 33 | |||
|
|
36 | 7 6 7.30 -25.40 0.00 0.00 DGRF2000 34 | |||
|
|
37 | 7 7 -1.20 -5.80 0.00 0.00 DGRF2000 35 | |||
|
|
38 | 8 0 24.40 0.00 0.00 0.00 DGRF2000 36 | |||
|
|
39 | 8 1 6.60 11.90 0.00 0.00 DGRF2000 37 | |||
|
|
40 | 8 2 -9.20 -21.50 0.00 0.00 DGRF2000 38 | |||
|
|
41 | 8 3 -7.90 8.50 0.00 0.00 DGRF2000 39 | |||
|
|
42 | 8 4 -16.60 -21.50 0.00 0.00 DGRF2000 40 | |||
|
|
43 | 8 5 9.10 15.50 0.00 0.00 DGRF2000 41 | |||
|
|
44 | 8 6 7.00 8.90 0.00 0.00 DGRF2000 42 | |||
|
|
45 | 8 7 -7.90 -14.90 0.00 0.00 DGRF2000 43 | |||
|
|
46 | 8 8 -7.00 -2.10 0.00 0.00 DGRF2000 44 | |||
|
|
47 | 9 0 5.00 0.00 0.00 0.00 DGRF2000 45 | |||
|
|
48 | 9 1 9.40 -19.70 0.00 0.00 DGRF2000 46 | |||
|
|
49 | 9 2 3.00 13.40 0.00 0.00 DGRF2000 47 | |||
|
|
50 | 9 3 -8.40 12.50 0.00 0.00 DGRF2000 48 | |||
|
|
51 | 9 4 6.30 -6.20 0.00 0.00 DGRF2000 49 | |||
|
|
52 | 9 5 -8.90 -8.40 0.00 0.00 DGRF2000 50 | |||
|
|
53 | 9 6 -1.50 8.40 0.00 0.00 DGRF2000 51 | |||
|
|
54 | 9 7 9.30 3.80 0.00 0.00 DGRF2000 52 | |||
|
|
55 | 9 8 -4.30 -8.20 0.00 0.00 DGRF2000 53 | |||
|
|
56 | 9 9 -8.20 4.80 0.00 0.00 DGRF2000 54 | |||
|
|
57 | 10 0 -2.60 0.00 0.00 0.00 DGRF2000 55 | |||
|
|
58 | 10 1 -6.00 1.70 0.00 0.00 DGRF2000 56 | |||
|
|
59 | 10 2 1.70 0.00 0.00 0.00 DGRF2000 57 | |||
|
|
60 | 10 3 -3.10 4.00 0.00 0.00 DGRF2000 58 | |||
|
|
61 | 10 4 -0.50 4.90 0.00 0.00 DGRF2000 59 | |||
|
|
62 | 10 5 3.70 -5.90 0.00 0.00 DGRF2000 60 | |||
|
|
63 | 10 6 1.00 -1.20 0.00 0.00 DGRF2000 61 | |||
|
|
64 | 10 7 2.00 -2.90 0.00 0.00 DGRF2000 62 | |||
|
|
65 | 10 8 4.20 0.20 0.00 0.00 DGRF2000 63 | |||
|
|
66 | 10 9 0.30 -2.20 0.00 0.00 DGRF2000 64 | |||
|
|
67 | 10 10 -1.10 -7.40 0.00 0.00 DGRF2000 65 | |||
|
|
68 | 11 0 2.70 0.00 0.00 0.00 DGRF2000 66 | |||
|
|
69 | 11 1 -1.70 0.10 0.00 0.00 DGRF2000 67 | |||
|
|
70 | 11 2 -1.90 1.30 0.00 0.00 DGRF2000 68 | |||
|
|
71 | 11 3 1.50 -0.90 0.00 0.00 DGRF2000 69 | |||
|
|
72 | 11 4 -0.10 -2.60 0.00 0.00 DGRF2000 70 | |||
|
|
73 | 11 5 0.10 0.90 0.00 0.00 DGRF2000 71 | |||
|
|
74 | 11 6 -0.70 -0.70 0.00 0.00 DGRF2000 72 | |||
|
|
75 | 11 7 0.70 -2.80 0.00 0.00 DGRF2000 73 | |||
|
|
76 | 11 8 1.70 -0.90 0.00 0.00 DGRF2000 74 | |||
|
|
77 | 11 9 0.10 -1.20 0.00 0.00 DGRF2000 75 | |||
|
|
78 | 11 10 1.20 -1.90 0.00 0.00 DGRF2000 76 | |||
|
|
79 | 11 11 4.00 -0.90 0.00 0.00 DGRF2000 77 | |||
|
|
80 | 12 0 -2.20 0.00 0.00 0.00 DGRF2000 78 | |||
|
|
81 | 12 1 -0.30 -0.40 0.00 0.00 DGRF2000 79 | |||
|
|
82 | 12 2 0.20 0.30 0.00 0.00 DGRF2000 80 | |||
|
|
83 | 12 3 0.90 2.50 0.00 0.00 DGRF2000 81 | |||
|
|
84 | 12 4 -0.20 -2.60 0.00 0.00 DGRF2000 82 | |||
|
|
85 | 12 5 0.90 0.70 0.00 0.00 DGRF2000 83 | |||
|
|
86 | 12 6 -0.50 0.30 0.00 0.00 DGRF2000 84 | |||
|
|
87 | 12 7 0.30 0.00 0.00 0.00 DGRF2000 85 | |||
|
|
88 | 12 8 -0.30 0.00 0.00 0.00 DGRF2000 86 | |||
|
|
89 | 12 9 -0.40 0.30 0.00 0.00 DGRF2000 87 | |||
|
|
90 | 12 10 -0.10 -0.90 0.00 0.00 DGRF2000 88 | |||
|
|
91 | 12 11 -0.20 -0.40 0.00 0.00 DGRF2000 89 | |||
|
|
92 | 12 12 -0.40 0.80 0.00 0.00 DGRF2000 90 | |||
|
|
93 | 13 0 -0.20 0.00 0.00 0.00 DGRF2000 91 | |||
|
|
94 | 13 1 -0.90 -0.90 0.00 0.00 DGRF2000 92 | |||
|
|
95 | 13 2 0.30 0.20 0.00 0.00 DGRF2000 93 | |||
|
|
96 | 13 3 0.10 1.80 0.00 0.00 DGRF2000 94 | |||
|
|
97 | 13 4 -0.40 -0.40 0.00 0.00 DGRF2000 95 | |||
|
|
98 | 13 5 1.30 -1.00 0.00 0.00 DGRF2000 96 | |||
|
|
99 | 13 6 -0.40 -0.10 0.00 0.00 DGRF2000 97 | |||
|
|
100 | 13 7 0.70 0.70 0.00 0.00 DGRF2000 98 | |||
|
|
101 | 13 8 -0.40 0.30 0.00 0.00 DGRF2000 99 | |||
|
|
102 | 13 9 0.30 0.60 0.00 0.00 DGRF2000 100 | |||
|
|
103 | 13 10 -0.10 0.30 0.00 0.00 DGRF2000 101 | |||
|
|
104 | 13 11 0.40 -0.20 0.00 0.00 DGRF2000 102 | |||
|
|
105 | 13 12 0.00 -0.50 0.00 0.00 DGRF2000 103 | |||
|
|
106 | 13 13 0.10 -0.90 0.00 0.00 DGRF2000 104 | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | dgrf05 | |||
|
|
2 | 13 6371.2 2005.0 | |||
|
|
3 | 1 0 -29554.63 0.00 0.00 0.00 IGRF2005 1 | |||
|
|
4 | 1 1 -1669.05 5077.99 0.00 0.00 IGRF2005 2 | |||
|
|
5 | 2 0 -2337.24 0.00 0.00 0.00 IGRF2005 3 | |||
|
|
6 | 2 1 3047.69 -2594.50 0.00 0.00 IGRF2005 4 | |||
|
|
7 | 2 2 1657.76 -515.43 0.00 0.00 IGRF2005 5 | |||
|
|
8 | 3 0 1336.30 0.00 0.00 0.00 IGRF2005 6 | |||
|
|
9 | 3 1 -2305.83 -198.86 0.00 0.00 IGRF2005 7 | |||
|
|
10 | 3 2 1246.39 269.72 0.00 0.00 IGRF2005 8 | |||
|
|
11 | 3 3 672.51 -524.72 0.00 0.00 IGRF2005 9 | |||
|
|
12 | 4 0 920.55 0.00 0.00 0.00 IGRF2005 10 | |||
|
|
13 | 4 1 797.96 282.07 0.00 0.00 IGRF2005 11 | |||
|
|
14 | 4 2 210.65 -225.23 0.00 0.00 IGRF2005 12 | |||
|
|
15 | 4 3 -379.86 145.15 0.00 0.00 IGRF2005 13 | |||
|
|
16 | 4 4 100.00 -305.36 0.00 0.00 IGRF2005 14 | |||
|
|
17 | 5 0 -227.00 0.00 0.00 0.00 IGRF2005 15 | |||
|
|
18 | 5 1 354.41 42.72 0.00 0.00 IGRF2005 16 | |||
|
|
19 | 5 2 208.95 180.25 0.00 0.00 IGRF2005 17 | |||
|
|
20 | 5 3 -136.54 -123.45 0.00 0.00 IGRF2005 18 | |||
|
|
21 | 5 4 -168.05 -19.57 0.00 0.00 IGRF2005 19 | |||
|
|
22 | 5 5 -13.55 103.85 0.00 0.00 IGRF2005 20 | |||
|
|
23 | 6 0 73.60 0.00 0.00 0.00 IGRF2005 21 | |||
|
|
24 | 6 1 69.56 -20.33 0.00 0.00 IGRF2005 22 | |||
|
|
25 | 6 2 76.74 54.75 0.00 0.00 IGRF2005 23 | |||
|
|
26 | 6 3 -151.34 63.63 0.00 0.00 IGRF2005 24 | |||
|
|
27 | 6 4 -14.58 -63.53 0.00 0.00 IGRF2005 25 | |||
|
|
28 | 6 5 14.58 0.24 0.00 0.00 IGRF2005 26 | |||
|
|
29 | 6 6 -86.36 50.94 0.00 0.00 IGRF2005 27 | |||
|
|
30 | 7 0 79.88 0.00 0.00 0.00 IGRF2005 28 | |||
|
|
31 | 7 1 -74.46 -61.14 0.00 0.00 IGRF2005 29 | |||
|
|
32 | 7 2 -1.65 -22.57 0.00 0.00 IGRF2005 30 | |||
|
|
33 | 7 3 38.73 6.82 0.00 0.00 IGRF2005 31 | |||
|
|
34 | 7 4 12.30 25.35 0.00 0.00 IGRF2005 32 | |||
|
|
35 | 7 5 9.37 10.93 0.00 0.00 IGRF2005 33 | |||
|
|
36 | 7 6 5.42 -26.32 0.00 0.00 IGRF2005 34 | |||
|
|
37 | 7 7 1.94 -4.64 0.00 0.00 IGRF2005 35 | |||
|
|
38 | 8 0 24.80 0.00 0.00 0.00 IGRF2005 36 | |||
|
|
39 | 8 1 7.62 11.20 0.00 0.00 IGRF2005 37 | |||
|
|
40 | 8 2 -11.73 -20.88 0.00 0.00 IGRF2005 38 | |||
|
|
41 | 8 3 -6.88 9.83 0.00 0.00 IGRF2005 39 | |||
|
|
42 | 8 4 -18.11 -19.71 0.00 0.00 IGRF2005 40 | |||
|
|
43 | 8 5 10.17 16.22 0.00 0.00 IGRF2005 41 | |||
|
|
44 | 8 6 9.36 7.61 0.00 0.00 IGRF2005 42 | |||
|
|
45 | 8 7 -11.25 -12.76 0.00 0.00 IGRF2005 43 | |||
|
|
46 | 8 8 -4.87 -0.06 0.00 0.00 IGRF2005 44 | |||
|
|
47 | 9 0 5.58 0.00 0.00 0.00 IGRF2005 45 | |||
|
|
48 | 9 1 9.76 -20.11 0.00 0.00 IGRF2005 46 | |||
|
|
49 | 9 2 3.58 12.69 0.00 0.00 IGRF2005 47 | |||
|
|
50 | 9 3 -6.94 12.67 0.00 0.00 IGRF2005 48 | |||
|
|
51 | 9 4 5.01 -6.72 0.00 0.00 IGRF2005 49 | |||
|
|
52 | 9 5 -10.76 -8.16 0.00 0.00 IGRF2005 50 | |||
|
|
53 | 9 6 -1.25 8.10 0.00 0.00 IGRF2005 51 | |||
|
|
54 | 9 7 8.76 2.92 0.00 0.00 IGRF2005 52 | |||
|
|
55 | 9 8 -6.66 -7.73 0.00 0.00 IGRF2005 53 | |||
|
|
56 | 9 9 -9.22 6.01 0.00 0.00 IGRF2005 54 | |||
|
|
57 | 10 0 -2.17 0.00 0.00 0.00 IGRF2005 55 | |||
|
|
58 | 10 1 -6.12 2.19 0.00 0.00 IGRF2005 56 | |||
|
|
59 | 10 2 1.42 0.10 0.00 0.00 IGRF2005 57 | |||
|
|
60 | 10 3 -2.35 4.46 0.00 0.00 IGRF2005 58 | |||
|
|
61 | 10 4 -0.15 4.76 0.00 0.00 IGRF2005 59 | |||
|
|
62 | 10 5 3.06 -6.58 0.00 0.00 IGRF2005 60 | |||
|
|
63 | 10 6 0.29 -1.01 0.00 0.00 IGRF2005 61 | |||
|
|
64 | 10 7 2.06 -3.47 0.00 0.00 IGRF2005 62 | |||
|
|
65 | 10 8 3.77 -0.86 0.00 0.00 IGRF2005 63 | |||
|
|
66 | 10 9 -0.21 -2.31 0.00 0.00 IGRF2005 64 | |||
|
|
67 | 10 10 -2.09 -7.93 0.00 0.00 IGRF2005 65 | |||
|
|
68 | 11 0 2.95 0.00 0.00 0.00 IGRF2005 66 | |||
|
|
69 | 11 1 -1.60 0.26 0.00 0.00 IGRF2005 67 | |||
|
|
70 | 11 2 -1.88 1.44 0.00 0.00 IGRF2005 68 | |||
|
|
71 | 11 3 1.44 -0.77 0.00 0.00 IGRF2005 69 | |||
|
|
72 | 11 4 -0.31 -2.27 0.00 0.00 IGRF2005 70 | |||
|
|
73 | 11 5 0.29 0.90 0.00 0.00 IGRF2005 71 | |||
|
|
74 | 11 6 -0.79 -0.58 0.00 0.00 IGRF2005 72 | |||
|
|
75 | 11 7 0.53 -2.69 0.00 0.00 IGRF2005 73 | |||
|
|
76 | 11 8 1.80 -1.08 0.00 0.00 IGRF2005 74 | |||
|
|
77 | 11 9 0.16 -1.58 0.00 0.00 IGRF2005 75 | |||
|
|
78 | 11 10 0.96 -1.90 0.00 0.00 IGRF2005 76 | |||
|
|
79 | 11 11 3.99 -1.39 0.00 0.00 IGRF2005 77 | |||
|
|
80 | 12 0 -2.15 0.00 0.00 0.00 IGRF2005 78 | |||
|
|
81 | 12 1 -0.29 -0.55 0.00 0.00 IGRF2005 79 | |||
|
|
82 | 12 2 0.21 0.23 0.00 0.00 IGRF2005 80 | |||
|
|
83 | 12 3 0.89 2.38 0.00 0.00 IGRF2005 81 | |||
|
|
84 | 12 4 -0.38 -2.63 0.00 0.00 IGRF2005 82 | |||
|
|
85 | 12 5 0.96 0.61 0.00 0.00 IGRF2005 83 | |||
|
|
86 | 12 6 -0.30 0.40 0.00 0.00 IGRF2005 84 | |||
|
|
87 | 12 7 0.46 0.01 0.00 0.00 IGRF2005 85 | |||
|
|
88 | 12 8 -0.35 0.02 0.00 0.00 IGRF2005 86 | |||
|
|
89 | 12 9 -0.36 0.28 0.00 0.00 IGRF2005 87 | |||
|
|
90 | 12 10 0.08 -0.87 0.00 0.00 IGRF2005 88 | |||
|
|
91 | 12 11 -0.49 -0.34 0.00 0.00 IGRF2005 89 | |||
|
|
92 | 12 12 -0.08 0.88 0.00 0.00 IGRF2005 90 | |||
|
|
93 | 13 0 -0.16 0.00 0.00 0.00 IGRF2005 91 | |||
|
|
94 | 13 1 -0.88 -0.76 0.00 0.00 IGRF2005 92 | |||
|
|
95 | 13 2 0.30 0.33 0.00 0.00 IGRF2005 93 | |||
|
|
96 | 13 3 0.28 1.72 0.00 0.00 IGRF2005 94 | |||
|
|
97 | 13 4 -0.43 -0.54 0.00 0.00 IGRF2005 95 | |||
|
|
98 | 13 5 1.18 -1.07 0.00 0.00 IGRF2005 96 | |||
|
|
99 | 13 6 -0.37 -0.04 0.00 0.00 IGRF2005 97 | |||
|
|
100 | 13 7 0.75 0.63 0.00 0.00 IGRF2005 98 | |||
|
|
101 | 13 8 -0.26 0.21 0.00 0.00 IGRF2005 99 | |||
|
|
102 | 13 9 0.35 0.53 0.00 0.00 IGRF2005 100 | |||
|
|
103 | 13 10 -0.05 0.38 0.00 0.00 IGRF2005 101 | |||
|
|
104 | 13 11 0.41 -0.22 0.00 0.00 IGRF2005 102 | |||
|
|
105 | 13 12 -0.10 -0.57 0.00 0.00 IGRF2005 103 | |||
|
|
106 | 13 13 -0.18 -0.82 0.00 0.00 IGRF2005 104 | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | dgrf15 | |||
|
|
2 | 13 6371.2 2015.0 | |||
|
|
3 | 1 0 -29441.46 0 | |||
|
|
4 | 1 1 -1501.77 4795.99 | |||
|
|
5 | 2 0 -2445.88 0 | |||
|
|
6 | 2 1 3012.2 -2845.41 | |||
|
|
7 | 2 2 1676.35 -642.17 | |||
|
|
8 | 3 0 1350.33 0 | |||
|
|
9 | 3 1 -2352.26 -115.29 | |||
|
|
10 | 3 2 1225.85 245.04 | |||
|
|
11 | 3 3 581.69 -538.7 | |||
|
|
12 | 4 0 907.42 0 | |||
|
|
13 | 4 1 813.68 283.54 | |||
|
|
14 | 4 2 120.49 -188.43 | |||
|
|
15 | 4 3 -334.85 180.95 | |||
|
|
16 | 4 4 70.38 -329.23 | |||
|
|
17 | 5 0 -232.91 0 | |||
|
|
18 | 5 1 360.14 46.98 | |||
|
|
19 | 5 2 192.35 196.98 | |||
|
|
20 | 5 3 -140.94 -119.14 | |||
|
|
21 | 5 4 -157.4 15.98 | |||
|
|
22 | 5 5 4.3 100.12 | |||
|
|
23 | 6 0 69.55 0 | |||
|
|
24 | 6 1 67.57 -20.61 | |||
|
|
25 | 6 2 72.79 33.3 | |||
|
|
26 | 6 3 -129.85 58.74 | |||
|
|
27 | 6 4 -28.93 -66.64 | |||
|
|
28 | 6 5 13.14 7.35 | |||
|
|
29 | 6 6 -70.85 62.41 | |||
|
|
30 | 7 0 81.29 0 | |||
|
|
31 | 7 1 -75.99 -54.27 | |||
|
|
32 | 7 2 -6.79 -19.53 | |||
|
|
33 | 7 3 51.82 5.59 | |||
|
|
34 | 7 4 15.07 24.45 | |||
|
|
35 | 7 5 9.32 3.27 | |||
|
|
36 | 7 6 -2.88 -27.5 | |||
|
|
37 | 7 7 6.61 -2.32 | |||
|
|
38 | 8 0 23.98 0 | |||
|
|
39 | 8 1 8.89 10.04 | |||
|
|
40 | 8 2 -16.78 -18.26 | |||
|
|
41 | 8 3 -3.16 13.18 | |||
|
|
42 | 8 4 -20.56 -14.6 | |||
|
|
43 | 8 5 13.33 16.16 | |||
|
|
44 | 8 6 11.76 5.69 | |||
|
|
45 | 8 7 -15.98 -9.1 | |||
|
|
46 | 8 8 -2.02 2.26 | |||
|
|
47 | 9 0 5.33 0 | |||
|
|
48 | 9 1 8.83 -21.77 | |||
|
|
49 | 9 2 3.02 10.76 | |||
|
|
50 | 9 3 -3.22 11.74 | |||
|
|
51 | 9 4 0.67 -6.74 | |||
|
|
52 | 9 5 -13.2 -6.88 | |||
|
|
53 | 9 6 -0.1 7.79 | |||
|
|
54 | 9 7 8.68 1.04 | |||
|
|
55 | 9 8 -9.06 -3.89 | |||
|
|
56 | 9 9 -10.54 8.44 | |||
|
|
57 | 10 0 -2.01 0 | |||
|
|
58 | 10 1 -6.26 3.28 | |||
|
|
59 | 10 2 0.17 -0.4 | |||
|
|
60 | 10 3 0.55 4.55 | |||
|
|
61 | 10 4 -0.55 4.4 | |||
|
|
62 | 10 5 1.7 -7.92 | |||
|
|
63 | 10 6 -0.67 -0.61 | |||
|
|
64 | 10 7 2.13 -4.16 | |||
|
|
65 | 10 8 2.33 -2.85 | |||
|
|
66 | 10 9 -1.8 -1.12 | |||
|
|
67 | 10 10 -3.59 -8.72 | |||
|
|
68 | 11 0 3 0 | |||
|
|
69 | 11 1 -1.4 0 | |||
|
|
70 | 11 2 -2.3 2.11 | |||
|
|
71 | 11 3 2.08 -0.6 | |||
|
|
72 | 11 4 -0.79 -1.05 | |||
|
|
73 | 11 5 0.58 0.76 | |||
|
|
74 | 11 6 -0.7 -0.2 | |||
|
|
75 | 11 7 0.14 -2.12 | |||
|
|
76 | 11 8 1.7 -1.44 | |||
|
|
77 | 11 9 -0.22 -2.57 | |||
|
|
78 | 11 10 0.44 -2.01 | |||
|
|
79 | 11 11 3.49 -2.34 | |||
|
|
80 | 12 0 -2.09 0 | |||
|
|
81 | 12 1 -0.16 -1.08 | |||
|
|
82 | 12 2 0.46 0.37 | |||
|
|
83 | 12 3 1.23 1.75 | |||
|
|
84 | 12 4 -0.89 -2.19 | |||
|
|
85 | 12 5 0.85 0.27 | |||
|
|
86 | 12 6 0.1 0.72 | |||
|
|
87 | 12 7 0.54 -0.09 | |||
|
|
88 | 12 8 -0.37 0.29 | |||
|
|
89 | 12 9 -0.43 0.23 | |||
|
|
90 | 12 10 0.22 -0.89 | |||
|
|
91 | 12 11 -0.94 -0.16 | |||
|
|
92 | 12 12 -0.03 0.72 | |||
|
|
93 | 13 0 -0.02 0 | |||
|
|
94 | 13 1 -0.92 -0.88 | |||
|
|
95 | 13 2 0.42 0.49 | |||
|
|
96 | 13 3 0.63 1.56 | |||
|
|
97 | 13 4 -0.42 -0.5 | |||
|
|
98 | 13 5 0.96 -1.24 | |||
|
|
99 | 13 6 -0.19 -0.1 | |||
|
|
100 | 13 7 0.81 0.42 | |||
|
|
101 | 13 8 -0.13 -0.04 | |||
|
|
102 | 13 9 0.38 0.48 | |||
|
|
103 | 13 10 0.08 0.48 | |||
|
|
104 | 13 11 0.46 -0.3 | |||
|
|
105 | 13 12 -0.35 -0.43 | |||
|
|
106 | 13 13 -0.36 -0.71 | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | dgrf65 | |||
|
|
2 | 10 6371.2 1965. | |||
|
|
3 | 1 0 -30334. 0. | |||
|
|
4 | 1 1 -2119. 5776. | |||
|
|
5 | 2 0 -1662. 0. | |||
|
|
6 | 2 1 2997. -2016. | |||
|
|
7 | 2 2 1594. 114. | |||
|
|
8 | 3 0 1297. 0. | |||
|
|
9 | 3 1 -2038. -404. | |||
|
|
10 | 3 2 1292. 240. | |||
|
|
11 | 3 3 856. -165. | |||
|
|
12 | 4 0 957. 0. | |||
|
|
13 | 4 1 804. 148. | |||
|
|
14 | 4 2 479. -269. | |||
|
|
15 | 4 3 -390. 13. | |||
|
|
16 | 4 4 252. -269. | |||
|
|
17 | 5 0 -219. 0. | |||
|
|
18 | 5 1 358. 19. | |||
|
|
19 | 5 2 254. 128. | |||
|
|
20 | 5 3 -31. -126. | |||
|
|
21 | 5 4 -157. -97. | |||
|
|
22 | 5 5 -62. 81. | |||
|
|
23 | 6 0 45. 0. | |||
|
|
24 | 6 1 61. -11. | |||
|
|
25 | 6 2 8. 100. | |||
|
|
26 | 6 3 -228. 68. | |||
|
|
27 | 6 4 4. -32. | |||
|
|
28 | 6 5 1. -8. | |||
|
|
29 | 6 6 -111. -7. | |||
|
|
30 | 7 0 75. 0. | |||
|
|
31 | 7 1 -57. -61. | |||
|
|
32 | 7 2 4. -27. | |||
|
|
33 | 7 3 13. -2. | |||
|
|
34 | 7 4 -26. 6. | |||
|
|
35 | 7 5 -6. 26. | |||
|
|
36 | 7 6 13. -23. | |||
|
|
37 | 7 7 1. -12. | |||
|
|
38 | 8 0 13. 0. | |||
|
|
39 | 8 1 5. 7. | |||
|
|
40 | 8 2 -4. -12. | |||
|
|
41 | 8 3 -14. 9. | |||
|
|
42 | 8 4 0. -16. | |||
|
|
43 | 8 5 8. 4. | |||
|
|
44 | 8 6 -1. 24. | |||
|
|
45 | 8 7 11. -3. | |||
|
|
46 | 8 8 4. -17. | |||
|
|
47 | 9 0 8. 0. | |||
|
|
48 | 9 1 10. -22. | |||
|
|
49 | 9 2 2. 15. | |||
|
|
50 | 9 3 -13. 7. | |||
|
|
51 | 9 4 10. -4. | |||
|
|
52 | 9 5 -1. -5. | |||
|
|
53 | 9 6 -1. 10. | |||
|
|
54 | 9 7 5. 10. | |||
|
|
55 | 9 8 1. -4. | |||
|
|
56 | 9 9 -2. 1. | |||
|
|
57 | 10 0 -2. 0. | |||
|
|
58 | 10 1 -3. 2. | |||
|
|
59 | 10 2 2. 1. | |||
|
|
60 | 10 3 -5. 2. | |||
|
|
61 | 10 4 -2. 6. | |||
|
|
62 | 10 5 4. -4. | |||
|
|
63 | 10 6 4. 0. | |||
|
|
64 | 10 7 0. -2. | |||
|
|
65 | 10 8 2. 3. | |||
|
|
66 | 10 9 2. 0. | |||
|
|
67 | 10 10 0. -6. | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | dgrf70 | |||
|
|
2 | 10 6371.2 1970. | |||
|
|
3 | 1 0 -30220. 0. | |||
|
|
4 | 1 1 -2068. 5737. | |||
|
|
5 | 2 0 -1781. 0. | |||
|
|
6 | 2 1 3000. -2047. | |||
|
|
7 | 2 2 1611. 25. | |||
|
|
8 | 3 0 1287. 0. | |||
|
|
9 | 3 1 -2091. -366. | |||
|
|
10 | 3 2 1278. 251. | |||
|
|
11 | 3 3 838. -196. | |||
|
|
12 | 4 0 952. 0. | |||
|
|
13 | 4 1 800. 167. | |||
|
|
14 | 4 2 461. -266. | |||
|
|
15 | 4 3 -395. 26. | |||
|
|
16 | 4 4 234. -279. | |||
|
|
17 | 5 0 -216. 0. | |||
|
|
18 | 5 1 359. 26. | |||
|
|
19 | 5 2 262. 139. | |||
|
|
20 | 5 3 -42. -139. | |||
|
|
21 | 5 4 -160. -91. | |||
|
|
22 | 5 5 -56. 83. | |||
|
|
23 | 6 0 43. 0. | |||
|
|
24 | 6 1 64. -12. | |||
|
|
25 | 6 2 15. 100. | |||
|
|
26 | 6 3 -212. 72. | |||
|
|
27 | 6 4 2. -37. | |||
|
|
28 | 6 5 3. -6. | |||
|
|
29 | 6 6 -112. 1. | |||
|
|
30 | 7 0 72. 0. | |||
|
|
31 | 7 1 -57. -70. | |||
|
|
32 | 7 2 1. -27. | |||
|
|
33 | 7 3 14. -4. | |||
|
|
34 | 7 4 -22. 8. | |||
|
|
35 | 7 5 -2. 23. | |||
|
|
36 | 7 6 13. -23. | |||
|
|
37 | 7 7 -2. -11. | |||
|
|
38 | 8 0 14. 0. | |||
|
|
39 | 8 1 6. 7. | |||
|
|
40 | 8 2 -2. -15. | |||
|
|
41 | 8 3 -13. 6. | |||
|
|
42 | 8 4 -3. -17. | |||
|
|
43 | 8 5 5. 6. | |||
|
|
44 | 8 6 0. 21. | |||
|
|
45 | 8 7 11. -6. | |||
|
|
46 | 8 8 3. -16. | |||
|
|
47 | 9 0 8. 0. | |||
|
|
48 | 9 1 10. -21. | |||
|
|
49 | 9 2 2. 16. | |||
|
|
50 | 9 3 -12. 6. | |||
|
|
51 | 9 4 10. -4. | |||
|
|
52 | 9 5 -1. -5. | |||
|
|
53 | 9 6 0. 10. | |||
|
|
54 | 9 7 3. 11. | |||
|
|
55 | 9 8 1. -2. | |||
|
|
56 | 9 9 -1. 1. | |||
|
|
57 | 10 0 -3. 0. | |||
|
|
58 | 10 1 -3. 1. | |||
|
|
59 | 10 2 2. 1. | |||
|
|
60 | 10 3 -5. 3. | |||
|
|
61 | 10 4 -1. 4. | |||
|
|
62 | 10 5 6. -4. | |||
|
|
63 | 10 6 4. 0. | |||
|
|
64 | 10 7 1. -1. | |||
|
|
65 | 10 8 0. 3. | |||
|
|
66 | 10 9 3. 1. | |||
|
|
67 | 10 10 -1. -4. | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | dgrf75 | |||
|
|
2 | 10 6371.2 1975. | |||
|
|
3 | 1 0 -30100. 0. | |||
|
|
4 | 1 1 -2013. 5675. | |||
|
|
5 | 2 0 -1902. 0. | |||
|
|
6 | 2 1 3010. -2067. | |||
|
|
7 | 2 2 1632. -68. | |||
|
|
8 | 3 0 1276. 0. | |||
|
|
9 | 3 1 -2144. -333. | |||
|
|
10 | 3 2 1260. 262. | |||
|
|
11 | 3 3 830. -223. | |||
|
|
12 | 4 0 946. 0. | |||
|
|
13 | 4 1 791. 191. | |||
|
|
14 | 4 2 438. -265. | |||
|
|
15 | 4 3 -405. 39. | |||
|
|
16 | 4 4 216. -288. | |||
|
|
17 | 5 0 -218. 0. | |||
|
|
18 | 5 1 356. 31. | |||
|
|
19 | 5 2 264. 148. | |||
|
|
20 | 5 3 -59. -152. | |||
|
|
21 | 5 4 -159. -83. | |||
|
|
22 | 5 5 -49. 88. | |||
|
|
23 | 6 0 45. 0. | |||
|
|
24 | 6 1 66. -13. | |||
|
|
25 | 6 2 28. 99. | |||
|
|
26 | 6 3 -198. 75. | |||
|
|
27 | 6 4 1. -41. | |||
|
|
28 | 6 5 6. -4. | |||
|
|
29 | 6 6 -111. 11. | |||
|
|
30 | 7 0 71. 0. | |||
|
|
31 | 7 1 -56. -77. | |||
|
|
32 | 7 2 1. -26. | |||
|
|
33 | 7 3 16. -5. | |||
|
|
34 | 7 4 -14. 10. | |||
|
|
35 | 7 5 0. 22. | |||
|
|
36 | 7 6 12. -23. | |||
|
|
37 | 7 7 -5. -12. | |||
|
|
38 | 8 0 14. 0. | |||
|
|
39 | 8 1 6. 6. | |||
|
|
40 | 8 2 -1. -16. | |||
|
|
41 | 8 3 -12. 4. | |||
|
|
42 | 8 4 -8. -19. | |||
|
|
43 | 8 5 4. 6. | |||
|
|
44 | 8 6 0. 18. | |||
|
|
45 | 8 7 10. -10. | |||
|
|
46 | 8 8 1. -17. | |||
|
|
47 | 9 0 7. 0. | |||
|
|
48 | 9 1 10. -21. | |||
|
|
49 | 9 2 2. 16. | |||
|
|
50 | 9 3 -12. 7. | |||
|
|
51 | 9 4 10. -4. | |||
|
|
52 | 9 5 -1. -5. | |||
|
|
53 | 9 6 -1. 10. | |||
|
|
54 | 9 7 4. 11. | |||
|
|
55 | 9 8 1. -3. | |||
|
|
56 | 9 9 -2. 1. | |||
|
|
57 | 10 0 -3. 0. | |||
|
|
58 | 10 1 -3. 1. | |||
|
|
59 | 10 2 2. 1. | |||
|
|
60 | 10 3 -5. 3. | |||
|
|
61 | 10 4 -2. 4. | |||
|
|
62 | 10 5 5. -4. | |||
|
|
63 | 10 6 4. -1. | |||
|
|
64 | 10 7 1. -1. | |||
|
|
65 | 10 8 0. 3. | |||
|
|
66 | 10 9 3. 1. | |||
|
|
67 | 10 10 -1. -5. | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | dgrf80 | |||
|
|
2 | 10 6371.2 1980.0 | |||
|
|
3 | 1 0 -29992. 0. | |||
|
|
4 | 1 1 -1956. 5604. | |||
|
|
5 | 2 0 -1997. 0. | |||
|
|
6 | 2 1 3027. -2129. | |||
|
|
7 | 2 2 1663. -200. | |||
|
|
8 | 3 0 1281. 0. | |||
|
|
9 | 3 1 -2180. -336. | |||
|
|
10 | 3 2 1251. 271. | |||
|
|
11 | 3 3 833. -252. | |||
|
|
12 | 4 0 938. 0. | |||
|
|
13 | 4 1 782. 212. | |||
|
|
14 | 4 2 398. -257. | |||
|
|
15 | 4 3 -419. 53. | |||
|
|
16 | 4 4 199. -297. | |||
|
|
17 | 5 0 -218. 0. | |||
|
|
18 | 5 1 357. 46. | |||
|
|
19 | 5 2 261. 150. | |||
|
|
20 | 5 3 -74. -151. | |||
|
|
21 | 5 4 -162. -78. | |||
|
|
22 | 5 5 -48. 92. | |||
|
|
23 | 6 0 48. 0. | |||
|
|
24 | 6 1 66. -15. | |||
|
|
25 | 6 2 42. 93. | |||
|
|
26 | 6 3 -192. 71. | |||
|
|
27 | 6 4 4. -43. | |||
|
|
28 | 6 5 14. -2. | |||
|
|
29 | 6 6 -108. 17. | |||
|
|
30 | 7 0 72. 0. | |||
|
|
31 | 7 1 -59. -82. | |||
|
|
32 | 7 2 2. -27. | |||
|
|
33 | 7 3 21. -5. | |||
|
|
34 | 7 4 -12. 16. | |||
|
|
35 | 7 5 1. 18. | |||
|
|
36 | 7 6 11. -23. | |||
|
|
37 | 7 7 -2. -10. | |||
|
|
38 | 8 0 18. 0. | |||
|
|
39 | 8 1 6. 7. | |||
|
|
40 | 8 2 0. -18. | |||
|
|
41 | 8 3 -11. 4. | |||
|
|
42 | 8 4 -7. -22. | |||
|
|
43 | 8 5 4. 9. | |||
|
|
44 | 8 6 3. 16. | |||
|
|
45 | 8 7 6. -13. | |||
|
|
46 | 8 8 -1. -15. | |||
|
|
47 | 9 0 5. 0. | |||
|
|
48 | 9 1 10. -21. | |||
|
|
49 | 9 2 1. 16. | |||
|
|
50 | 9 3 -12. 9. | |||
|
|
51 | 9 4 9. -5. | |||
|
|
52 | 9 5 -3. -6. | |||
|
|
53 | 9 6 -1. 9. | |||
|
|
54 | 9 7 7. 10. | |||
|
|
55 | 9 8 2. -6. | |||
|
|
56 | 9 9 -5. 2. | |||
|
|
57 | 10 0 -4. 0. | |||
|
|
58 | 10 1 -4. 1. | |||
|
|
59 | 10 2 2. 0. | |||
|
|
60 | 10 3 -5. 3. | |||
|
|
61 | 10 4 -2. 6. | |||
|
|
62 | 10 5 5. -4. | |||
|
|
63 | 10 6 3. 0. | |||
|
|
64 | 10 7 1. -1. | |||
|
|
65 | 10 8 2. 4. | |||
|
|
66 | 10 9 3. 0. | |||
|
|
67 | 10 10 0. -6. | |||
| This diff has been collapsed as it changes many lines, (594 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,594 | |||||
|
|
1 | DGRF45 1945.00 10 0 0 1945.00 1945.00 -1.0 600.0 dgrf45 1 | |||
|
|
2 | 0 1-30594.0 .0 .00 .00 dgrf45 4 | |||
|
|
3 | 1 1 -2285.0 5810.0 .00 .00 dgrf45 5 | |||
|
|
4 | 0 2 -1244.0 .0 .00 .00 dgrf45 6 | |||
|
|
5 | 1 2 2990.0 -1702.0 .00 .00 dgrf45 7 | |||
|
|
6 | 2 2 1578.0 477.0 .00 .00 dgrf45 8 | |||
|
|
7 | 0 3 1282.0 .0 .00 .00 dgrf45 9 | |||
|
|
8 | 1 3 -1834.0 -499.0 .00 .00 dgrf45 10 | |||
|
|
9 | 2 3 1255.0 186.0 .00 .00 dgrf45 11 | |||
|
|
10 | 3 3 913.0 -11.0 .00 .00 dgrf45 12 | |||
|
|
11 | 0 4 944.0 .0 .00 .00 dgrf45 13 | |||
|
|
12 | 1 4 776.0 144.0 .00 .00 dgrf45 14 | |||
|
|
13 | 2 4 544.0 -276.0 .00 .00 dgrf45 15 | |||
|
|
14 | 3 4 -421.0 -55.0 .00 .00 dgrf45 16 | |||
|
|
15 | 4 4 304.0 -178.0 .00 .00 dgrf45 17 | |||
|
|
16 | 0 5 -253.0 .0 .00 .00 dgrf45 18 | |||
|
|
17 | 1 5 346.0 -12.0 .00 .00 dgrf45 19 | |||
|
|
18 | 2 5 194.0 95.0 .00 .00 dgrf45 20 | |||
|
|
19 | 3 5 -20.0 -67.0 .00 .00 dgrf45 21 | |||
|
|
20 | 4 5 -142.0 -119.0 .00 .00 dgrf45 22 | |||
|
|
21 | 5 5 -82.0 82.0 .00 .00 dgrf45 23 | |||
|
|
22 | 0 6 59.0 .0 .00 .00 dgrf45 24 | |||
|
|
23 | 1 6 57.0 6.0 .00 .00 dgrf45 25 | |||
|
|
24 | 2 6 6.0 100.0 .00 .00 dgrf45 26 | |||
|
|
25 | 3 6 -246.0 16.0 .00 .00 dgrf45 27 | |||
|
|
26 | 4 6 -25.0 -9.0 .00 .00 dgrf45 28 | |||
|
|
27 | 5 6 21.0 -16.0 .00 .00 dgrf45 29 | |||
|
|
28 | 6 6 -104.0 -39.0 .00 .00 dgrf45 30 | |||
|
|
29 | 0 7 70.0 .0 .00 .00 dgrf45 31 | |||
|
|
30 | 1 7 -40.0 -45.0 .00 .00 dgrf45 32 | |||
|
|
31 | 2 7 .0 -18.0 .00 .00 dgrf45 33 | |||
|
|
32 | 3 7 .0 2.0 .00 .00 dgrf45 34 | |||
|
|
33 | 4 7 -29.0 6.0 .00 .00 dgrf45 35 | |||
|
|
34 | 5 7 -10.0 28.0 .00 .00 dgrf45 36 | |||
|
|
35 | 6 7 15.0 -17.0 .00 .00 dgrf45 37 | |||
|
|
36 | 7 7 29.0 -22.0 .00 .00 dgrf45 38 | |||
|
|
37 | 0 8 13.0 .0 .00 .00 dgrf45 39 | |||
|
|
38 | 1 8 7.0 12.0 .00 .00 dgrf45 40 | |||
|
|
39 | 2 8 -8.0 -21.0 .00 .00 dgrf45 41 | |||
|
|
40 | 3 8 -5.0 -12.0 .00 .00 dgrf45 42 | |||
|
|
41 | 4 8 9.0 -7.0 .00 .00 dgrf45 43 | |||
|
|
42 | 5 8 7.0 2.0 .00 .00 dgrf45 44 | |||
|
|
43 | 6 8 -10.0 18.0 .00 .00 dgrf45 45 | |||
|
|
44 | 7 8 7.0 3.0 .00 .00 dgrf45 46 | |||
|
|
45 | 8 8 2.0 -11.0 .00 .00 dgrf45 47 | |||
|
|
46 | 0 9 5.0 .0 .00 .00 dgrf45 48 | |||
|
|
47 | 1 9 -21.0 -27.0 .00 .00 dgrf45 49 | |||
|
|
48 | 2 9 1.0 17.0 .00 .00 dgrf45 50 | |||
|
|
49 | 3 9 -11.0 29.0 .00 .00 dgrf45 51 | |||
|
|
50 | 4 9 3.0 -9.0 .00 .00 dgrf45 52 | |||
|
|
51 | 5 9 16.0 4.0 .00 .00 dgrf45 53 | |||
|
|
52 | 6 9 -3.0 9.0 .00 .00 dgrf45 54 | |||
|
|
53 | 7 9 -4.0 6.0 .00 .00 dgrf45 55 | |||
|
|
54 | 8 9 -3.0 1.0 .00 .00 dgrf45 56 | |||
|
|
55 | 9 9 -4.0 8.0 .00 .00 dgrf45 57 | |||
|
|
56 | 010 -3.0 .0 .00 .00 dgrf45 58 | |||
|
|
57 | 110 11.0 5.0 .00 .00 dgrf45 59 | |||
|
|
58 | 210 1.0 1.0 .00 .00 dgrf45 60 | |||
|
|
59 | 310 2.0 -20.0 .00 .00 dgrf45 61 | |||
|
|
60 | 410 -5.0 -1.0 .00 .00 dgrf45 62 | |||
|
|
61 | 510 -1.0 -6.0 .00 .00 dgrf45 63 | |||
|
|
62 | 610 8.0 6.0 .00 .00 dgrf45 64 | |||
|
|
63 | 710 -1.0 -4.0 .00 .00 dgrf45 65 | |||
|
|
64 | 810 -3.0 -2.0 .00 .00 dgrf45 66 | |||
|
|
65 | 910 5.0 .0 .00 .00 dgrf45 67 | |||
|
|
66 | 1010 -2.0 -2.0 .00 .00 dgrf45 68 | |||
|
|
67 | DGRF50 1950.00 10 0 0 1950.00 1955.00 -1.0 600.0 dgrf50 1 | |||
|
|
68 | 0 1-30554.0 .0 .00 .00 dgrf50 4 | |||
|
|
69 | 1 1 -2250.0 5815.0 .00 .00 dgrf50 5 | |||
|
|
70 | 0 2 -1341.0 .0 .00 .00 dgrf50 6 | |||
|
|
71 | 1 2 2998.0 -1810.0 .00 .00 dgrf50 7 | |||
|
|
72 | 2 2 1576.0 381.0 .00 .00 dgrf50 8 | |||
|
|
73 | 0 3 1297.0 .0 .00 .00 dgrf50 9 | |||
|
|
74 | 1 3 -1889.0 -476.0 .00 .00 dgrf50 10 | |||
|
|
75 | 2 3 1274.0 206.0 .00 .00 dgrf50 11 | |||
|
|
76 | 3 3 896.0 -46.0 .00 .00 dgrf50 12 | |||
|
|
77 | 0 4 954.0 .0 .00 .00 dgrf50 13 | |||
|
|
78 | 1 4 792.0 136.0 .00 .00 dgrf50 14 | |||
|
|
79 | 2 4 528.0 -278.0 .00 .00 dgrf50 15 | |||
|
|
80 | 3 4 -408.0 -37.0 .00 .00 dgrf50 16 | |||
|
|
81 | 4 4 303.0 -210.0 .00 .00 dgrf50 17 | |||
|
|
82 | 0 5 -240.0 .0 .00 .00 dgrf50 18 | |||
|
|
83 | 1 5 349.0 3.0 .00 .00 dgrf50 19 | |||
|
|
84 | 2 5 211.0 103.0 .00 .00 dgrf50 20 | |||
|
|
85 | 3 5 -20.0 -87.0 .00 .00 dgrf50 21 | |||
|
|
86 | 4 5 -147.0 -122.0 .00 .00 dgrf50 22 | |||
|
|
87 | 5 5 -76.0 80.0 .00 .00 dgrf50 23 | |||
|
|
88 | 0 6 54.0 .0 .00 .00 dgrf50 24 | |||
|
|
89 | 1 6 57.0 -1.0 .00 .00 dgrf50 25 | |||
|
|
90 | 2 6 4.0 99.0 .00 .00 dgrf50 26 | |||
|
|
91 | 3 6 -247.0 33.0 .00 .00 dgrf50 27 | |||
|
|
92 | 4 6 -16.0 -12.0 .00 .00 dgrf50 28 | |||
|
|
93 | 5 6 12.0 -12.0 .00 .00 dgrf50 29 | |||
|
|
94 | 6 6 -105.0 -30.0 .00 .00 dgrf50 30 | |||
|
|
95 | 0 7 65.0 .0 .00 .00 dgrf50 31 | |||
|
|
96 | 1 7 -55.0 -35.0 .00 .00 dgrf50 32 | |||
|
|
97 | 2 7 2.0 -17.0 .00 .00 dgrf50 33 | |||
|
|
98 | 3 7 1.0 .0 .00 .00 dgrf50 34 | |||
|
|
99 | 4 7 -40.0 10.0 .00 .00 dgrf50 35 | |||
|
|
100 | 5 7 -7.0 36.0 .00 .00 dgrf50 36 | |||
|
|
101 | 6 7 5.0 -18.0 .00 .00 dgrf50 37 | |||
|
|
102 | 7 7 19.0 -16.0 .00 .00 dgrf50 38 | |||
|
|
103 | 0 8 22.0 .0 .00 .00 dgrf50 39 | |||
|
|
104 | 1 8 15.0 5.0 .00 .00 dgrf50 40 | |||
|
|
105 | 2 8 -4.0 -22.0 .00 .00 dgrf50 41 | |||
|
|
106 | 3 8 -1.0 .0 .00 .00 dgrf50 42 | |||
|
|
107 | 4 8 11.0 -21.0 .00 .00 dgrf50 43 | |||
|
|
108 | 5 8 15.0 -8.0 .00 .00 dgrf50 44 | |||
|
|
109 | 6 8 -13.0 17.0 .00 .00 dgrf50 45 | |||
|
|
110 | 7 8 5.0 -4.0 .00 .00 dgrf50 46 | |||
|
|
111 | 8 8 -1.0 -17.0 .00 .00 dgrf50 47 | |||
|
|
112 | 0 9 3.0 .0 .00 .00 dgrf50 48 | |||
|
|
113 | 1 9 -7.0 -24.0 .00 .00 dgrf50 49 | |||
|
|
114 | 2 9 -1.0 19.0 .00 .00 dgrf50 50 | |||
|
|
115 | 3 9 -25.0 12.0 .00 .00 dgrf50 51 | |||
|
|
116 | 4 9 10.0 2.0 .00 .00 dgrf50 52 | |||
|
|
117 | 5 9 5.0 2.0 .00 .00 dgrf50 53 | |||
|
|
118 | 6 9 -5.0 8.0 .00 .00 dgrf50 54 | |||
|
|
119 | 7 9 -2.0 8.0 .00 .00 dgrf50 55 | |||
|
|
120 | 8 9 3.0 -11.0 .00 .00 dgrf50 56 | |||
|
|
121 | 9 9 8.0 -7.0 .00 .00 dgrf50 57 | |||
|
|
122 | 010 -8.0 .0 .00 .00 dgrf50 58 | |||
|
|
123 | 110 4.0 13.0 .00 .00 dgrf50 59 | |||
|
|
124 | 210 -1.0 -2.0 .00 .00 dgrf50 60 | |||
|
|
125 | 310 13.0 -10.0 .00 .00 dgrf50 61 | |||
|
|
126 | 410 -4.0 2.0 .00 .00 dgrf50 62 | |||
|
|
127 | 510 4.0 -3.0 .00 .00 dgrf50 63 | |||
|
|
128 | 610 12.0 6.0 .00 .00 dgrf50 64 | |||
|
|
129 | 710 3.0 -3.0 .00 .00 dgrf50 65 | |||
|
|
130 | 810 2.0 6.0 .00 .00 dgrf50 66 | |||
|
|
131 | 910 10.0 11.0 .00 .00 dgrf50 67 | |||
|
|
132 | 1010 3.0 8.0 .00 .00 dgrf50 68 | |||
|
|
133 | DGRF55 1955.00 10 0 0 1955.00 1960.00 -1.0 600.0 dgrf55 1 | |||
|
|
134 | 0 1-30500.0 .0 .00 .00 dgrf55 2 | |||
|
|
135 | 1 1 -2215.0 5820.0 .00 .00 dgrf55 3 | |||
|
|
136 | 0 2 -1440.0 .0 .00 .00 dgrf55 4 | |||
|
|
137 | 1 2 3003.0 -1898.0 .00 .00 dgrf55 5 | |||
|
|
138 | 2 2 1581.0 291.0 .00 .00 dgrf55 6 | |||
|
|
139 | 0 3 1302.0 .0 .00 .00 dgrf55 7 | |||
|
|
140 | 1 3 -1944.0 -462.0 .00 .00 dgrf55 8 | |||
|
|
141 | 2 3 1288.0 216.0 .00 .00 dgrf55 9 | |||
|
|
142 | 3 3 882.0 -83.0 .00 .00 dgrf55 10 | |||
|
|
143 | 0 4 958.0 .0 .00 .00 dgrf55 11 | |||
|
|
144 | 1 4 796.0 133.0 .00 .00 dgrf55 12 | |||
|
|
145 | 2 4 510.0 -274.0 .00 .00 dgrf55 13 | |||
|
|
146 | 3 4 -397.0 -23.0 .00 .00 dgrf55 14 | |||
|
|
147 | 4 4 290.0 -230.0 .00 .00 dgrf55 15 | |||
|
|
148 | 0 5 -229.0 .0 .00 .00 dgrf55 16 | |||
|
|
149 | 1 5 360.0 15.0 .00 .00 dgrf55 17 | |||
|
|
150 | 2 5 230.0 110.0 .00 .00 dgrf55 18 | |||
|
|
151 | 3 5 -23.0 -98.0 .00 .00 dgrf55 19 | |||
|
|
152 | 4 5 -152.0 -121.0 .00 .00 dgrf55 20 | |||
|
|
153 | 5 5 -69.0 78.0 .00 .00 dgrf55 21 | |||
|
|
154 | 0 6 47.0 .0 .00 .00 dgrf55 22 | |||
|
|
155 | 1 6 57.0 -9.0 .00 .00 dgrf55 23 | |||
|
|
156 | 2 6 3.0 96.0 .00 .00 dgrf55 24 | |||
|
|
157 | 3 6 -247.0 48.0 .00 .00 dgrf55 25 | |||
|
|
158 | 4 6 -8.0 -16.0 .00 .00 dgrf55 26 | |||
|
|
159 | 5 6 7.0 -12.0 .00 .00 dgrf55 27 | |||
|
|
160 | 6 6 -107.0 -24.0 .00 .00 dgrf55 28 | |||
|
|
161 | 0 7 65.0 .0 .00 .00 dgrf55 29 | |||
|
|
162 | 1 7 -56.0 -50.0 .00 .00 dgrf55 30 | |||
|
|
163 | 2 7 2.0 -24.0 .00 .00 dgrf55 31 | |||
|
|
164 | 3 7 10.0 -4.0 .00 .00 dgrf55 32 | |||
|
|
165 | 4 7 -32.0 8.0 .00 .00 dgrf55 33 | |||
|
|
166 | 5 7 -11.0 28.0 .00 .00 dgrf55 34 | |||
|
|
167 | 6 7 9.0 -20.0 .00 .00 dgrf55 35 | |||
|
|
168 | 7 7 18.0 -18.0 .00 .00 dgrf55 36 | |||
|
|
169 | 0 8 11.0 .0 .00 .00 dgrf55 37 | |||
|
|
170 | 1 8 9.0 10.0 .00 .00 dgrf55 38 | |||
|
|
171 | 2 8 -6.0 -15.0 .00 .00 dgrf55 39 | |||
|
|
172 | 3 8 -14.0 5.0 .00 .00 dgrf55 40 | |||
|
|
173 | 4 8 6.0 -23.0 .00 .00 dgrf55 41 | |||
|
|
174 | 5 8 10.0 3.0 .00 .00 dgrf55 42 | |||
|
|
175 | 6 8 -7.0 23.0 .00 .00 dgrf55 43 | |||
|
|
176 | 7 8 6.0 -4.0 .00 .00 dgrf55 44 | |||
|
|
177 | 8 8 9.0 -13.0 .00 .00 dgrf55 45 | |||
|
|
178 | 0 9 4.0 .0 .00 .00 dgrf55 46 | |||
|
|
179 | 1 9 9.0 -11.0 .00 .00 dgrf55 47 | |||
|
|
180 | 2 9 -4.0 12.0 .00 .00 dgrf55 48 | |||
|
|
181 | 3 9 -5.0 7.0 .00 .00 dgrf55 49 | |||
|
|
182 | 4 9 2.0 6.0 .00 .00 dgrf55 50 | |||
|
|
183 | 5 9 4.0 -2.0 .00 .00 dgrf55 51 | |||
|
|
184 | 6 9 1.0 10.0 .00 .00 dgrf55 52 | |||
|
|
185 | 7 9 2.0 7.0 .00 .00 dgrf55 53 | |||
|
|
186 | 8 9 2.0 -6.0 .00 .00 dgrf55 54 | |||
|
|
187 | 9 9 5.0 5.0 .00 .00 dgrf55 55 | |||
|
|
188 | 010 -3.0 .0 .00 .00 dgrf55 56 | |||
|
|
189 | 110 -5.0 -4.0 .00 .00 dgrf55 57 | |||
|
|
190 | 210 -1.0 .0 .00 .00 dgrf55 58 | |||
|
|
191 | 310 2.0 -8.0 .00 .00 dgrf55 59 | |||
|
|
192 | 410 -3.0 -2.0 .00 .00 dgrf55 60 | |||
|
|
193 | 510 7.0 -4.0 .00 .00 dgrf55 61 | |||
|
|
194 | 610 4.0 1.0 .00 .00 dgrf55 62 | |||
|
|
195 | 710 -2.0 -3.0 .00 .00 dgrf55 63 | |||
|
|
196 | 810 6.0 7.0 .00 .00 dgrf55 64 | |||
|
|
197 | 910 -2.0 -1.0 .00 .00 dgrf55 65 | |||
|
|
198 | 1010 .0 -3.0 .00 .00 dgrf55 66 | |||
|
|
199 | DGRF60 1960.00 10 0 0 1960.00 1965.00 -1.0 600.0 dgrf60 1 | |||
|
|
200 | 0 1-30421.0 .0 .00 .00 dgrf60 2 | |||
|
|
201 | 1 1 -2169.0 5791.0 .00 .00 dgrf60 3 | |||
|
|
202 | 0 2 -1555.0 .0 .00 .00 dgrf60 4 | |||
|
|
203 | 1 2 3002.0 -1967.0 .00 .00 dgrf60 5 | |||
|
|
204 | 2 2 1590.0 206.0 .00 .00 dgrf60 6 | |||
|
|
205 | 0 3 1302.0 .0 .00 .00 dgrf60 7 | |||
|
|
206 | 1 3 -1992.0 -414.0 .00 .00 dgrf60 8 | |||
|
|
207 | 2 3 1289.0 224.0 .00 .00 dgrf60 9 | |||
|
|
208 | 3 3 878.0 -130.0 .00 .00 dgrf60 10 | |||
|
|
209 | 0 4 957.0 .0 .00 .00 dgrf60 11 | |||
|
|
210 | 1 4 800.0 135.0 .00 .00 dgrf60 12 | |||
|
|
211 | 2 4 504.0 -278.0 .00 .00 dgrf60 13 | |||
|
|
212 | 3 4 -394.0 3.0 .00 .00 dgrf60 14 | |||
|
|
213 | 4 4 269.0 -255.0 .00 .00 dgrf60 15 | |||
|
|
214 | 0 5 -222.0 .0 .00 .00 dgrf60 16 | |||
|
|
215 | 1 5 362.0 16.0 .00 .00 dgrf60 17 | |||
|
|
216 | 2 5 242.0 125.0 .00 .00 dgrf60 18 | |||
|
|
217 | 3 5 -26.0 -117.0 .00 .00 dgrf60 19 | |||
|
|
218 | 4 5 -156.0 -114.0 .00 .00 dgrf60 20 | |||
|
|
219 | 5 5 -63.0 81.0 .00 .00 dgrf60 21 | |||
|
|
220 | 0 6 46.0 .0 .00 .00 dgrf60 22 | |||
|
|
221 | 1 6 58.0 -10.0 .00 .00 dgrf60 23 | |||
|
|
222 | 2 6 1.0 99.0 .00 .00 dgrf60 24 | |||
|
|
223 | 3 6 -237.0 60.0 .00 .00 dgrf60 25 | |||
|
|
224 | 4 6 -1.0 -20.0 .00 .00 dgrf60 26 | |||
|
|
225 | 5 6 -2.0 -11.0 .00 .00 dgrf60 27 | |||
|
|
226 | 6 6 -113.0 -17.0 .00 .00 dgrf60 28 | |||
|
|
227 | 0 7 67.0 .0 .00 .00 dgrf60 29 | |||
|
|
228 | 1 7 -56.0 -55.0 .00 .00 dgrf60 30 | |||
|
|
229 | 2 7 5.0 -28.0 .00 .00 dgrf60 31 | |||
|
|
230 | 3 7 15.0 -6.0 .00 .00 dgrf60 32 | |||
|
|
231 | 4 7 -32.0 7.0 .00 .00 dgrf60 33 | |||
|
|
232 | 5 7 -7.0 23.0 .00 .00 dgrf60 34 | |||
|
|
233 | 6 7 17.0 -18.0 .00 .00 dgrf60 35 | |||
|
|
234 | 7 7 8.0 -17.0 .00 .00 dgrf60 36 | |||
|
|
235 | 0 8 15.0 .0 .00 .00 dgrf60 37 | |||
|
|
236 | 1 8 6.0 11.0 .00 .00 dgrf60 38 | |||
|
|
237 | 2 8 -4.0 -14.0 .00 .00 dgrf60 39 | |||
|
|
238 | 3 8 -11.0 7.0 .00 .00 dgrf60 40 | |||
|
|
239 | 4 8 2.0 -18.0 .00 .00 dgrf60 41 | |||
|
|
240 | 5 8 10.0 4.0 .00 .00 dgrf60 42 | |||
|
|
241 | 6 8 -5.0 23.0 .00 .00 dgrf60 43 | |||
|
|
242 | 7 8 10.0 1.0 .00 .00 dgrf60 44 | |||
|
|
243 | 8 8 8.0 -20.0 .00 .00 dgrf60 45 | |||
|
|
244 | 0 9 4.0 .0 .00 .00 dgrf60 46 | |||
|
|
245 | 1 9 6.0 -18.0 .00 .00 dgrf60 47 | |||
|
|
246 | 2 9 .0 12.0 .00 .00 dgrf60 48 | |||
|
|
247 | 3 9 -9.0 2.0 .00 .00 dgrf60 49 | |||
|
|
248 | 4 9 1.0 .0 .00 .00 dgrf60 50 | |||
|
|
249 | 5 9 4.0 -3.0 .00 .00 dgrf60 51 | |||
|
|
250 | 6 9 -1.0 9.0 .00 .00 dgrf60 52 | |||
|
|
251 | 7 9 -2.0 8.0 .00 .00 dgrf60 53 | |||
|
|
252 | 8 9 3.0 .0 .00 .00 dgrf60 54 | |||
|
|
253 | 9 9 -1.0 5.0 .00 .00 dgrf60 55 | |||
|
|
254 | 010 1.0 .0 .00 .00 dgrf60 56 | |||
|
|
255 | 110 -3.0 4.0 .00 .00 dgrf60 57 | |||
|
|
256 | 210 4.0 1.0 .00 .00 dgrf60 58 | |||
|
|
257 | 310 .0 .0 .00 .00 dgrf60 59 | |||
|
|
258 | 410 -1.0 2.0 .00 .00 dgrf60 60 | |||
|
|
259 | 510 4.0 -5.0 .00 .00 dgrf60 61 | |||
|
|
260 | 610 6.0 1.0 .00 .00 dgrf60 62 | |||
|
|
261 | 710 1.0 -1.0 .00 .00 dgrf60 63 | |||
|
|
262 | 810 -1.0 6.0 .00 .00 dgrf60 64 | |||
|
|
263 | 910 2.0 .0 .00 .00 dgrf60 65 | |||
|
|
264 | 1010 .0 -7.0 .00 .00 dgrf60 66 | |||
|
|
265 | DGRF65 1965.00 10 0 0 1965.00 1970.00 -1.0 600.0 dgrf65 1 | |||
|
|
266 | 0 1-30334.0 .0 .00 .00 dgrf65 2 | |||
|
|
267 | 1 1 -2119.0 5776.0 .00 .00 dgrf65 3 | |||
|
|
268 | 0 2 -1662.0 .0 .00 .00 dgrf65 4 | |||
|
|
269 | 1 2 2997.0 -2016.0 .00 .00 dgrf65 5 | |||
|
|
270 | 2 2 1594.0 114.0 .00 .00 dgrf65 6 | |||
|
|
271 | 0 3 1297.0 .0 .00 .00 dgrf65 7 | |||
|
|
272 | 1 3 -2038.0 -404.0 .00 .00 dgrf65 8 | |||
|
|
273 | 2 3 1292.0 240.0 .00 .00 dgrf65 9 | |||
|
|
274 | 3 3 856.0 -165.0 .00 .00 dgrf65 10 | |||
|
|
275 | 0 4 957.0 .0 .00 .00 dgrf65 11 | |||
|
|
276 | 1 4 804.0 148.0 .00 .00 dgrf65 12 | |||
|
|
277 | 2 4 479.0 -269.0 .00 .00 dgrf65 13 | |||
|
|
278 | 3 4 -390.0 13.0 .00 .00 dgrf65 14 | |||
|
|
279 | 4 4 252.0 -269.0 .00 .00 dgrf65 15 | |||
|
|
280 | 0 5 -219.0 .0 .00 .00 dgrf65 16 | |||
|
|
281 | 1 5 358.0 19.0 .00 .00 dgrf65 17 | |||
|
|
282 | 2 5 254.0 128.0 .00 .00 dgrf65 18 | |||
|
|
283 | 3 5 -31.0 -126.0 .00 .00 dgrf65 19 | |||
|
|
284 | 4 5 -157.0 -97.0 .00 .00 dgrf65 20 | |||
|
|
285 | 5 5 -62.0 81.0 .00 .00 dgrf65 21 | |||
|
|
286 | 0 6 45.0 .0 .00 .00 dgrf65 22 | |||
|
|
287 | 1 6 61.0 -11.0 .00 .00 dgrf65 23 | |||
|
|
288 | 2 6 8.0 100.0 .00 .00 dgrf65 24 | |||
|
|
289 | 3 6 -228.0 68.0 .00 .00 dgrf65 25 | |||
|
|
290 | 4 6 4.0 -32.0 .00 .00 dgrf65 26 | |||
|
|
291 | 5 6 1.0 -8.0 .00 .00 dgrf65 27 | |||
|
|
292 | 6 6 -111.0 -7.0 .00 .00 dgrf65 28 | |||
|
|
293 | 0 7 75.0 .0 .00 .00 dgrf65 29 | |||
|
|
294 | 1 7 -57.0 -61.0 .00 .00 dgrf65 30 | |||
|
|
295 | 2 7 4.0 -27.0 .00 .00 dgrf65 31 | |||
|
|
296 | 3 7 13.0 -2.0 .00 .00 dgrf65 32 | |||
|
|
297 | 4 7 -26.0 6.0 .00 .00 dgrf65 33 | |||
|
|
298 | 5 7 -6.0 26.0 .00 .00 dgrf65 34 | |||
|
|
299 | 6 7 13.0 -23.0 .00 .00 dgrf65 35 | |||
|
|
300 | 7 7 1.0 -12.0 .00 .00 dgrf65 36 | |||
|
|
301 | 0 8 13.0 .0 .00 .00 dgrf65 37 | |||
|
|
302 | 1 8 5.0 7.0 .00 .00 dgrf65 38 | |||
|
|
303 | 2 8 -4.0 -12.0 .00 .00 dgrf65 39 | |||
|
|
304 | 3 8 -14.0 9.0 .00 .00 dgrf65 40 | |||
|
|
305 | 4 8 .0 -16.0 .00 .00 dgrf65 41 | |||
|
|
306 | 5 8 8.0 4.0 .00 .00 dgrf65 42 | |||
|
|
307 | 6 8 -1.0 24.0 .00 .00 dgrf65 43 | |||
|
|
308 | 7 8 11.0 -3.0 .00 .00 dgrf65 44 | |||
|
|
309 | 8 8 4.0 -17.0 .00 .00 dgrf65 45 | |||
|
|
310 | 0 9 8.0 .0 .00 .00 dgrf65 46 | |||
|
|
311 | 1 9 10.0 -22.0 .00 .00 dgrf65 47 | |||
|
|
312 | 2 9 2.0 15.0 .00 .00 dgrf65 48 | |||
|
|
313 | 3 9 -13.0 7.0 .00 .00 dgrf65 49 | |||
|
|
314 | 4 9 10.0 -4.0 .00 .00 dgrf65 50 | |||
|
|
315 | 5 9 -1.0 -5.0 .00 .00 dgrf65 51 | |||
|
|
316 | 6 9 -1.0 10.0 .00 .00 dgrf65 52 | |||
|
|
317 | 7 9 5.0 10.0 .00 .00 dgrf65 53 | |||
|
|
318 | 8 9 1.0 -4.0 .00 .00 dgrf65 54 | |||
|
|
319 | 9 9 -2.0 1.0 .00 .00 dgrf65 55 | |||
|
|
320 | 010 -2.0 .0 .00 .00 dgrf65 56 | |||
|
|
321 | 110 -3.0 2.0 .00 .00 dgrf65 57 | |||
|
|
322 | 210 2.0 1.0 .00 .00 dgrf65 58 | |||
|
|
323 | 310 -5.0 2.0 .00 .00 dgrf65 59 | |||
|
|
324 | 410 -2.0 6.0 .00 .00 dgrf65 60 | |||
|
|
325 | 510 4.0 -4.0 .00 .00 dgrf65 61 | |||
|
|
326 | 610 4.0 .0 .00 .00 dgrf65 62 | |||
|
|
327 | 710 .0 -2.0 .00 .00 dgrf65 63 | |||
|
|
328 | 810 2.0 3.0 .00 .00 dgrf65 64 | |||
|
|
329 | 910 2.0 .0 .00 .00 dgrf65 65 | |||
|
|
330 | 1010 .0 -6.0 .00 .00 dgrf65 66 | |||
|
|
331 | DGRF70 1970.00 10 0 0 1970.00 1975.00 -1.0 600.0 dgrf70 1 | |||
|
|
332 | 0 1-30220.0 .0 .00 .00 dgrf70 2 | |||
|
|
333 | 1 1 -2068.0 5737.0 .00 .00 dgrf70 3 | |||
|
|
334 | 0 2 -1781.0 .0 .00 .00 dgrf70 4 | |||
|
|
335 | 1 2 3000.0 -2047.0 .00 .00 dgrf70 5 | |||
|
|
336 | 2 2 1611.0 25.0 .00 .00 dgrf70 6 | |||
|
|
337 | 0 3 1287.0 .0 .00 .00 dgrf70 7 | |||
|
|
338 | 1 3 -2091.0 -366.0 .00 .00 dgrf70 8 | |||
|
|
339 | 2 3 1278.0 251.0 .00 .00 dgrf70 9 | |||
|
|
340 | 3 3 838.0 -196.0 .00 .00 dgrf70 10 | |||
|
|
341 | 0 4 952.0 .0 .00 .00 dgrf70 11 | |||
|
|
342 | 1 4 800.0 167.0 .00 .00 dgrf70 12 | |||
|
|
343 | 2 4 461.0 -266.0 .00 .00 dgrf70 13 | |||
|
|
344 | 3 4 -395.0 26.0 .00 .00 dgrf70 14 | |||
|
|
345 | 4 4 234.0 -279.0 .00 .00 dgrf70 15 | |||
|
|
346 | 0 5 -216.0 .0 .00 .00 dgrf70 16 | |||
|
|
347 | 1 5 359.0 26.0 .00 .00 dgrf70 17 | |||
|
|
348 | 2 5 262.0 139.0 .00 .00 dgrf70 18 | |||
|
|
349 | 3 5 -42.0 -139.0 .00 .00 dgrf70 19 | |||
|
|
350 | 4 5 -160.0 -91.0 .00 .00 dgrf70 20 | |||
|
|
351 | 5 5 -56.0 83.0 .00 .00 dgrf70 21 | |||
|
|
352 | 0 6 43.0 .0 .00 .00 dgrf70 22 | |||
|
|
353 | 1 6 64.0 -12.0 .00 .00 dgrf70 23 | |||
|
|
354 | 2 6 15.0 100.0 .00 .00 dgrf70 24 | |||
|
|
355 | 3 6 -212.0 72.0 .00 .00 dgrf70 25 | |||
|
|
356 | 4 6 2.0 -37.0 .00 .00 dgrf70 26 | |||
|
|
357 | 5 6 3.0 -6.0 .00 .00 dgrf70 27 | |||
|
|
358 | 6 6 -112.0 1.0 .00 .00 dgrf70 28 | |||
|
|
359 | 0 7 72.0 .0 .00 .00 dgrf70 29 | |||
|
|
360 | 1 7 -57.0 -70.0 .00 .00 dgrf70 30 | |||
|
|
361 | 2 7 1.0 -27.0 .00 .00 dgrf70 31 | |||
|
|
362 | 3 7 14.0 -4.0 .00 .00 dgrf70 32 | |||
|
|
363 | 4 7 -22.0 8.0 .00 .00 dgrf70 33 | |||
|
|
364 | 5 7 -2.0 23.0 .00 .00 dgrf70 34 | |||
|
|
365 | 6 7 13.0 -23.0 .00 .00 dgrf70 35 | |||
|
|
366 | 7 7 -2.0 -11.0 .00 .00 dgrf70 36 | |||
|
|
367 | 0 8 14.0 .0 .00 .00 dgrf70 37 | |||
|
|
368 | 1 8 6.0 7.0 .00 .00 dgrf70 38 | |||
|
|
369 | 2 8 -2.0 -15.0 .00 .00 dgrf70 39 | |||
|
|
370 | 3 8 -13.0 6.0 .00 .00 dgrf70 40 | |||
|
|
371 | 4 8 -3.0 -17.0 .00 .00 dgrf70 41 | |||
|
|
372 | 5 8 5.0 6.0 .00 .00 dgrf70 42 | |||
|
|
373 | 6 8 .0 21.0 .00 .00 dgrf70 43 | |||
|
|
374 | 7 8 11.0 -6.0 .00 .00 dgrf70 44 | |||
|
|
375 | 8 8 3.0 -16.0 .00 .00 dgrf70 45 | |||
|
|
376 | 0 9 8.0 .0 .00 .00 dgrf70 46 | |||
|
|
377 | 1 9 10.0 -21.0 .00 .00 dgrf70 47 | |||
|
|
378 | 2 9 2.0 16.0 .00 .00 dgrf70 48 | |||
|
|
379 | 3 9 -12.0 6.0 .00 .00 dgrf70 49 | |||
|
|
380 | 4 9 10.0 -4.0 .00 .00 dgrf70 50 | |||
|
|
381 | 5 9 -1.0 -5.0 .00 .00 dgrf70 51 | |||
|
|
382 | 6 9 .0 10.0 .00 .00 dgrf70 52 | |||
|
|
383 | 7 9 3.0 11.0 .00 .00 dgrf70 53 | |||
|
|
384 | 8 9 1.0 -2.0 .00 .00 dgrf70 54 | |||
|
|
385 | 9 9 -1.0 1.0 .00 .00 dgrf70 55 | |||
|
|
386 | 010 -3.0 .0 .00 .00 dgrf70 56 | |||
|
|
387 | 110 -3.0 1.0 .00 .00 dgrf70 57 | |||
|
|
388 | 210 2.0 1.0 .00 .00 dgrf70 58 | |||
|
|
389 | 310 -5.0 3.0 .00 .00 dgrf70 59 | |||
|
|
390 | 410 -1.0 4.0 .00 .00 dgrf70 60 | |||
|
|
391 | 510 6.0 -4.0 .00 .00 dgrf70 61 | |||
|
|
392 | 610 4.0 .0 .00 .00 dgrf70 62 | |||
|
|
393 | 710 1.0 -1.0 .00 .00 dgrf70 63 | |||
|
|
394 | 810 .0 3.0 .00 .00 dgrf70 64 | |||
|
|
395 | 910 3.0 1.0 .00 .00 dgrf70 65 | |||
|
|
396 | 1010 -1.0 -4.0 .00 .00 dgrf70 66 | |||
|
|
397 | DGRF75 1975.00 10 0 0 1975.00 1980.00 -1.0 600.0 dgrf75 1 | |||
|
|
398 | 0 1-30100.0 .0 .00 .00 dgrf75 2 | |||
|
|
399 | 1 1 -2013.0 5675.0 .00 .00 dgrf75 3 | |||
|
|
400 | 0 2 -1902.0 .0 .00 .00 dgrf75 4 | |||
|
|
401 | 1 2 3010.0 -2067.0 .00 .00 dgrf75 5 | |||
|
|
402 | 2 2 1632.0 -68.0 .00 .00 dgrf75 6 | |||
|
|
403 | 0 3 1276.0 .0 .00 .00 dgrf75 7 | |||
|
|
404 | 1 3 -2144.0 -333.0 .00 .00 dgrf75 8 | |||
|
|
405 | 2 3 1260.0 262.0 .00 .00 dgrf75 9 | |||
|
|
406 | 3 3 830.0 -223.0 .00 .00 dgrf75 10 | |||
|
|
407 | 0 4 946.0 .0 .00 .00 dgrf75 11 | |||
|
|
408 | 1 4 791.0 191.0 .00 .00 dgrf75 12 | |||
|
|
409 | 2 4 438.0 -265.0 .00 .00 dgrf75 13 | |||
|
|
410 | 3 4 -405.0 39.0 .00 .00 dgrf75 14 | |||
|
|
411 | 4 4 216.0 -288.0 .00 .00 dgrf75 15 | |||
|
|
412 | 0 5 -218.0 .0 .00 .00 dgrf75 16 | |||
|
|
413 | 1 5 356.0 31.0 .00 .00 dgrf75 17 | |||
|
|
414 | 2 5 264.0 148.0 .00 .00 dgrf75 18 | |||
|
|
415 | 3 5 -59.0 -152.0 .00 .00 dgrf75 19 | |||
|
|
416 | 4 5 -159.0 -83.0 .00 .00 dgrf75 20 | |||
|
|
417 | 5 5 -49.0 88.0 .00 .00 dgrf75 21 | |||
|
|
418 | 0 6 45.0 .0 .00 .00 dgrf75 22 | |||
|
|
419 | 1 6 66.0 -13.0 .00 .00 dgrf75 23 | |||
|
|
420 | 2 6 28.0 99.0 .00 .00 dgrf75 24 | |||
|
|
421 | 3 6 -198.0 75.0 .00 .00 dgrf75 25 | |||
|
|
422 | 4 6 1.0 -41.0 .00 .00 dgrf75 26 | |||
|
|
423 | 5 6 6.0 -4.0 .00 .00 dgrf75 27 | |||
|
|
424 | 6 6 -111.0 11.0 .00 .00 dgrf75 28 | |||
|
|
425 | 0 7 71.0 .0 .00 .00 dgrf75 29 | |||
|
|
426 | 1 7 -56.0 -77.0 .00 .00 dgrf75 30 | |||
|
|
427 | 2 7 1.0 -26.0 .00 .00 dgrf75 31 | |||
|
|
428 | 3 7 16.0 -5.0 .00 .00 dgrf75 32 | |||
|
|
429 | 4 7 -14.0 10.0 .00 .00 dgrf75 33 | |||
|
|
430 | 5 7 .0 22.0 .00 .00 dgrf75 34 | |||
|
|
431 | 6 7 12.0 -23.0 .00 .00 dgrf75 35 | |||
|
|
432 | 7 7 -5.0 -12.0 .00 .00 dgrf75 36 | |||
|
|
433 | 0 8 14.0 .0 .00 .00 dgrf75 37 | |||
|
|
434 | 1 8 6.0 6.0 .00 .00 dgrf75 38 | |||
|
|
435 | 2 8 -1.0 -16.0 .00 .00 dgrf75 39 | |||
|
|
436 | 3 8 -12.0 4.0 .00 .00 dgrf75 40 | |||
|
|
437 | 4 8 -8.0 -19.0 .00 .00 dgrf75 41 | |||
|
|
438 | 5 8 4.0 6.0 .00 .00 dgrf75 42 | |||
|
|
439 | 6 8 .0 18.0 .00 .00 dgrf75 43 | |||
|
|
440 | 7 8 10.0 -10.0 .00 .00 dgrf75 44 | |||
|
|
441 | 8 8 1.0 -17.0 .00 .00 dgrf75 45 | |||
|
|
442 | 0 9 7.0 .0 .00 .00 dgrf75 46 | |||
|
|
443 | 1 9 10.0 -21.0 .00 .00 dgrf75 47 | |||
|
|
444 | 2 9 2.0 16.0 .00 .00 dgrf75 48 | |||
|
|
445 | 3 9 -12.0 7.0 .00 .00 dgrf75 49 | |||
|
|
446 | 4 9 10.0 -4.0 .00 .00 dgrf75 50 | |||
|
|
447 | 5 9 -1.0 -5.0 .00 .00 dgrf75 51 | |||
|
|
448 | 6 9 -1.0 10.0 .00 .00 dgrf75 52 | |||
|
|
449 | 7 9 4.0 11.0 .00 .00 dgrf75 53 | |||
|
|
450 | 8 9 1.0 -3.0 .00 .00 dgrf75 54 | |||
|
|
451 | 9 9 -2.0 1.0 .00 .00 dgrf75 55 | |||
|
|
452 | 010 -3.0 .0 .00 .00 dgrf75 56 | |||
|
|
453 | 110 -3.0 1.0 .00 .00 dgrf75 57 | |||
|
|
454 | 210 2.0 1.0 .00 .00 dgrf75 58 | |||
|
|
455 | 310 -5.0 3.0 .00 .00 dgrf75 59 | |||
|
|
456 | 410 -2.0 4.0 .00 .00 dgrf75 60 | |||
|
|
457 | 510 5.0 -4.0 .00 .00 dgrf75 61 | |||
|
|
458 | 610 4.0 -1.0 .00 .00 dgrf75 62 | |||
|
|
459 | 710 1.0 -1.0 .00 .00 dgrf75 63 | |||
|
|
460 | 810 .0 3.0 .00 .00 dgrf75 64 | |||
|
|
461 | 910 3.0 1.0 .00 .00 dgrf75 65 | |||
|
|
462 | 1010 -1.0 -5.0 .00 .00 dgrf75 66 | |||
|
|
463 | DGRF80 1980.00 10 0 0 1980.00 1985.00 -1.0 600.0 dgrf80 1 | |||
|
|
464 | 0 1-29992.0 .0 .00 .00 dgrf80 2 | |||
|
|
465 | 1 1 -1956.0 5604.0 .00 .00 dgrf80 3 | |||
|
|
466 | 0 2 -1997.0 .0 .00 .00 dgrf80 4 | |||
|
|
467 | 1 2 3027.0 -2129.0 .00 .00 dgrf80 5 | |||
|
|
468 | 2 2 1663.0 -200.0 .00 .00 dgrf80 6 | |||
|
|
469 | 0 3 1281.0 .0 .00 .00 dgrf80 7 | |||
|
|
470 | 1 3 -2180.0 -336.0 .00 .00 dgrf80 8 | |||
|
|
471 | 2 3 1251.0 271.0 .00 .00 dgrf80 9 | |||
|
|
472 | 3 3 833.0 -252.0 .00 .00 dgrf80 10 | |||
|
|
473 | 0 4 938.0 .0 .00 .00 dgrf80 11 | |||
|
|
474 | 1 4 782.0 212.0 .00 .00 dgrf80 12 | |||
|
|
475 | 2 4 398.0 -257.0 .00 .00 dgrf80 13 | |||
|
|
476 | 3 4 -419.0 53.0 .00 .00 dgrf80 14 | |||
|
|
477 | 4 4 199.0 -297.0 .00 .00 dgrf80 15 | |||
|
|
478 | 0 5 -218.0 .0 .00 .00 dgrf80 16 | |||
|
|
479 | 1 5 357.0 46.0 .00 .00 dgrf80 17 | |||
|
|
480 | 2 5 261.0 150.0 .00 .00 dgrf80 18 | |||
|
|
481 | 3 5 -74.0 -151.0 .00 .00 dgrf80 19 | |||
|
|
482 | 4 5 -162.0 -78.0 .00 .00 dgrf80 20 | |||
|
|
483 | 5 5 -48.0 92.0 .00 .00 dgrf80 21 | |||
|
|
484 | 0 6 48.0 .0 .00 .00 dgrf80 22 | |||
|
|
485 | 1 6 66.0 -15.0 .00 .00 dgrf80 23 | |||
|
|
486 | 2 6 42.0 93.0 .00 .00 dgrf80 24 | |||
|
|
487 | 3 6 -192.0 71.0 .00 .00 dgrf80 25 | |||
|
|
488 | 4 6 4.0 -43.0 .00 .00 dgrf80 26 | |||
|
|
489 | 5 6 14.0 -2.0 .00 .00 dgrf80 27 | |||
|
|
490 | 6 6 -108.0 17.0 .00 .00 dgrf80 28 | |||
|
|
491 | 0 7 72.0 .0 .00 .00 dgrf80 29 | |||
|
|
492 | 1 7 -59.0 -82.0 .00 .00 dgrf80 30 | |||
|
|
493 | 2 7 2.0 -27.0 .00 .00 dgrf80 31 | |||
|
|
494 | 3 7 21.0 -5.0 .00 .00 dgrf80 32 | |||
|
|
495 | 4 7 -12.0 16.0 .00 .00 dgrf80 33 | |||
|
|
496 | 5 7 1.0 18.0 .00 .00 dgrf80 34 | |||
|
|
497 | 6 7 11.0 -23.0 .00 .00 dgrf80 35 | |||
|
|
498 | 7 7 -2.0 -10.0 .00 .00 dgrf80 36 | |||
|
|
499 | 0 8 18.0 .0 .00 .00 dgrf80 37 | |||
|
|
500 | 1 8 6.0 7.0 .00 .00 dgrf80 38 | |||
|
|
501 | 2 8 .0 -18.0 .00 .00 dgrf80 39 | |||
|
|
502 | 3 8 -11.0 4.0 .00 .00 dgrf80 40 | |||
|
|
503 | 4 8 -7.0 -22.0 .00 .00 dgrf80 41 | |||
|
|
504 | 5 8 4.0 9.0 .00 .00 dgrf80 42 | |||
|
|
505 | 6 8 3.0 16.0 .00 .00 dgrf80 43 | |||
|
|
506 | 7 8 6.0 -13.0 .00 .00 dgrf80 44 | |||
|
|
507 | 8 8 -1.0 -15.0 .00 .00 dgrf80 45 | |||
|
|
508 | 0 9 5.0 .0 .00 .00 dgrf80 46 | |||
|
|
509 | 1 9 10.0 -21.0 .00 .00 dgrf80 47 | |||
|
|
510 | 2 9 1.0 16.0 .00 .00 dgrf80 48 | |||
|
|
511 | 3 9 -12.0 9.0 .00 .00 dgrf80 49 | |||
|
|
512 | 4 9 9.0 -5.0 .00 .00 dgrf80 50 | |||
|
|
513 | 5 9 -3.0 -6.0 .00 .00 dgrf80 51 | |||
|
|
514 | 6 9 -1.0 9.0 .00 .00 dgrf80 52 | |||
|
|
515 | 7 9 7.0 10.0 .00 .00 dgrf80 53 | |||
|
|
516 | 8 9 2.0 -6.0 .00 .00 dgrf80 54 | |||
|
|
517 | 9 9 -5.0 2.0 .00 .00 dgrf80 55 | |||
|
|
518 | 010 -4.0 .0 .00 .00 dgrf80 56 | |||
|
|
519 | 110 -4.0 1.0 .00 .00 dgrf80 57 | |||
|
|
520 | 210 2.0 .0 .00 .00 dgrf80 58 | |||
|
|
521 | 310 -5.0 3.0 .00 .00 dgrf80 59 | |||
|
|
522 | 410 -2.0 6.0 .00 .00 dgrf80 60 | |||
|
|
523 | 510 5.0 -4.0 .00 .00 dgrf80 61 | |||
|
|
524 | 610 3.0 .0 .00 .00 dgrf80 62 | |||
|
|
525 | 710 1.0 -1.0 .00 .00 dgrf80 63 | |||
|
|
526 | 810 2.0 4.0 .00 .00 dgrf80 64 | |||
|
|
527 | 910 3.0 .0 .00 .00 dgrf80 65 | |||
|
|
528 | 1010 .0 -6.0 .00 .00 dgrf80 66 | |||
|
|
529 | DGRF85 1985.00 10 0 0 1985.00 1990.00 -1.0 600.0 DGRF85 | |||
|
|
530 | 0 1-29872.6 .0 .0 .0 DGRF85 1 | |||
|
|
531 | 1 1 -1904.6 5500.4 .0 .0 DGRF85 2 | |||
|
|
532 | 0 2 -2072.0 .0 .0 .0 DGRF85 3 | |||
|
|
533 | 1 2 3044.1 -2197.0 .0 .0 DGRF85 4 | |||
|
|
534 | 2 2 1687.1 -306.1 .0 .0 DGRF85 5 | |||
|
|
535 | 0 3 1295.6 .0 .0 .0 DGRF85 6 | |||
|
|
536 | 1 3 -2208.2 -309.8 .0 .0 DGRF85 7 | |||
|
|
537 | 2 3 1246.8 283.8 .0 .0 DGRF85 8 | |||
|
|
538 | 3 3 829.4 -296.9 .0 .0 DGRF85 9 | |||
|
|
539 | 0 4 936.2 .0 .0 .0 DGRF85 10 | |||
|
|
540 | 1 4 780.4 231.7 .0 .0 DGRF85 11 | |||
|
|
541 | 2 4 361.4 -249.3 .0 .0 DGRF85 12 | |||
|
|
542 | 3 4 -424.3 69.5 .0 .0 DGRF85 13 | |||
|
|
543 | 4 4 169.9 -296.9 .0 .0 DGRF85 14 | |||
|
|
544 | 0 5 -213.9 .0 .0 .0 DGRF85 15 | |||
|
|
545 | 1 5 354.6 47.3 .0 .0 DGRF85 16 | |||
|
|
546 | 2 5 253.3 150.4 .0 .0 DGRF85 17 | |||
|
|
547 | 3 5 -93.1 -153.7 .0 .0 DGRF85 18 | |||
|
|
548 | 4 5 -163.7 -74.9 .0 .0 DGRF85 19 | |||
|
|
549 | 5 5 -46.3 95.1 .0 .0 DGRF85 20 | |||
|
|
550 | 0 6 53.3 .0 .0 .0 DGRF85 21 | |||
|
|
551 | 1 6 65.1 -15.7 .0 .0 DGRF85 22 | |||
|
|
552 | 2 6 50.9 88.4 .0 .0 DGRF85 23 | |||
|
|
553 | 3 6 -184.8 68.9 .0 .0 DGRF85 24 | |||
|
|
554 | 4 6 4.0 -48.0 .0 .0 DGRF85 25 | |||
|
|
555 | 5 6 15.9 -.6 .0 .0 DGRF85 26 | |||
|
|
556 | 6 6 -102.1 20.8 .0 .0 DGRF85 27 | |||
|
|
557 | 0 7 73.6 .0 .0 .0 DGRF85 28 | |||
|
|
558 | 1 7 -61.6 -82.7 .0 .0 DGRF85 29 | |||
|
|
559 | 2 7 3.2 -26.9 .0 .0 DGRF85 30 | |||
|
|
560 | 3 7 24.0 -2.3 .0 .0 DGRF85 31 | |||
|
|
561 | 4 7 -6.2 19.8 .0 .0 DGRF85 32 | |||
|
|
562 | 5 7 3.5 17.0 .0 .0 DGRF85 33 | |||
|
|
563 | 6 7 9.8 -22.8 .0 .0 DGRF85 34 | |||
|
|
564 | 7 7 -.5 -6.7 .0 .0 DGRF85 35 | |||
|
|
565 | 0 8 20.8 .0 .0 .0 DGRF85 36 | |||
|
|
566 | 1 8 6.3 7.7 .0 .0 DGRF85 37 | |||
|
|
567 | 2 8 -.0 -18.9 .0 .0 DGRF85 38 | |||
|
|
568 | 3 8 -10.9 4.8 .0 .0 DGRF85 39 | |||
|
|
569 | 4 8 -9.1 -23.2 .0 .0 DGRF85 40 | |||
|
|
570 | 5 8 3.6 10.7 .0 .0 DGRF85 41 | |||
|
|
571 | 6 8 3.6 13.6 .0 .0 DGRF85 42 | |||
|
|
572 | 7 8 3.8 -14.5 .0 .0 DGRF85 43 | |||
|
|
573 | 8 8 -3.7 -11.4 .0 .0 DGRF85 44 | |||
|
|
574 | 0 9 4.5 .0 .0 .0 DGRF85 45 | |||
|
|
575 | 1 9 9.8 -21.1 .0 .0 DGRF85 46 | |||
|
|
576 | 2 9 .6 15.4 .0 .0 DGRF85 47 | |||
|
|
577 | 3 9 -11.9 9.3 .0 .0 DGRF85 48 | |||
|
|
578 | 4 9 9.5 -5.6 .0 .0 DGRF85 49 | |||
|
|
579 | 5 9 -3.5 -6.3 .0 .0 DGRF85 50 | |||
|
|
580 | 6 9 -1.3 8.9 .0 .0 DGRF85 51 | |||
|
|
581 | 7 9 7.0 9.4 .0 .0 DGRF85 52 | |||
|
|
582 | 8 9 1.5 -6.5 .0 .0 DGRF85 53 | |||
|
|
583 | 9 9 -5.4 2.0 .0 .0 DGRF85 54 | |||
|
|
584 | 010 -3.6 .0 .0 .0 DGRF85 55 | |||
|
|
585 | 110 -3.7 1.4 .0 .0 DGRF85 56 | |||
|
|
586 | 210 2.6 .4 .0 .0 DGRF85 57 | |||
|
|
587 | 310 -5.3 2.9 .0 .0 DGRF85 58 | |||
|
|
588 | 410 -2.4 5.8 .0 .0 DGRF85 59 | |||
|
|
589 | 510 4.5 -4.1 .0 .0 DGRF85 60 | |||
|
|
590 | 610 3.0 -.3 .0 .0 DGRF85 61 | |||
|
|
591 | 710 1.2 -1.4 .0 .0 DGRF85 62 | |||
|
|
592 | 810 2.2 3.8 .0 .0 DGRF85 63 | |||
|
|
593 | 910 3.1 -.4 .0 .0 DGRF85 64 | |||
|
|
594 | 1010 .0 -6.2 .0 .0 DGRF85 65 | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf05 | |||
|
|
2 | 10 6371.2 2005.0 | |||
|
|
3 | 1 0 -29556.8 0.0 | |||
|
|
4 | 1 1 -1671.8 5080.0 | |||
|
|
5 | 2 0 -2340.5 0.0 | |||
|
|
6 | 2 1 3047.0 -2594.9 | |||
|
|
7 | 2 2 1656.9 -516.7 | |||
|
|
8 | 3 0 1335.7 0.0 | |||
|
|
9 | 3 1 -2305.3 -200.4 | |||
|
|
10 | 3 2 1246.8 269.3 | |||
|
|
11 | 3 3 674.4 -524.5 | |||
|
|
12 | 4 0 919.8 0.0 | |||
|
|
13 | 4 1 798.2 281.4 | |||
|
|
14 | 4 2 211.5 -225.8 | |||
|
|
15 | 4 3 -379.5 145.7 | |||
|
|
16 | 4 4 100.2 -304.7 | |||
|
|
17 | 5 0 -227.6 0.0 | |||
|
|
18 | 5 1 354.4 42.7 | |||
|
|
19 | 5 2 208.8 179.8 | |||
|
|
20 | 5 3 -136.6 -123.0 | |||
|
|
21 | 5 4 -168.3 -19.5 | |||
|
|
22 | 5 5 -14.1 103.6 | |||
|
|
23 | 6 0 72.9 0.0 | |||
|
|
24 | 6 1 69.6 -20.2 | |||
|
|
25 | 6 2 76.6 54.7 | |||
|
|
26 | 6 3 -151.1 63.7 | |||
|
|
27 | 6 4 -15.0 -63.4 | |||
|
|
28 | 6 5 14.7 0.0 | |||
|
|
29 | 6 6 -86.4 50.3 | |||
|
|
30 | 7 0 79.8 0.0 | |||
|
|
31 | 7 1 -74.4 -61.4 | |||
|
|
32 | 7 2 -1.4 -22.5 | |||
|
|
33 | 7 3 38.6 6.9 | |||
|
|
34 | 7 4 12.3 25.4 | |||
|
|
35 | 7 5 9.4 10.9 | |||
|
|
36 | 7 6 5.5 -26.4 | |||
|
|
37 | 7 7 2.0 -4.8 | |||
|
|
38 | 8 0 24.8 0.0 | |||
|
|
39 | 8 1 7.7 11.2 | |||
|
|
40 | 8 2 -11.4 -21.0 | |||
|
|
41 | 8 3 -6.8 9.7 | |||
|
|
42 | 8 4 -18.0 -19.8 | |||
|
|
43 | 8 5 10.0 16.1 | |||
|
|
44 | 8 6 9.4 7.7 | |||
|
|
45 | 8 7 -11.4 -12.8 | |||
|
|
46 | 8 8 -5.0 -0.1 | |||
|
|
47 | 9 0 5.6 0.0 | |||
|
|
48 | 9 1 9.8 -20.1 | |||
|
|
49 | 9 2 3.6 12.9 | |||
|
|
50 | 9 3 -7.0 12.7 | |||
|
|
51 | 9 4 5.0 -6.7 | |||
|
|
52 | 9 5 -10.8 -8.1 | |||
|
|
53 | 9 6 -1.3 8.1 | |||
|
|
54 | 9 7 8.7 2.9 | |||
|
|
55 | 9 8 -6.7 -7.9 | |||
|
|
56 | 9 9 -9.2 5.9 | |||
|
|
57 | 10 0 -2.2 0.0 | |||
|
|
58 | 10 1 -6.3 2.4 | |||
|
|
59 | 10 2 1.6 0.2 | |||
|
|
60 | 10 3 -2.5 4.4 | |||
|
|
61 | 10 4 -0.1 4.7 | |||
|
|
62 | 10 5 3.0 -6.5 | |||
|
|
63 | 10 6 0.3 -1.0 | |||
|
|
64 | 10 7 2.1 -3.4 | |||
|
|
65 | 10 8 3.9 -0.9 | |||
|
|
66 | 10 9 -0.1 -2.3 | |||
|
|
67 | 10 10 -2.2 -8.0 No newline at end of file | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf05s | |||
|
|
2 | 8 6371.2 2010.0 | |||
|
|
3 | 1 0 8.8 0. | |||
|
|
4 | 1 1 10.8 -21.3 | |||
|
|
5 | 2 0 -15.0 0. | |||
|
|
6 | 2 1 -6.9 -23.3 | |||
|
|
7 | 2 2 -1.0 -14.0 | |||
|
|
8 | 3 0 -0.3 0.0 | |||
|
|
9 | 3 1 -3.1 5.4 | |||
|
|
10 | 3 2 -0.9 -6.5 | |||
|
|
11 | 3 3 -6.8 -2.0 | |||
|
|
12 | 4 0 -2.5 0. | |||
|
|
13 | 4 1 2.8 2.0 | |||
|
|
14 | 4 2 -7.1 1.8 | |||
|
|
15 | 4 3 5.9 5.6 | |||
|
|
16 | 4 4 -3.2 0.0 | |||
|
|
17 | 5 0 -2.6 0.0 | |||
|
|
18 | 5 1 0.4 0.1 | |||
|
|
19 | 5 2 -3.0 1.8 | |||
|
|
20 | 5 3 -1.2 2.0 | |||
|
|
21 | 5 4 0.2 4.5 | |||
|
|
22 | 5 5 -0.6 -1.0 | |||
|
|
23 | 6 0 -0.8 0.0 | |||
|
|
24 | 6 1 0.2 -0.4 | |||
|
|
25 | 6 2 -0.2 -1.9 | |||
|
|
26 | 6 3 2.1 -0.4 | |||
|
|
27 | 6 4 -2.1 -0.4 | |||
|
|
28 | 6 5 -0.4 -0.2 | |||
|
|
29 | 6 6 1.3 0.9 | |||
|
|
30 | 7 0 -0.4 0.0 | |||
|
|
31 | 7 1 0.0 0.8 | |||
|
|
32 | 7 2 -0.2 0.4 | |||
|
|
33 | 7 3 1.1 0.1 | |||
|
|
34 | 7 4 0.6 0.2 | |||
|
|
35 | 7 5 0.4 -0.9 | |||
|
|
36 | 7 6 -0.5 -0.3 | |||
|
|
37 | 7 7 0.9 0.3 | |||
|
|
38 | 8 0 -0.2 0.0 | |||
|
|
39 | 8 1 0.2 -0.2 | |||
|
|
40 | 8 2 -0.2 0.2 | |||
|
|
41 | 8 3 0.2 0.2 | |||
|
|
42 | 8 4 -0.2 0.4 | |||
|
|
43 | 8 5 0.2 0.2 | |||
|
|
44 | 8 6 0.5 -0.3 | |||
|
|
45 | 8 7 -0.7 0.5 | |||
|
|
46 | 8 8 0.5 0.4 No newline at end of file | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | igrf10 | |||
|
|
2 | 13 6371.2 2010.0 | |||
|
|
3 | 1 0 -29496.50 0.00 11.40 0.00 IGRF2010 1 | |||
|
|
4 | 1 1 -1585.90 4945.10 16.70 -28.80 IGRF2010 2 | |||
|
|
5 | 2 0 -2396.60 0.00 -11.30 0.00 IGRF2010 3 | |||
|
|
6 | 2 1 3026.00 -2707.70 -3.90 -23.00 IGRF2010 4 | |||
|
|
7 | 2 2 1668.60 -575.40 2.70 -12.90 IGRF2010 5 | |||
|
|
8 | 3 0 1339.70 0.00 1.30 0.00 IGRF2010 6 | |||
|
|
9 | 3 1 -2326.30 -160.50 -3.90 8.60 IGRF2010 7 | |||
|
|
10 | 3 2 1231.70 251.70 -2.90 -2.90 IGRF2010 8 | |||
|
|
11 | 3 3 634.20 -536.80 -8.10 -2.10 IGRF2010 9 | |||
|
|
12 | 4 0 912.60 0.00 -1.40 0.00 IGRF2010 10 | |||
|
|
13 | 4 1 809.00 286.40 2.00 0.40 IGRF2010 11 | |||
|
|
14 | 4 2 166.60 -211.20 -8.90 3.20 IGRF2010 12 | |||
|
|
15 | 4 3 -357.10 164.40 4.40 3.60 IGRF2010 13 | |||
|
|
16 | 4 4 89.70 -309.20 -2.30 -0.80 IGRF2010 14 | |||
|
|
17 | 5 0 -231.10 0.00 -0.50 0.00 IGRF2010 15 | |||
|
|
18 | 5 1 357.20 44.70 0.50 0.50 IGRF2010 16 | |||
|
|
19 | 5 2 200.30 188.90 -1.50 1.50 IGRF2010 17 | |||
|
|
20 | 5 3 -141.20 -118.10 -0.70 0.90 IGRF2010 18 | |||
|
|
21 | 5 4 -163.10 0.10 1.30 3.70 IGRF2010 19 | |||
|
|
22 | 5 5 -7.70 100.90 1.40 -0.60 IGRF2010 20 | |||
|
|
23 | 6 0 72.80 0.00 -0.30 0.00 IGRF2010 21 | |||
|
|
24 | 6 1 68.60 -20.80 -0.30 -0.10 IGRF2010 22 | |||
|
|
25 | 6 2 76.00 44.20 -0.30 -2.10 IGRF2010 23 | |||
|
|
26 | 6 3 -141.40 61.50 1.90 -0.40 IGRF2010 24 | |||
|
|
27 | 6 4 -22.90 -66.30 -1.60 -0.50 IGRF2010 25 | |||
|
|
28 | 6 5 13.10 3.10 -0.20 0.80 IGRF2010 26 | |||
|
|
29 | 6 6 -77.90 54.90 1.80 0.50 IGRF2010 27 | |||
|
|
30 | 7 0 80.40 0.00 0.20 0.00 IGRF2010 28 | |||
|
|
31 | 7 1 -75.00 -57.80 -0.10 0.60 IGRF2010 29 | |||
|
|
32 | 7 2 -4.70 -21.20 -0.60 0.30 IGRF2010 30 | |||
|
|
33 | 7 3 45.30 6.60 1.40 -0.20 IGRF2010 31 | |||
|
|
34 | 7 4 14.00 24.90 0.30 -0.10 IGRF2010 32 | |||
|
|
35 | 7 5 10.40 7.00 0.10 -0.80 IGRF2010 33 | |||
|
|
36 | 7 6 1.60 -27.70 -0.80 -0.30 IGRF2010 34 | |||
|
|
37 | 7 7 4.90 -3.40 0.40 0.20 IGRF2010 35 | |||
|
|
38 | 8 0 24.30 0.00 -0.10 0.00 IGRF2010 36 | |||
|
|
39 | 8 1 8.20 10.90 0.10 0.00 IGRF2010 37 | |||
|
|
40 | 8 2 -14.50 -20.00 -0.50 0.20 IGRF2010 38 | |||
|
|
41 | 8 3 -5.70 11.90 0.30 0.50 IGRF2010 39 | |||
|
|
42 | 8 4 -19.30 -17.40 -0.30 0.40 IGRF2010 40 | |||
|
|
43 | 8 5 11.60 16.70 0.30 0.10 IGRF2010 41 | |||
|
|
44 | 8 6 10.90 7.10 0.20 -0.10 IGRF2010 42 | |||
|
|
45 | 8 7 -14.10 -10.80 -0.50 0.40 IGRF2010 43 | |||
|
|
46 | 8 8 -3.70 1.70 0.20 0.40 IGRF2010 44 | |||
|
|
47 | 9 0 5.40 0.00 0.00 0.00 IGRF2010 45 | |||
|
|
48 | 9 1 9.40 -20.50 0.00 0.00 IGRF2010 46 | |||
|
|
49 | 9 2 3.40 11.60 0.00 0.00 IGRF2010 47 | |||
|
|
50 | 9 3 -5.30 12.80 0.00 0.00 IGRF2010 48 | |||
|
|
51 | 9 4 3.10 -7.20 0.00 0.00 IGRF2010 49 | |||
|
|
52 | 9 5 -12.40 -7.40 0.00 0.00 IGRF2010 50 | |||
|
|
53 | 9 6 -0.80 8.00 0.00 0.00 IGRF2010 51 | |||
|
|
54 | 9 7 8.40 2.20 0.00 0.00 IGRF2010 52 | |||
|
|
55 | 9 8 -8.40 -6.10 0.00 0.00 IGRF2010 53 | |||
|
|
56 | 9 9 -10.10 7.00 0.00 0.00 IGRF2010 54 | |||
|
|
57 | 10 0 -2.00 0.00 0.00 0.00 IGRF2010 55 | |||
|
|
58 | 10 1 -6.30 2.80 0.00 0.00 IGRF2010 56 | |||
|
|
59 | 10 2 0.90 -0.10 0.00 0.00 IGRF2010 57 | |||
|
|
60 | 10 3 -1.10 4.70 0.00 0.00 IGRF2010 58 | |||
|
|
61 | 10 4 -0.20 4.40 0.00 0.00 IGRF2010 59 | |||
|
|
62 | 10 5 2.50 -7.20 0.00 0.00 IGRF2010 60 | |||
|
|
63 | 10 6 -0.30 -1.00 0.00 0.00 IGRF2010 61 | |||
|
|
64 | 10 7 2.20 -4.00 0.00 0.00 IGRF2010 62 | |||
|
|
65 | 10 8 3.10 -2.00 0.00 0.00 IGRF2010 63 | |||
|
|
66 | 10 9 -1.00 -2.00 0.00 0.00 IGRF2010 64 | |||
|
|
67 | 10 10 -2.80 -8.30 0.00 0.00 IGRF2010 65 | |||
|
|
68 | 11 0 3.00 0.00 0.00 0.00 IGRF2010 66 | |||
|
|
69 | 11 1 -1.50 0.10 0.00 0.00 IGRF2010 67 | |||
|
|
70 | 11 2 -2.10 1.70 0.00 0.00 IGRF2010 68 | |||
|
|
71 | 11 3 1.60 -0.60 0.00 0.00 IGRF2010 69 | |||
|
|
72 | 11 4 -0.50 -1.80 0.00 0.00 IGRF2010 70 | |||
|
|
73 | 11 5 0.50 0.90 0.00 0.00 IGRF2010 71 | |||
|
|
74 | 11 6 -0.80 -0.40 0.00 0.00 IGRF2010 72 | |||
|
|
75 | 11 7 0.40 -2.50 0.00 0.00 IGRF2010 73 | |||
|
|
76 | 11 8 1.80 -1.30 0.00 0.00 IGRF2010 74 | |||
|
|
77 | 11 9 0.20 -2.10 0.00 0.00 IGRF2010 75 | |||
|
|
78 | 11 10 0.80 -1.90 0.00 0.00 IGRF2010 76 | |||
|
|
79 | 11 11 3.80 -1.80 0.00 0.00 IGRF2010 77 | |||
|
|
80 | 12 0 -2.10 0.00 0.00 0.00 IGRF2010 78 | |||
|
|
81 | 12 1 -0.20 -0.80 0.00 0.00 IGRF2010 79 | |||
|
|
82 | 12 2 0.30 0.30 0.00 0.00 IGRF2010 80 | |||
|
|
83 | 12 3 1.00 2.20 0.00 0.00 IGRF2010 81 | |||
|
|
84 | 12 4 -0.70 -2.50 0.00 0.00 IGRF2010 82 | |||
|
|
85 | 12 5 0.90 0.50 0.00 0.00 IGRF2010 83 | |||
|
|
86 | 12 6 -0.10 0.60 0.00 0.00 IGRF2010 84 | |||
|
|
87 | 12 7 0.50 0.00 0.00 0.00 IGRF2010 85 | |||
|
|
88 | 12 8 -0.40 0.10 0.00 0.00 IGRF2010 86 | |||
|
|
89 | 12 9 -0.40 0.30 0.00 0.00 IGRF2010 87 | |||
|
|
90 | 12 10 0.20 -0.90 0.00 0.00 IGRF2010 88 | |||
|
|
91 | 12 11 -0.80 -0.20 0.00 0.00 IGRF2010 89 | |||
|
|
92 | 12 12 0.00 0.80 0.00 0.00 IGRF2010 90 | |||
|
|
93 | 13 0 -0.20 0.00 0.00 0.00 IGRF2010 91 | |||
|
|
94 | 13 1 -0.90 -0.80 0.00 0.00 IGRF2010 92 | |||
|
|
95 | 13 2 0.30 0.30 0.00 0.00 IGRF2010 93 | |||
|
|
96 | 13 3 0.40 1.70 0.00 0.00 IGRF2010 94 | |||
|
|
97 | 13 4 -0.40 -0.60 0.00 0.00 IGRF2010 95 | |||
|
|
98 | 13 5 1.10 -1.20 0.00 0.00 IGRF2010 96 | |||
|
|
99 | 13 6 -0.30 -0.10 0.00 0.00 IGRF2010 97 | |||
|
|
100 | 13 7 0.80 0.50 0.00 0.00 IGRF2010 98 | |||
|
|
101 | 13 8 -0.20 0.10 0.00 0.00 IGRF2010 99 | |||
|
|
102 | 13 9 0.40 0.50 0.00 0.00 IGRF2010 100 | |||
|
|
103 | 13 10 0.00 0.40 0.00 0.00 IGRF2010 101 | |||
|
|
104 | 13 11 0.40 -0.20 0.00 0.00 IGRF2010 102 | |||
|
|
105 | 13 12 -0.30 -0.50 0.00 0.00 IGRF2010 103 | |||
|
|
106 | 13 13 -0.30 -0.80 0.00 0.00 IGRF2010 104 | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | igrf10s | |||
|
|
2 | 13 6371.2 2015.0 | |||
|
|
3 | 1 0 11.40 0.00 IGRF2010 1 | |||
|
|
4 | 1 1 16.70 -28.80 IGRF2010 2 | |||
|
|
5 | 2 0 -11.30 0.00 IGRF2010 3 | |||
|
|
6 | 2 1 -3.90 -23.00 IGRF2010 4 | |||
|
|
7 | 2 2 2.70 -12.90 IGRF2010 5 | |||
|
|
8 | 3 0 1.30 0.00 IGRF2010 6 | |||
|
|
9 | 3 1 -3.90 8.60 IGRF2010 7 | |||
|
|
10 | 3 2 -2.90 -2.90 IGRF2010 8 | |||
|
|
11 | 3 3 -8.10 -2.10 IGRF2010 9 | |||
|
|
12 | 4 0 -1.40 0.00 IGRF2010 10 | |||
|
|
13 | 4 1 2.00 0.40 IGRF2010 11 | |||
|
|
14 | 4 2 -8.90 3.20 IGRF2010 12 | |||
|
|
15 | 4 3 4.40 3.60 IGRF2010 13 | |||
|
|
16 | 4 4 -2.30 -0.80 IGRF2010 14 | |||
|
|
17 | 5 0 -0.50 0.00 IGRF2010 15 | |||
|
|
18 | 5 1 0.50 0.50 IGRF2010 16 | |||
|
|
19 | 5 2 -1.50 1.50 IGRF2010 17 | |||
|
|
20 | 5 3 -0.70 0.90 IGRF2010 18 | |||
|
|
21 | 5 4 1.30 3.70 IGRF2010 19 | |||
|
|
22 | 5 5 1.40 -0.60 IGRF2010 20 | |||
|
|
23 | 6 0 -0.30 0.00 IGRF2010 21 | |||
|
|
24 | 6 1 -0.30 -0.10 IGRF2010 22 | |||
|
|
25 | 6 2 -0.30 -2.10 IGRF2010 23 | |||
|
|
26 | 6 3 1.90 -0.40 IGRF2010 24 | |||
|
|
27 | 6 4 -1.60 -0.50 IGRF2010 25 | |||
|
|
28 | 6 5 -0.20 0.80 IGRF2010 26 | |||
|
|
29 | 6 6 1.80 0.50 IGRF2010 27 | |||
|
|
30 | 7 0 0.20 0.00 IGRF2010 28 | |||
|
|
31 | 7 1 -0.10 0.60 IGRF2010 29 | |||
|
|
32 | 7 2 -0.60 0.30 IGRF2010 30 | |||
|
|
33 | 7 3 1.40 -0.20 IGRF2010 31 | |||
|
|
34 | 7 4 0.30 -0.10 IGRF2010 32 | |||
|
|
35 | 7 5 0.10 -0.80 IGRF2010 33 | |||
|
|
36 | 7 6 -0.80 -0.30 IGRF2010 34 | |||
|
|
37 | 7 7 0.40 0.20 IGRF2010 35 | |||
|
|
38 | 8 0 -0.10 0.00 IGRF2010 36 | |||
|
|
39 | 8 1 0.10 0.00 IGRF2010 37 | |||
|
|
40 | 8 2 -0.50 0.20 IGRF2010 38 | |||
|
|
41 | 8 3 0.30 0.50 IGRF2010 39 | |||
|
|
42 | 8 4 -0.30 0.40 IGRF2010 40 | |||
|
|
43 | 8 5 0.30 0.10 IGRF2010 41 | |||
|
|
44 | 8 6 0.20 -0.10 IGRF2010 42 | |||
|
|
45 | 8 7 -0.50 0.40 IGRF2010 43 | |||
|
|
46 | 8 8 0.20 0.40 IGRF2010 44 | |||
|
|
47 | 9 0 0.00 0.00 IGRF2010 45 | |||
|
|
48 | 9 1 0.00 0.00 IGRF2010 46 | |||
|
|
49 | 9 2 0.00 0.00 IGRF2010 47 | |||
|
|
50 | 9 3 0.00 0.00 IGRF2010 48 | |||
|
|
51 | 9 4 0.00 0.00 IGRF2010 49 | |||
|
|
52 | 9 5 0.00 0.00 IGRF2010 50 | |||
|
|
53 | 9 6 0.00 0.00 IGRF2010 51 | |||
|
|
54 | 9 7 0.00 0.00 IGRF2010 52 | |||
|
|
55 | 9 8 0.00 0.00 IGRF2010 53 | |||
|
|
56 | 9 9 0.00 0.00 IGRF2010 54 | |||
|
|
57 | 10 0 0.00 0.00 IGRF2010 55 | |||
|
|
58 | 10 1 0.00 0.00 IGRF2010 56 | |||
|
|
59 | 10 2 0.00 0.00 IGRF2010 57 | |||
|
|
60 | 10 3 0.00 0.00 IGRF2010 58 | |||
|
|
61 | 10 4 0.00 0.00 IGRF2010 59 | |||
|
|
62 | 10 5 0.00 0.00 IGRF2010 60 | |||
|
|
63 | 10 6 0.00 0.00 IGRF2010 61 | |||
|
|
64 | 10 7 0.00 0.00 IGRF2010 62 | |||
|
|
65 | 10 8 0.00 0.00 IGRF2010 63 | |||
|
|
66 | 10 9 0.00 0.00 IGRF2010 64 | |||
|
|
67 | 10 10 0.00 0.00 IGRF2010 65 | |||
|
|
68 | 11 0 0.00 0.00 IGRF2010 66 | |||
|
|
69 | 11 1 0.00 0.00 IGRF2010 67 | |||
|
|
70 | 11 2 0.00 0.00 IGRF2010 68 | |||
|
|
71 | 11 3 0.00 0.00 IGRF2010 69 | |||
|
|
72 | 11 4 0.00 0.00 IGRF2010 70 | |||
|
|
73 | 11 5 0.00 0.00 IGRF2010 71 | |||
|
|
74 | 11 6 0.00 0.00 IGRF2010 72 | |||
|
|
75 | 11 7 0.00 0.00 IGRF2010 73 | |||
|
|
76 | 11 8 0.00 0.00 IGRF2010 74 | |||
|
|
77 | 11 9 0.00 0.00 IGRF2010 75 | |||
|
|
78 | 11 10 0.00 0.00 IGRF2010 76 | |||
|
|
79 | 11 11 0.00 0.00 IGRF2010 77 | |||
|
|
80 | 12 0 0.00 0.00 IGRF2010 78 | |||
|
|
81 | 12 1 0.00 0.00 IGRF2010 79 | |||
|
|
82 | 12 2 0.00 0.00 IGRF2010 80 | |||
|
|
83 | 12 3 0.00 0.00 IGRF2010 81 | |||
|
|
84 | 12 4 0.00 0.00 IGRF2010 82 | |||
|
|
85 | 12 5 0.00 0.00 IGRF2010 83 | |||
|
|
86 | 12 6 0.00 0.00 IGRF2010 84 | |||
|
|
87 | 12 7 0.00 0.00 IGRF2010 85 | |||
|
|
88 | 12 8 0.00 0.00 IGRF2010 86 | |||
|
|
89 | 12 9 0.00 0.00 IGRF2010 87 | |||
|
|
90 | 12 10 0.00 0.00 IGRF2010 88 | |||
|
|
91 | 12 11 0.00 0.00 IGRF2010 89 | |||
|
|
92 | 12 12 0.00 0.00 IGRF2010 90 | |||
|
|
93 | 13 0 0.00 0.00 IGRF2010 91 | |||
|
|
94 | 13 1 0.00 0.00 IGRF2010 92 | |||
|
|
95 | 13 2 0.00 0.00 IGRF2010 93 | |||
|
|
96 | 13 3 0.00 0.00 IGRF2010 94 | |||
|
|
97 | 13 4 0.00 0.00 IGRF2010 95 | |||
|
|
98 | 13 5 0.00 0.00 IGRF2010 96 | |||
|
|
99 | 13 6 0.00 0.00 IGRF2010 97 | |||
|
|
100 | 13 7 0.00 0.00 IGRF2010 98 | |||
|
|
101 | 13 8 0.00 0.00 IGRF2010 99 | |||
|
|
102 | 13 9 0.00 0.00 IGRF2010 100 | |||
|
|
103 | 13 10 0.00 0.00 IGRF2010 101 | |||
|
|
104 | 13 11 0.00 0.00 IGRF2010 102 | |||
|
|
105 | 13 12 0.00 0.00 IGRF2010 103 | |||
|
|
106 | 13 13 0.00 0.00 IGRF2010 104 | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | igrf15 | |||
|
|
2 | 13 6371.2 2015.0 | |||
|
|
3 | 1 0 -29442.00 0.00 | |||
|
|
4 | 1 1 -1501.00 4797.10 | |||
|
|
5 | 2 0 -2445.10 0.00 | |||
|
|
6 | 2 1 3012.90 -2845.60 | |||
|
|
7 | 2 2 1676.70 -641.90 | |||
|
|
8 | 3 0 1350.70 0.00 | |||
|
|
9 | 3 1 -2352.30 -115.30 | |||
|
|
10 | 3 2 1225.60 244.90 | |||
|
|
11 | 3 3 582.00 -538.40 | |||
|
|
12 | 4 0 907.60 0.00 | |||
|
|
13 | 4 1 813.70 283.30 | |||
|
|
14 | 4 2 120.40 -188.70 | |||
|
|
15 | 4 3 -334.90 180.90 | |||
|
|
16 | 4 4 70.40 -329.50 | |||
|
|
17 | 5 0 -232.60 0.00 | |||
|
|
18 | 5 1 360.10 47.30 | |||
|
|
19 | 5 2 192.40 197.00 | |||
|
|
20 | 5 3 -140.90 -119.30 | |||
|
|
21 | 5 4 -157.50 16.00 | |||
|
|
22 | 5 5 4.10 100.20 | |||
|
|
23 | 6 0 70.00 0.00 | |||
|
|
24 | 6 1 67.70 -20.80 | |||
|
|
25 | 6 2 72.70 33.20 | |||
|
|
26 | 6 3 -129.90 58.90 | |||
|
|
27 | 6 4 -28.90 -66.70 | |||
|
|
28 | 6 5 13.20 7.30 | |||
|
|
29 | 6 6 -70.90 62.60 | |||
|
|
30 | 7 0 81.60 0.00 | |||
|
|
31 | 7 1 -76.10 -54.10 | |||
|
|
32 | 7 2 -6.80 -19.50 | |||
|
|
33 | 7 3 51.80 5.70 | |||
|
|
34 | 7 4 15.00 24.40 | |||
|
|
35 | 7 5 9.40 3.40 | |||
|
|
36 | 7 6 -2.80 -27.40 | |||
|
|
37 | 7 7 6.80 -2.20 | |||
|
|
38 | 8 0 24.20 0.00 | |||
|
|
39 | 8 1 8.80 10.10 | |||
|
|
40 | 8 2 -16.90 -18.30 | |||
|
|
41 | 8 3 -3.20 13.30 | |||
|
|
42 | 8 4 -20.60 -14.60 | |||
|
|
43 | 8 5 13.40 16.20 | |||
|
|
44 | 8 6 11.70 5.70 | |||
|
|
45 | 8 7 -15.90 -9.10 | |||
|
|
46 | 8 8 -2.00 2.10 | |||
|
|
47 | 9 0 5.40 0.00 | |||
|
|
48 | 9 1 8.80 -21.60 | |||
|
|
49 | 9 2 3.10 10.80 | |||
|
|
50 | 9 3 -3.30 11.80 | |||
|
|
51 | 9 4 0.70 -6.80 | |||
|
|
52 | 9 5 -13.30 -6.90 | |||
|
|
53 | 9 6 -0.10 7.80 | |||
|
|
54 | 9 7 8.70 1.00 | |||
|
|
55 | 9 8 -9.10 -4.00 | |||
|
|
56 | 9 9 -10.50 8.40 | |||
|
|
57 | 10 0 -1.90 0.00 | |||
|
|
58 | 10 1 -6.30 3.20 | |||
|
|
59 | 10 2 0.10 -0.40 | |||
|
|
60 | 10 3 0.50 4.60 | |||
|
|
61 | 10 4 -0.50 4.40 | |||
|
|
62 | 10 5 1.80 -7.90 | |||
|
|
63 | 10 6 -0.70 -0.60 | |||
|
|
64 | 10 7 2.10 -4.20 | |||
|
|
65 | 10 8 2.40 -2.80 | |||
|
|
66 | 10 9 -1.80 -1.20 | |||
|
|
67 | 10 10 -3.60 -8.70 | |||
|
|
68 | 11 0 3.10 0.00 | |||
|
|
69 | 11 1 -1.50 -0.10 | |||
|
|
70 | 11 2 -2.30 2.00 | |||
|
|
71 | 11 3 2.00 -0.70 | |||
|
|
72 | 11 4 -0.80 -1.10 | |||
|
|
73 | 11 5 0.60 0.80 | |||
|
|
74 | 11 6 -0.70 -0.20 | |||
|
|
75 | 11 7 0.20 -2.20 | |||
|
|
76 | 11 8 1.70 -1.40 | |||
|
|
77 | 11 9 -0.20 -2.50 | |||
|
|
78 | 11 10 0.40 -2.00 | |||
|
|
79 | 11 11 3.50 -2.40 | |||
|
|
80 | 12 0 -1.90 0.00 | |||
|
|
81 | 12 1 -0.20 -1.10 | |||
|
|
82 | 12 2 0.40 0.40 | |||
|
|
83 | 12 3 1.20 1.90 | |||
|
|
84 | 12 4 -0.80 -2.20 | |||
|
|
85 | 12 5 0.90 0.30 | |||
|
|
86 | 12 6 0.10 0.70 | |||
|
|
87 | 12 7 0.50 -0.10 | |||
|
|
88 | 12 8 -0.30 0.30 | |||
|
|
89 | 12 9 -0.40 0.20 | |||
|
|
90 | 12 10 0.20 -0.90 | |||
|
|
91 | 12 11 -0.90 -0.10 | |||
|
|
92 | 12 12 0.00 0.70 | |||
|
|
93 | 13 0 0.00 0.00 | |||
|
|
94 | 13 1 -0.90 -0.90 | |||
|
|
95 | 13 2 0.40 0.40 | |||
|
|
96 | 13 3 0.50 1.60 | |||
|
|
97 | 13 4 -0.50 -0.50 | |||
|
|
98 | 13 5 1.00 -1.20 | |||
|
|
99 | 13 6 -0.20 -0.10 | |||
|
|
100 | 13 7 0.80 0.40 | |||
|
|
101 | 13 8 -0.10 -0.10 | |||
|
|
102 | 13 9 0.30 0.40 | |||
|
|
103 | 13 10 0.10 0.50 | |||
|
|
104 | 13 11 0.50 -0.30 | |||
|
|
105 | 13 12 -0.40 -0.40 | |||
|
|
106 | 13 13 -0.30 -0.80 | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | igrf15s | |||
|
|
2 | 13 6371.2 2020.0 | |||
|
|
3 | 1 0 10.30 0.00 | |||
|
|
4 | 1 1 18.10 -26.60 | |||
|
|
5 | 2 0 -8.70 0.00 | |||
|
|
6 | 2 1 -3.30 -27.40 | |||
|
|
7 | 2 2 2.10 -14.10 | |||
|
|
8 | 3 0 3.40 0.00 | |||
|
|
9 | 3 1 -5.50 8.20 | |||
|
|
10 | 3 2 -0.70 -0.40 | |||
|
|
11 | 3 3 -10.10 1.80 | |||
|
|
12 | 4 0 -0.70 0.00 | |||
|
|
13 | 4 1 0.20 -1.30 | |||
|
|
14 | 4 2 -9.10 5.30 | |||
|
|
15 | 4 3 4.10 2.90 | |||
|
|
16 | 4 4 -4.30 -5.20 | |||
|
|
17 | 5 0 -0.20 0.00 | |||
|
|
18 | 5 1 0.50 0.60 | |||
|
|
19 | 5 2 -1.30 1.70 | |||
|
|
20 | 5 3 -0.10 -1.20 | |||
|
|
21 | 5 4 1.40 3.40 | |||
|
|
22 | 5 5 3.90 0.00 | |||
|
|
23 | 6 0 -0.30 0.00 | |||
|
|
24 | 6 1 -0.10 0.00 | |||
|
|
25 | 6 2 -0.70 -2.10 | |||
|
|
26 | 6 3 2.10 -0.70 | |||
|
|
27 | 6 4 -1.20 0.20 | |||
|
|
28 | 6 5 0.30 0.90 | |||
|
|
29 | 6 6 1.60 1.00 | |||
|
|
30 | 7 0 0.30 0.00 | |||
|
|
31 | 7 1 -0.20 0.80 | |||
|
|
32 | 7 2 -0.50 0.40 | |||
|
|
33 | 7 3 1.30 -0.20 | |||
|
|
34 | 7 4 0.10 -0.30 | |||
|
|
35 | 7 5 -0.60 -0.60 | |||
|
|
36 | 7 6 -0.80 0.10 | |||
|
|
37 | 7 7 0.20 -0.20 | |||
|
|
38 | 8 0 0.20 0.00 | |||
|
|
39 | 8 1 0.00 -0.30 | |||
|
|
40 | 8 2 -0.60 0.30 | |||
|
|
41 | 8 3 0.50 0.10 | |||
|
|
42 | 8 4 -0.20 0.50 | |||
|
|
43 | 8 5 0.40 -0.20 | |||
|
|
44 | 8 6 0.10 -0.30 | |||
|
|
45 | 8 7 -0.40 0.30 | |||
|
|
46 | 8 8 0.30 0.00 | |||
|
|
47 | 9 0 0.00 0.00 | |||
|
|
48 | 9 1 0.00 0.00 | |||
|
|
49 | 9 2 0.00 0.00 | |||
|
|
50 | 9 3 0.00 0.00 | |||
|
|
51 | 9 4 0.00 0.00 | |||
|
|
52 | 9 5 0.00 0.00 | |||
|
|
53 | 9 6 0.00 0.00 | |||
|
|
54 | 9 7 0.00 0.00 | |||
|
|
55 | 9 8 0.00 0.00 | |||
|
|
56 | 9 9 0.00 0.00 | |||
|
|
57 | 10 0 0.00 0.00 | |||
|
|
58 | 10 1 0.00 0.00 | |||
|
|
59 | 10 2 0.00 0.00 | |||
|
|
60 | 10 3 0.00 0.00 | |||
|
|
61 | 10 4 0.00 0.00 | |||
|
|
62 | 10 5 0.00 0.00 | |||
|
|
63 | 10 6 0.00 0.00 | |||
|
|
64 | 10 7 0.00 0.00 | |||
|
|
65 | 10 8 0.00 0.00 | |||
|
|
66 | 10 9 0.00 0.00 | |||
|
|
67 | 10 10 0.00 0.00 | |||
|
|
68 | 11 0 0.00 0.00 | |||
|
|
69 | 11 1 0.00 0.00 | |||
|
|
70 | 11 2 0.00 0.00 | |||
|
|
71 | 11 3 0.00 0.00 | |||
|
|
72 | 11 4 0.00 0.00 | |||
|
|
73 | 11 5 0.00 0.00 | |||
|
|
74 | 11 6 0.00 0.00 | |||
|
|
75 | 11 7 0.00 0.00 | |||
|
|
76 | 11 8 0.00 0.00 | |||
|
|
77 | 11 9 0.00 0.00 | |||
|
|
78 | 11 10 0.00 0.00 | |||
|
|
79 | 11 11 0.00 0.00 | |||
|
|
80 | 12 0 0.00 0.00 | |||
|
|
81 | 12 1 0.00 0.00 | |||
|
|
82 | 12 2 0.00 0.00 | |||
|
|
83 | 12 3 0.00 0.00 | |||
|
|
84 | 12 4 0.00 0.00 | |||
|
|
85 | 12 5 0.00 0.00 | |||
|
|
86 | 12 6 0.00 0.00 | |||
|
|
87 | 12 7 0.00 0.00 | |||
|
|
88 | 12 8 0.00 0.00 | |||
|
|
89 | 12 9 0.00 0.00 | |||
|
|
90 | 12 10 0.00 0.00 | |||
|
|
91 | 12 11 0.00 0.00 | |||
|
|
92 | 12 12 0.00 0.00 | |||
|
|
93 | 13 0 0.00 0.00 | |||
|
|
94 | 13 1 0.00 0.00 | |||
|
|
95 | 13 2 0.00 0.00 | |||
|
|
96 | 13 3 0.00 0.00 | |||
|
|
97 | 13 4 0.00 0.00 | |||
|
|
98 | 13 5 0.00 0.00 | |||
|
|
99 | 13 6 0.00 0.00 | |||
|
|
100 | 13 7 0.00 0.00 | |||
|
|
101 | 13 8 0.00 0.00 | |||
|
|
102 | 13 9 0.00 0.00 | |||
|
|
103 | 13 10 0.00 0.00 | |||
|
|
104 | 13 11 0.00 0.00 | |||
|
|
105 | 13 12 0.00 0.00 | |||
|
|
106 | 13 13 0.00 0.00 | |||
| @@ -0,0 +1,106 | |||||
|
|
1 | igrf2020 | |||
|
|
2 | 13 6371.20 2020.0 | |||
|
|
3 | 1 0 -29404.8 0 | |||
|
|
4 | 1 1 -1450.9 4652.5 | |||
|
|
5 | 2 0 -2499.6 0 | |||
|
|
6 | 2 1 2982 -2991.6 | |||
|
|
7 | 2 2 1677 -734.6 | |||
|
|
8 | 3 0 1363.2 0 | |||
|
|
9 | 3 1 -2381.2 -82.1 | |||
|
|
10 | 3 2 1236.2 241.9 | |||
|
|
11 | 3 3 525.7 -543.4 | |||
|
|
12 | 4 0 903 0 | |||
|
|
13 | 4 1 809.5 281.9 | |||
|
|
14 | 4 2 86.3 -158.4 | |||
|
|
15 | 4 3 -309.4 199.7 | |||
|
|
16 | 4 4 48 -349.7 | |||
|
|
17 | 5 0 -234.3 0 | |||
|
|
18 | 5 1 363.2 47.7 | |||
|
|
19 | 5 2 187.8 208.3 | |||
|
|
20 | 5 3 -140.7 -121.2 | |||
|
|
21 | 5 4 -151.2 32.3 | |||
|
|
22 | 5 5 13.5 98.9 | |||
|
|
23 | 6 0 66 0 | |||
|
|
24 | 6 1 65.5 -19.1 | |||
|
|
25 | 6 2 72.9 25.1 | |||
|
|
26 | 6 3 -121.5 52.8 | |||
|
|
27 | 6 4 -36.2 -64.5 | |||
|
|
28 | 6 5 13.5 8.9 | |||
|
|
29 | 6 6 -64.7 68.1 | |||
|
|
30 | 7 0 80.6 0 | |||
|
|
31 | 7 1 -76.7 -51.5 | |||
|
|
32 | 7 2 -8.2 -16.9 | |||
|
|
33 | 7 3 56.5 2.2 | |||
|
|
34 | 7 4 15.8 23.5 | |||
|
|
35 | 7 5 6.4 -2.2 | |||
|
|
36 | 7 6 -7.2 -27.2 | |||
|
|
37 | 7 7 9.8 -1.8 | |||
|
|
38 | 8 0 23.7 0 | |||
|
|
39 | 8 1 9.7 8.4 | |||
|
|
40 | 8 2 -17.6 -15.3 | |||
|
|
41 | 8 3 -0.5 12.8 | |||
|
|
42 | 8 4 -21.1 -11.7 | |||
|
|
43 | 8 5 15.3 14.9 | |||
|
|
44 | 8 6 13.7 3.6 | |||
|
|
45 | 8 7 -16.5 -6.9 | |||
|
|
46 | 8 8 -0.3 2.8 | |||
|
|
47 | 9 0 5 0 | |||
|
|
48 | 9 1 8.4 -23.4 | |||
|
|
49 | 9 2 2.9 11 | |||
|
|
50 | 9 3 -1.5 9.8 | |||
|
|
51 | 9 4 -1.1 -5.1 | |||
|
|
52 | 9 5 -13.2 -6.3 | |||
|
|
53 | 9 6 1.1 7.8 | |||
|
|
54 | 9 7 8.8 0.4 | |||
|
|
55 | 9 8 -9.3 -1.4 | |||
|
|
56 | 9 9 -11.9 9.6 | |||
|
|
57 | 10 0 -1.9 0 | |||
|
|
58 | 10 1 -6.2 3.4 | |||
|
|
59 | 10 2 -0.1 -0.2 | |||
|
|
60 | 10 3 1.7 3.6 | |||
|
|
61 | 10 4 -0.9 4.8 | |||
|
|
62 | 10 5 0.7 -8.6 | |||
|
|
63 | 10 6 -0.9 -0.1 | |||
|
|
64 | 10 7 1.9 -4.3 | |||
|
|
65 | 10 8 1.4 -3.4 | |||
|
|
66 | 10 9 -2.4 -0.1 | |||
|
|
67 | 10 10 -3.8 -8.8 | |||
|
|
68 | 11 0 3 0 | |||
|
|
69 | 11 1 -1.4 0 | |||
|
|
70 | 11 2 -2.5 2.5 | |||
|
|
71 | 11 3 2.3 -0.6 | |||
|
|
72 | 11 4 -0.9 -0.4 | |||
|
|
73 | 11 5 0.3 0.6 | |||
|
|
74 | 11 6 -0.7 -0.2 | |||
|
|
75 | 11 7 -0.1 -1.7 | |||
|
|
76 | 11 8 1.4 -1.6 | |||
|
|
77 | 11 9 -0.6 -3 | |||
|
|
78 | 11 10 0.2 -2 | |||
|
|
79 | 11 11 3.1 -2.6 | |||
|
|
80 | 12 0 -2 0 | |||
|
|
81 | 12 1 -0.1 -1.2 | |||
|
|
82 | 12 2 0.5 0.5 | |||
|
|
83 | 12 3 1.3 1.4 | |||
|
|
84 | 12 4 -1.2 -1.8 | |||
|
|
85 | 12 5 0.7 0.1 | |||
|
|
86 | 12 6 0.3 0.8 | |||
|
|
87 | 12 7 0.5 -0.2 | |||
|
|
88 | 12 8 -0.3 0.6 | |||
|
|
89 | 12 9 -0.5 0.2 | |||
|
|
90 | 12 10 0.1 -0.9 | |||
|
|
91 | 12 11 -1.1 0 | |||
|
|
92 | 12 12 -0.3 0.5 | |||
|
|
93 | 13 0 0.1 0 | |||
|
|
94 | 13 1 -0.9 -0.9 | |||
|
|
95 | 13 2 0.5 0.6 | |||
|
|
96 | 13 3 0.7 1.4 | |||
|
|
97 | 13 4 -0.3 -0.4 | |||
|
|
98 | 13 5 0.8 -1.3 | |||
|
|
99 | 13 6 0 -0.1 | |||
|
|
100 | 13 7 0.8 0.3 | |||
|
|
101 | 13 8 0 -0.1 | |||
|
|
102 | 13 9 0.4 0.5 | |||
|
|
103 | 13 10 0.1 0.5 | |||
|
|
104 | 13 11 0.5 -0.4 | |||
|
|
105 | 13 12 -0.5 -0.4 | |||
|
|
106 | 13 13 -0.4 -0.6 | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf00 | |||
|
|
2 | 10 6371.2 2000.0 | |||
|
|
3 | 1 0 -29615. 0.0 | |||
|
|
4 | 1 1 -1728. 5186. | |||
|
|
5 | 2 0 -2267. 0.0 | |||
|
|
6 | 2 1 3072. -2478. | |||
|
|
7 | 2 2 1672. -458. | |||
|
|
8 | 3 0 1341. 0.0 | |||
|
|
9 | 3 1 -2290. -227. | |||
|
|
10 | 3 2 1253. 296. | |||
|
|
11 | 3 3 715. -492. | |||
|
|
12 | 4 0 935. .0 | |||
|
|
13 | 4 1 787. 272. | |||
|
|
14 | 4 2 251. -232. | |||
|
|
15 | 4 3 -405. 119. | |||
|
|
16 | 4 4 110. -304. | |||
|
|
17 | 5 0 -217. .0 | |||
|
|
18 | 5 1 351. 44. | |||
|
|
19 | 5 2 222. 172. | |||
|
|
20 | 5 3 -131. -134. | |||
|
|
21 | 5 4 -169. -40. | |||
|
|
22 | 5 5 -12. 107. | |||
|
|
23 | 6 0 72. .0 | |||
|
|
24 | 6 1 68. -17. | |||
|
|
25 | 6 2 74. 64. | |||
|
|
26 | 6 3 -161. 65. | |||
|
|
27 | 6 4 -5. -61. | |||
|
|
28 | 6 5 17. 1. | |||
|
|
29 | 6 6 -91. 44. | |||
|
|
30 | 7 0 79. .0 | |||
|
|
31 | 7 1 -74. -65. | |||
|
|
32 | 7 2 0. -24. | |||
|
|
33 | 7 3 33. 6. | |||
|
|
34 | 7 4 9. 24. | |||
|
|
35 | 7 5 7. 15. | |||
|
|
36 | 7 6 8. -25. | |||
|
|
37 | 7 7 -2. -6. | |||
|
|
38 | 8 0 25. .0 | |||
|
|
39 | 8 1 6. 12. | |||
|
|
40 | 8 2 -9. -22. | |||
|
|
41 | 8 3 -8. 8. | |||
|
|
42 | 8 4 -17. -21. | |||
|
|
43 | 8 5 9. 15. | |||
|
|
44 | 8 6 7. 9. | |||
|
|
45 | 8 7 -8. -16. | |||
|
|
46 | 8 8 -7. -3. | |||
|
|
47 | 9 0 5. .0 | |||
|
|
48 | 9 1 9. -20. | |||
|
|
49 | 9 2 3. 13. | |||
|
|
50 | 9 3 -8. 12. | |||
|
|
51 | 9 4 6. -6. | |||
|
|
52 | 9 5 -9. -8. | |||
|
|
53 | 9 6 -2. 9. | |||
|
|
54 | 9 7 9. 4. | |||
|
|
55 | 9 8 -4. -8. | |||
|
|
56 | 9 9 -8. 5. | |||
|
|
57 | 10 0 -2. .0 | |||
|
|
58 | 10 1 -6. 1. | |||
|
|
59 | 10 2 2. 0. | |||
|
|
60 | 10 3 -3. 4. | |||
|
|
61 | 10 4 0. 5. | |||
|
|
62 | 10 5 4. -6. | |||
|
|
63 | 10 6 1. -1. | |||
|
|
64 | 10 7 2. -3. | |||
|
|
65 | 10 8 4. 0. | |||
|
|
66 | 10 9 0. -2. | |||
|
|
67 | 10 10 -1. -8. | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf2000 | |||
|
|
2 | 10 6371.2 2000.0 | |||
|
|
3 | 1 0 -29615. 0. | |||
|
|
4 | 1 1 -1728. 5186. | |||
|
|
5 | 2 0 -2267. 0. | |||
|
|
6 | 2 1 3072. -2478. | |||
|
|
7 | 2 2 1672. -458. | |||
|
|
8 | 3 0 1341. 0. | |||
|
|
9 | 3 1 -2290. -227. | |||
|
|
10 | 3 2 1253. 296. | |||
|
|
11 | 3 3 715. -492. | |||
|
|
12 | 4 0 935. 0. | |||
|
|
13 | 4 1 787. 272. | |||
|
|
14 | 4 2 251. -232. | |||
|
|
15 | 4 3 -405. 119. | |||
|
|
16 | 4 4 110. -304. | |||
|
|
17 | 5 0 -217. 0. | |||
|
|
18 | 5 1 351. 44. | |||
|
|
19 | 5 2 222. 172. | |||
|
|
20 | 5 3 -131. -134. | |||
|
|
21 | 5 4 -169. -40. | |||
|
|
22 | 5 5 -12. 107. | |||
|
|
23 | 6 0 72. 0. | |||
|
|
24 | 6 1 68. -17. | |||
|
|
25 | 6 2 74. 64. | |||
|
|
26 | 6 3 -161. 65. | |||
|
|
27 | 6 4 -5. -61. | |||
|
|
28 | 6 5 17. 1. | |||
|
|
29 | 6 6 -91. 44. | |||
|
|
30 | 7 0 79. 0. | |||
|
|
31 | 7 1 -74. -65. | |||
|
|
32 | 7 2 0. -24. | |||
|
|
33 | 7 3 33. 6. | |||
|
|
34 | 7 4 9. 24. | |||
|
|
35 | 7 5 7. 15. | |||
|
|
36 | 7 6 8. -25. | |||
|
|
37 | 7 7 -2. -6. | |||
|
|
38 | 8 0 25. 0. | |||
|
|
39 | 8 1 6. 12. | |||
|
|
40 | 8 2 -9. -22. | |||
|
|
41 | 8 3 -8. 8. | |||
|
|
42 | 8 4 -17. -21. | |||
|
|
43 | 8 5 9. 15. | |||
|
|
44 | 8 6 7. 9. | |||
|
|
45 | 8 7 -8. -16. | |||
|
|
46 | 8 8 -7. -3. | |||
|
|
47 | 9 0 5. 0. | |||
|
|
48 | 9 1 9. -20. | |||
|
|
49 | 9 2 3. 13. | |||
|
|
50 | 9 3 -8. 12. | |||
|
|
51 | 9 4 6. -6. | |||
|
|
52 | 9 5 -9. -8. | |||
|
|
53 | 9 6 -2. 9. | |||
|
|
54 | 9 7 9. 4. | |||
|
|
55 | 9 8 -4. -8. | |||
|
|
56 | 9 9 -8. 5. | |||
|
|
57 | 10 0 -2. 0. | |||
|
|
58 | 10 1 -6. 1. | |||
|
|
59 | 10 2 2. 0. | |||
|
|
60 | 10 3 -3. 4. | |||
|
|
61 | 10 4 0. 5. | |||
|
|
62 | 10 5 4. -6. | |||
|
|
63 | 10 6 1. -1. | |||
|
|
64 | 10 7 2. -3. | |||
|
|
65 | 10 8 4. 0. | |||
|
|
66 | 10 9 0. -2. | |||
|
|
67 | 10 10 -1. -8. | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf00 | |||
|
|
2 | 10 6371.2 2000.0 | |||
|
|
3 | 1 0 -29615. 0. | |||
|
|
4 | 1 1 -1728. 5186. | |||
|
|
5 | 2 0 -2267. 0. | |||
|
|
6 | 2 1 3072. -2478. | |||
|
|
7 | 2 2 1672. -458. | |||
|
|
8 | 3 0 1341. 0. | |||
|
|
9 | 3 1 -2290. -227. | |||
|
|
10 | 3 2 1253. 296. | |||
|
|
11 | 3 3 715. -492. | |||
|
|
12 | 4 0 935. 0. | |||
|
|
13 | 4 1 787. 272. | |||
|
|
14 | 4 2 251. -232. | |||
|
|
15 | 4 3 -405. 119. | |||
|
|
16 | 4 4 110. -304. | |||
|
|
17 | 5 0 -217. 0. | |||
|
|
18 | 5 1 351. 44. | |||
|
|
19 | 5 2 222. 172. | |||
|
|
20 | 5 3 -131. -134. | |||
|
|
21 | 5 4 -169. -40. | |||
|
|
22 | 5 5 -12. 107. | |||
|
|
23 | 6 0 72. 0. | |||
|
|
24 | 6 1 68. -17. | |||
|
|
25 | 6 2 74. 64. | |||
|
|
26 | 6 3 -161. 65. | |||
|
|
27 | 6 4 -5. -61. | |||
|
|
28 | 6 5 17. 1. | |||
|
|
29 | 6 6 -91. 44. | |||
|
|
30 | 7 0 79. 0. | |||
|
|
31 | 7 1 -74. -65. | |||
|
|
32 | 7 2 0. -24. | |||
|
|
33 | 7 3 33. 6. | |||
|
|
34 | 7 4 9. 24. | |||
|
|
35 | 7 5 7. 15. | |||
|
|
36 | 7 6 8. -25. | |||
|
|
37 | 7 7 -2. -6. | |||
|
|
38 | 8 0 25. 0. | |||
|
|
39 | 8 1 6. 12. | |||
|
|
40 | 8 2 -9. -22. | |||
|
|
41 | 8 3 -8. 8. | |||
|
|
42 | 8 4 -17. -21. | |||
|
|
43 | 8 5 9. 15. | |||
|
|
44 | 8 6 7. 9. | |||
|
|
45 | 8 7 -8. -16. | |||
|
|
46 | 8 8 -7. -3. | |||
|
|
47 | 9 0 5. 0. | |||
|
|
48 | 9 1 9. -20. | |||
|
|
49 | 9 2 3. 13. | |||
|
|
50 | 9 3 -8. 12. | |||
|
|
51 | 9 4 6. -6. | |||
|
|
52 | 9 5 -9. -8. | |||
|
|
53 | 9 6 -2. 9. | |||
|
|
54 | 9 7 9. 4. | |||
|
|
55 | 9 8 -4. -8. | |||
|
|
56 | 9 9 -8. 5. | |||
|
|
57 | 10 0 -2. 0. | |||
|
|
58 | 10 1 -6. 1. | |||
|
|
59 | 10 2 2. 0. | |||
|
|
60 | 10 3 -3. 4. | |||
|
|
61 | 10 4 0. 5. | |||
|
|
62 | 10 5 4. -6. | |||
|
|
63 | 10 6 1. -1. | |||
|
|
64 | 10 7 2. -3. | |||
|
|
65 | 10 8 4. 0. | |||
|
|
66 | 10 9 0. -2. | |||
|
|
67 | 10 10 -1. -8. | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf00s | |||
|
|
2 | 8 6371.2 2005.0 | |||
|
|
3 | 1 0 14.6 0. | |||
|
|
4 | 1 1 10.7 -22.5 | |||
|
|
5 | 2 0 -12.4 0. | |||
|
|
6 | 2 1 1.1 -20.6 | |||
|
|
7 | 2 2 -1.1 -9.6 | |||
|
|
8 | 3 0 0.7 0. | |||
|
|
9 | 3 1 -5.4 6.0 | |||
|
|
10 | 3 2 0.9 -0.1 | |||
|
|
11 | 3 3 -7.7 -14.2 | |||
|
|
12 | 4 0 -1.3 0. | |||
|
|
13 | 4 1 1.6 2.1 | |||
|
|
14 | 4 2 -7.3 1.3 | |||
|
|
15 | 4 3 2.9 5.0 | |||
|
|
16 | 4 4 -3.2 0.3 | |||
|
|
17 | 5 0 0.0 0. | |||
|
|
18 | 5 1 -0.7 -0.1 | |||
|
|
19 | 5 2 -2.1 0.6 | |||
|
|
20 | 5 3 -2.8 1.7 | |||
|
|
21 | 5 4 -0.8 1.9 | |||
|
|
22 | 5 5 2.5 0.1 | |||
|
|
23 | 6 0 1.0 0. | |||
|
|
24 | 6 1 -0.4 -0.2 | |||
|
|
25 | 6 2 0.9 -1.4 | |||
|
|
26 | 6 3 2.0 0.0 | |||
|
|
27 | 6 4 -0.6 -0.8 | |||
|
|
28 | 6 5 -0.3 0.0 | |||
|
|
29 | 6 6 1.2 0.9 | |||
|
|
30 | 7 0 -0.4 0. | |||
|
|
31 | 7 1 -0.4 1.1 | |||
|
|
32 | 7 2 -0.3 0.0 | |||
|
|
33 | 7 3 1.1 0.3 | |||
|
|
34 | 7 4 1.1 -0.1 | |||
|
|
35 | 7 5 -0.2 -0.6 | |||
|
|
36 | 7 6 0.6 -0.7 | |||
|
|
37 | 7 7 -0.9 0.2 | |||
|
|
38 | 8 0 -0.3 0. | |||
|
|
39 | 8 1 0.2 0.1 | |||
|
|
40 | 8 2 -0.3 0.0 | |||
|
|
41 | 8 3 0.4 0.0 | |||
|
|
42 | 8 4 -1.0 0.3 | |||
|
|
43 | 8 5 0.3 0.6 | |||
|
|
44 | 8 6 -0.5 -0.4 | |||
|
|
45 | 8 7 -0.7 0.3 | |||
|
|
46 | 8 8 -0.4 0.7 | |||
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| @@ -0,0 +1,106 | |||||
|
|
1 | igrf2020s | |||
|
|
2 | 13 6371.2 2025 | |||
|
|
3 | 1 0 5.7 0 | |||
|
|
4 | 1 1 7.4 -25.9 | |||
|
|
5 | 2 0 -11 0 | |||
|
|
6 | 2 1 -7 -30.2 | |||
|
|
7 | 2 2 -2.1 -22.4 | |||
|
|
8 | 3 0 2.2 0 | |||
|
|
9 | 3 1 -5.9 6 | |||
|
|
10 | 3 2 3.1 -1.1 | |||
|
|
11 | 3 3 -12 0.5 | |||
|
|
12 | 4 0 -1.2 0 | |||
|
|
13 | 4 1 -1.6 -0.1 | |||
|
|
14 | 4 2 -5.9 6.5 | |||
|
|
15 | 4 3 5.2 3.6 | |||
|
|
16 | 4 4 -5.1 -5 | |||
|
|
17 | 5 0 -0.3 0 | |||
|
|
18 | 5 1 0.5 0 | |||
|
|
19 | 5 2 -0.6 2.5 | |||
|
|
20 | 5 3 0.2 -0.6 | |||
|
|
21 | 5 4 1.3 3 | |||
|
|
22 | 5 5 0.9 0.3 | |||
|
|
23 | 6 0 -0.5 0 | |||
|
|
24 | 6 1 -0.3 0 | |||
|
|
25 | 6 2 0.4 -1.6 | |||
|
|
26 | 6 3 1.3 -1.3 | |||
|
|
27 | 6 4 -1.4 0.8 | |||
|
|
28 | 6 5 0 0 | |||
|
|
29 | 6 6 0.9 1 | |||
|
|
30 | 7 0 -0.1 0 | |||
|
|
31 | 7 1 -0.2 0.6 | |||
|
|
32 | 7 2 0 0.6 | |||
|
|
33 | 7 3 0.7 -0.8 | |||
|
|
34 | 7 4 0.1 -0.2 | |||
|
|
35 | 7 5 -0.5 -1.1 | |||
|
|
36 | 7 6 -0.8 0.1 | |||
|
|
37 | 7 7 0.8 0.3 | |||
|
|
38 | 8 0 0 0 | |||
|
|
39 | 8 1 0.1 -0.2 | |||
|
|
40 | 8 2 -0.1 0.6 | |||
|
|
41 | 8 3 0.4 -0.2 | |||
|
|
42 | 8 4 -0.1 0.5 | |||
|
|
43 | 8 5 0.4 -0.3 | |||
|
|
44 | 8 6 0.3 -0.4 | |||
|
|
45 | 8 7 -0.1 0.5 | |||
|
|
46 | 8 8 0.4 0 | |||
|
|
47 | 9 0 0 0 | |||
|
|
48 | 9 1 0 0 | |||
|
|
49 | 9 2 0 0 | |||
|
|
50 | 9 3 0 0 | |||
|
|
51 | 9 4 0 0 | |||
|
|
52 | 9 5 0 0 | |||
|
|
53 | 9 6 0 0 | |||
|
|
54 | 9 7 0 0 | |||
|
|
55 | 9 8 0 0 | |||
|
|
56 | 9 9 0 0 | |||
|
|
57 | 10 0 0 0 | |||
|
|
58 | 10 1 0 0 | |||
|
|
59 | 10 2 0 0 | |||
|
|
60 | 10 3 0 0 | |||
|
|
61 | 10 4 0 0 | |||
|
|
62 | 10 5 0 0 | |||
|
|
63 | 10 6 0 0 | |||
|
|
64 | 10 7 0 0 | |||
|
|
65 | 10 8 0 0 | |||
|
|
66 | 10 9 0 0 | |||
|
|
67 | 10 10 0 0 | |||
|
|
68 | 11 0 0 0 | |||
|
|
69 | 11 1 0 0 | |||
|
|
70 | 11 2 0 0 | |||
|
|
71 | 11 3 0 0 | |||
|
|
72 | 11 4 0 0 | |||
|
|
73 | 11 5 0 0 | |||
|
|
74 | 11 6 0 0 | |||
|
|
75 | 11 7 0 0 | |||
|
|
76 | 11 8 0 0 | |||
|
|
77 | 11 9 0 0 | |||
|
|
78 | 11 10 0 0 | |||
|
|
79 | 11 11 0 0 | |||
|
|
80 | 12 0 0 0 | |||
|
|
81 | 12 1 0 0 | |||
|
|
82 | 12 2 0 0 | |||
|
|
83 | 12 3 0 0 | |||
|
|
84 | 12 4 0 0 | |||
|
|
85 | 12 5 0 0 | |||
|
|
86 | 12 6 0 0 | |||
|
|
87 | 12 7 0 0 | |||
|
|
88 | 12 8 0 0 | |||
|
|
89 | 12 9 0 0 | |||
|
|
90 | 12 10 0 0 | |||
|
|
91 | 12 11 0 0 | |||
|
|
92 | 12 12 0 0 | |||
|
|
93 | 13 0 0 0 | |||
|
|
94 | 13 1 0 0 | |||
|
|
95 | 13 2 0 0 | |||
|
|
96 | 13 3 0 0 | |||
|
|
97 | 13 4 0 0 | |||
|
|
98 | 13 5 0 0 | |||
|
|
99 | 13 6 0 0 | |||
|
|
100 | 13 7 0 0 | |||
|
|
101 | 13 8 0 0 | |||
|
|
102 | 13 9 0 0 | |||
|
|
103 | 13 10 0 0 | |||
|
|
104 | 13 11 0 0 | |||
|
|
105 | 13 12 0 0 | |||
|
|
106 | 13 13 0 0 | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf45 | |||
|
|
2 | 8 6371.2 1945.0 | |||
|
|
3 | 1 0 -30634. 0. | |||
|
|
4 | 1 1 -2240. 5806. | |||
|
|
5 | 2 0 -1215. 0. | |||
|
|
6 | 2 1 2972. -1700. | |||
|
|
7 | 2 2 1588. 497. | |||
|
|
8 | 3 0 1274. 0. | |||
|
|
9 | 3 1 -1833. -512. | |||
|
|
10 | 3 2 1225. 185. | |||
|
|
11 | 3 3 926. -5. | |||
|
|
12 | 4 0 980. 0. | |||
|
|
13 | 4 1 771. 155. | |||
|
|
14 | 4 2 544. -280. | |||
|
|
15 | 4 3 -408. -68. | |||
|
|
16 | 4 4 300. -158. | |||
|
|
17 | 5 0 -286. 0. | |||
|
|
18 | 5 1 341. -14. | |||
|
|
19 | 5 2 207. 80. | |||
|
|
20 | 5 3 -25. -65. | |||
|
|
21 | 5 4 -156. -114. | |||
|
|
22 | 5 5 -88. 83. | |||
|
|
23 | 6 0 68. 0. | |||
|
|
24 | 6 1 67. 9. | |||
|
|
25 | 6 2 6. 118. | |||
|
|
26 | 6 3 -244. 18. | |||
|
|
27 | 6 4 -12. -9. | |||
|
|
28 | 6 5 14. -12. | |||
|
|
29 | 6 6 -100. -42. | |||
|
|
30 | 7 0 72. 0. | |||
|
|
31 | 7 1 -61. -42. | |||
|
|
32 | 7 2 6. -39. | |||
|
|
33 | 7 3 6. 2. | |||
|
|
34 | 7 4 -44. -1. | |||
|
|
35 | 7 5 -2. 25. | |||
|
|
36 | 7 6 18. -19. | |||
|
|
37 | 7 7 27. -23. | |||
|
|
38 | 8 0 15. 0. | |||
|
|
39 | 8 1 5. -7. | |||
|
|
40 | 8 2 -12. 9. | |||
|
|
41 | 8 3 -21. 0. | |||
|
|
42 | 8 4 18. -13. | |||
|
|
43 | 8 5 16. 5. | |||
|
|
44 | 8 6 -14. 26. | |||
|
|
45 | 8 7 1. 1. | |||
|
|
46 | 8 8 10. -19. | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf50 | |||
|
|
2 | 8 6371.2 1950.0 | |||
|
|
3 | 1 0 -30571. 0. | |||
|
|
4 | 1 1 -2241. 5807. | |||
|
|
5 | 2 0 -1330. 0. | |||
|
|
6 | 2 1 2978. -1813. | |||
|
|
7 | 2 2 1579. 388. | |||
|
|
8 | 3 0 1293. 0. | |||
|
|
9 | 3 1 -1878. -485. | |||
|
|
10 | 3 2 1271. 228. | |||
|
|
11 | 3 3 890. -67. | |||
|
|
12 | 4 0 975. 0. | |||
|
|
13 | 4 1 795. 171. | |||
|
|
14 | 4 2 532. -306. | |||
|
|
15 | 4 3 -402. -51. | |||
|
|
16 | 4 4 310. -184. | |||
|
|
17 | 5 0 -255. 0. | |||
|
|
18 | 5 1 355. -8. | |||
|
|
19 | 5 2 201. 101. | |||
|
|
20 | 5 3 -3. -95. | |||
|
|
21 | 5 4 -160. -100. | |||
|
|
22 | 5 5 -76. 73. | |||
|
|
23 | 6 0 57. 0. | |||
|
|
24 | 6 1 50. -1. | |||
|
|
25 | 6 2 15. 100. | |||
|
|
26 | 6 3 -261. 52. | |||
|
|
27 | 6 4 8. -7. | |||
|
|
28 | 6 5 8. -17. | |||
|
|
29 | 6 6 -108. -21. | |||
|
|
30 | 7 0 67. 0. | |||
|
|
31 | 7 1 -48. -44. | |||
|
|
32 | 7 2 -3. -18. | |||
|
|
33 | 7 3 16. -6. | |||
|
|
34 | 7 4 -38. -8. | |||
|
|
35 | 7 5 1. 32. | |||
|
|
36 | 7 6 9. -18. | |||
|
|
37 | 7 7 11. -22. | |||
|
|
38 | 8 0 16. 0. | |||
|
|
39 | 8 1 4. 2. | |||
|
|
40 | 8 2 -8. -2. | |||
|
|
41 | 8 3 -31. -3. | |||
|
|
42 | 8 4 15. -7. | |||
|
|
43 | 8 5 8. 6. | |||
|
|
44 | 8 6 -17. 27. | |||
|
|
45 | 8 7 7. -6. | |||
|
|
46 | 8 8 13. -22. | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf55 | |||
|
|
2 | 8 6371.2 1955.0 | |||
|
|
3 | 1 0 -30507. 0. | |||
|
|
4 | 1 1 -2134. 5796. | |||
|
|
5 | 2 0 -1432. 0. | |||
|
|
6 | 2 1 2995. -1896. | |||
|
|
7 | 2 2 1567. 263. | |||
|
|
8 | 3 0 1308. 0. | |||
|
|
9 | 3 1 -1955. -487. | |||
|
|
10 | 3 2 1293. 235. | |||
|
|
11 | 3 3 897. -73. | |||
|
|
12 | 4 0 964. 0. | |||
|
|
13 | 4 1 794. 167. | |||
|
|
14 | 4 2 510. -275. | |||
|
|
15 | 4 3 -392. -44. | |||
|
|
16 | 4 4 292. -249. | |||
|
|
17 | 5 0 -232. 0. | |||
|
|
18 | 5 1 360. 14. | |||
|
|
19 | 5 2 237. 111. | |||
|
|
20 | 5 3 -13. -90. | |||
|
|
21 | 5 4 -176. -111. | |||
|
|
22 | 5 5 -68. 77. | |||
|
|
23 | 6 0 47. 0. | |||
|
|
24 | 6 1 57. -7. | |||
|
|
25 | 6 2 4. 101. | |||
|
|
26 | 6 3 -250. 46. | |||
|
|
27 | 6 4 12. -16. | |||
|
|
28 | 6 5 13. -6. | |||
|
|
29 | 6 6 -105. -21. | |||
|
|
30 | 7 0 80. 0. | |||
|
|
31 | 7 1 -66. -52. | |||
|
|
32 | 7 2 2. -37. | |||
|
|
33 | 7 3 4. 6. | |||
|
|
34 | 7 4 -46. -1. | |||
|
|
35 | 7 5 -15. 29. | |||
|
|
36 | 7 6 8. -20. | |||
|
|
37 | 7 7 14. -12. | |||
|
|
38 | 8 0 5. 0. | |||
|
|
39 | 8 1 17. 12. | |||
|
|
40 | 8 2 -3. 1. | |||
|
|
41 | 8 3 -30. 10. | |||
|
|
42 | 8 4 14. -20. | |||
|
|
43 | 8 5 27. 5. | |||
|
|
44 | 8 6 -15. 34. | |||
|
|
45 | 8 7 1. 4. | |||
|
|
46 | 8 8 12. -19. | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf60 | |||
|
|
2 | 10 6371.2 1960.0 | |||
|
|
3 | 1 0 -30411. 0. | |||
|
|
4 | 1 1 -2162. 5780. | |||
|
|
5 | 2 0 -1546. 0. | |||
|
|
6 | 2 1 3007. -1948. | |||
|
|
7 | 2 2 1572. 209. | |||
|
|
8 | 3 0 1307. 0. | |||
|
|
9 | 3 1 -1987. -421. | |||
|
|
10 | 3 2 1288. 230. | |||
|
|
11 | 3 3 879. -130. | |||
|
|
12 | 4 0 962. 0. | |||
|
|
13 | 4 1 804. 150. | |||
|
|
14 | 4 2 492. -272. | |||
|
|
15 | 4 3 -392. 1. | |||
|
|
16 | 4 4 267. -254. | |||
|
|
17 | 5 0 -236. 0. | |||
|
|
18 | 5 1 358. 12. | |||
|
|
19 | 5 2 229. 121. | |||
|
|
20 | 5 3 -34. -115. | |||
|
|
21 | 5 4 -153. -106. | |||
|
|
22 | 5 5 -64. 83. | |||
|
|
23 | 6 0 47. 0. | |||
|
|
24 | 6 1 56. -13. | |||
|
|
25 | 6 2 -3. 106. | |||
|
|
26 | 6 3 -241. 55. | |||
|
|
27 | 6 4 3. -26. | |||
|
|
28 | 6 5 4. -10. | |||
|
|
29 | 6 6 -108. -16. | |||
|
|
30 | 7 0 72. 0. | |||
|
|
31 | 7 1 -52. -53. | |||
|
|
32 | 7 2 4. -25. | |||
|
|
33 | 7 3 11. -8. | |||
|
|
34 | 7 4 -20. 3. | |||
|
|
35 | 7 5 -4. 28. | |||
|
|
36 | 7 6 15. -16. | |||
|
|
37 | 7 7 6. -18. | |||
|
|
38 | 8 0 6. 0. | |||
|
|
39 | 8 1 4. 7. | |||
|
|
40 | 8 2 -3. -16. | |||
|
|
41 | 8 3 -13. 5. | |||
|
|
42 | 8 4 -5. -19. | |||
|
|
43 | 8 5 10. 5. | |||
|
|
44 | 8 6 -6. 23. | |||
|
|
45 | 8 7 15. -2. | |||
|
|
46 | 8 8 5. -18. | |||
|
|
47 | 9 0 13. 0. | |||
|
|
48 | 9 1 5. -22. | |||
|
|
49 | 9 2 4. 14. | |||
|
|
50 | 9 3 -12. 5. | |||
|
|
51 | 9 4 14. -5. | |||
|
|
52 | 9 5 5. 0. | |||
|
|
53 | 9 6 -2. 11. | |||
|
|
54 | 9 7 0. 10. | |||
|
|
55 | 9 8 0. 2. | |||
|
|
56 | 9 9 -1. -2. | |||
|
|
57 | 10 0 -5. 0. | |||
|
|
58 | 10 1 -2. 3. | |||
|
|
59 | 10 2 0. 0. | |||
|
|
60 | 10 3 -5. 4. | |||
|
|
61 | 10 4 -2. 3. | |||
|
|
62 | 10 5 8. -4. | |||
|
|
63 | 10 6 3. -2. | |||
|
|
64 | 10 7 0. -3. | |||
|
|
65 | 10 8 1. 5. | |||
|
|
66 | 10 9 0. 3. | |||
|
|
67 | 10 10 -1. -3. | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf85 | |||
|
|
2 | 10 6371.2 1980.0 | |||
|
|
3 | 1 0 -29877. 0. | |||
|
|
4 | 1 1 -1903. 5497. | |||
|
|
5 | 2 0 -2073. 0. | |||
|
|
6 | 2 1 3045. -2191. | |||
|
|
7 | 2 2 1691. -309. | |||
|
|
8 | 3 0 1300. 0. | |||
|
|
9 | 3 1 -2208. -312. | |||
|
|
10 | 3 2 1244. 284. | |||
|
|
11 | 3 3 835. -296. | |||
|
|
12 | 4 0 937. 0. | |||
|
|
13 | 4 1 780. 233. | |||
|
|
14 | 4 2 363. -250. | |||
|
|
15 | 4 3 -426. 68. | |||
|
|
16 | 4 4 169. -298. | |||
|
|
17 | 5 0 -215. 0. | |||
|
|
18 | 5 1 356. 47. | |||
|
|
19 | 5 2 253. 148. | |||
|
|
20 | 5 3 -94. -155. | |||
|
|
21 | 5 4 -161. -75. | |||
|
|
22 | 5 5 -48. 95. | |||
|
|
23 | 6 0 52. 0. | |||
|
|
24 | 6 1 65. -16. | |||
|
|
25 | 6 2 50. 90. | |||
|
|
26 | 6 3 -186. 69. | |||
|
|
27 | 6 4 4. -50. | |||
|
|
28 | 6 5 17. -4. | |||
|
|
29 | 6 6 -102. 20. | |||
|
|
30 | 7 0 75. 0. | |||
|
|
31 | 7 1 -61. -82. | |||
|
|
32 | 7 2 2. -26. | |||
|
|
33 | 7 3 24. -1. | |||
|
|
34 | 7 4 -6. 23. | |||
|
|
35 | 7 5 4. 17. | |||
|
|
36 | 7 6 9. -21. | |||
|
|
37 | 7 7 0. -6. | |||
|
|
38 | 8 0 21. 0. | |||
|
|
39 | 8 1 6. 7. | |||
|
|
40 | 8 2 0. -21. | |||
|
|
41 | 8 3 -11. 5. | |||
|
|
42 | 8 4 -9. -25. | |||
|
|
43 | 8 5 2. 11. | |||
|
|
44 | 8 6 4. 12. | |||
|
|
45 | 8 7 4. -16. | |||
|
|
46 | 8 8 -6. -10. | |||
|
|
47 | 9 0 5. 0. | |||
|
|
48 | 9 1 10. -21. | |||
|
|
49 | 9 2 1. 16. | |||
|
|
50 | 9 3 -12. 9. | |||
|
|
51 | 9 4 9. -5. | |||
|
|
52 | 9 5 -3. -6. | |||
|
|
53 | 9 6 -1. 9. | |||
|
|
54 | 9 7 7. 10. | |||
|
|
55 | 9 8 2. -6. | |||
|
|
56 | 9 9 -5. 2. | |||
|
|
57 | 10 0 -4. 0. | |||
|
|
58 | 10 1 -4. 1. | |||
|
|
59 | 10 2 2. 0. | |||
|
|
60 | 10 3 -5. 3. | |||
|
|
61 | 10 4 -2. 6. | |||
|
|
62 | 10 5 5. -4. | |||
|
|
63 | 10 6 3. 0. | |||
|
|
64 | 10 7 1. -1. | |||
|
|
65 | 10 8 2. 4. | |||
|
|
66 | 10 9 3. 0. | |||
|
|
67 | 10 10 0. -6. | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf85s | |||
|
|
2 | 8 6371.2 1990.0 | |||
|
|
3 | 1 0 23.2 0.0 | |||
|
|
4 | 1 1 10.0 -24.5 | |||
|
|
5 | 2 0 -13.7 0.0 | |||
|
|
6 | 2 1 3.4 -11.5 | |||
|
|
7 | 2 2 7.0 -20.2 | |||
|
|
8 | 3 0 5.1 0.0 | |||
|
|
9 | 3 1 -4.6 5.3 | |||
|
|
10 | 3 2 -0.6 2.3 | |||
|
|
11 | 3 3 0.1 -10.8 | |||
|
|
12 | 4 0 0.1 0.0 | |||
|
|
13 | 4 1 -0.6 3.8 | |||
|
|
14 | 4 2 -7.8 2.2 | |||
|
|
15 | 4 3 -1.4 2.5 | |||
|
|
16 | 4 4 -6.8 0.9 | |||
|
|
17 | 5 0 1.3 0.0 | |||
|
|
18 | 5 1 0.1 0.1 | |||
|
|
19 | 5 2 -1.5 -0.2 | |||
|
|
20 | 5 3 -3.2 -0.1 | |||
|
|
21 | 5 4 0.1 0.6 | |||
|
|
22 | 5 5 -0.1 0.0 | |||
|
|
23 | 6 0 1.4 0.0 | |||
|
|
24 | 6 1 -0.3 -0.4 | |||
|
|
25 | 6 2 1.7 -1.1 | |||
|
|
26 | 6 3 0.6 -0.8 | |||
|
|
27 | 6 4 0.0 -2.3 | |||
|
|
28 | 6 5 0.9 -0.5 | |||
|
|
29 | 6 6 1.2 -0.1 | |||
|
|
30 | 7 0 0.2 0.0 | |||
|
|
31 | 7 1 -0.6 0.2 | |||
|
|
32 | 7 2 -0.5 1.0 | |||
|
|
33 | 7 3 0.8 1.1 | |||
|
|
34 | 7 4 1.0 1.9 | |||
|
|
35 | 7 5 0.4 0.3 | |||
|
|
36 | 7 6 -0.5 0.2 | |||
|
|
37 | 7 7 -0.1 0.9 | |||
|
|
38 | 8 0 0.7 0.0 | |||
|
|
39 | 8 1 0.0 0.1 | |||
|
|
40 | 8 2 0.3 -1.0 | |||
|
|
41 | 8 3 0.4 0.1 | |||
|
|
42 | 8 4 -0.3 -0.8 | |||
|
|
43 | 8 5 -0.3 0.2 | |||
|
|
44 | 8 6 0.1 -0.8 | |||
|
|
45 | 8 7 -0.5 -0.1 | |||
|
|
46 | 8 8 -0.8 1.3 | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf90 | |||
|
|
2 | 10 6371.2 1990.0 | |||
|
|
3 | 1 0 -29775.4 0.0 | |||
|
|
4 | 1 1 -1851.0 5410.9 | |||
|
|
5 | 2 0 -2135.8 0.0 | |||
|
|
6 | 2 1 3058.2 -2277.7 | |||
|
|
7 | 2 2 1693.2 -380.0 | |||
|
|
8 | 3 0 1314.6 0.0 | |||
|
|
9 | 3 1 -2240.2 -286.5 | |||
|
|
10 | 3 2 1245.6 293.3 | |||
|
|
11 | 3 3 806.5 -348.5 | |||
|
|
12 | 4 0 938.9 0.0 | |||
|
|
13 | 4 1 782.3 248.1 | |||
|
|
14 | 4 2 323.9 -239.5 | |||
|
|
15 | 4 3 -422.7 87.0 | |||
|
|
16 | 4 4 141.7 -299.4 | |||
|
|
17 | 5 0 -211.0 0.0 | |||
|
|
18 | 5 1 352.5 47.2 | |||
|
|
19 | 5 2 243.8 153.5 | |||
|
|
20 | 5 3 -110.8 -154.4 | |||
|
|
21 | 5 4 -165.6 -69.2 | |||
|
|
22 | 5 5 -37.0 97.7 | |||
|
|
23 | 6 0 60.7 0.0 | |||
|
|
24 | 6 1 63.9 -15.8 | |||
|
|
25 | 6 2 60.4 82.7 | |||
|
|
26 | 6 3 -177.5 68.3 | |||
|
|
27 | 6 4 2.0 -52.5 | |||
|
|
28 | 6 5 16.7 1.8 | |||
|
|
29 | 6 6 -96.3 26.9 | |||
|
|
30 | 7 0 76.6 0.0 | |||
|
|
31 | 7 1 -64.2 -81.1 | |||
|
|
32 | 7 2 3.7 -27.3 | |||
|
|
33 | 7 3 27.5 0.6 | |||
|
|
34 | 7 4 0.9 20.4 | |||
|
|
35 | 7 5 5.7 16.4 | |||
|
|
36 | 7 6 9.8 -22.6 | |||
|
|
37 | 7 7 -0.5 -5.0 | |||
|
|
38 | 8 0 22.4 0.0 | |||
|
|
39 | 8 1 5.1 9.7 | |||
|
|
40 | 8 2 -0.9 -19.9 | |||
|
|
41 | 8 3 -10.8 7.1 | |||
|
|
42 | 8 4 -12.4 -22.1 | |||
|
|
43 | 8 5 3.8 11.9 | |||
|
|
44 | 8 6 3.8 11.0 | |||
|
|
45 | 8 7 2.6 -16.0 | |||
|
|
46 | 8 8 -6.0 -10.7 | |||
|
|
47 | 9 0 4.4 0.0 | |||
|
|
48 | 9 1 9.9 -20.8 | |||
|
|
49 | 9 2 0.8 15.4 | |||
|
|
50 | 9 3 -12.0 9.5 | |||
|
|
51 | 9 4 9.3 -5.7 | |||
|
|
52 | 9 5 -3.9 -6.4 | |||
|
|
53 | 9 6 -1.4 8.6 | |||
|
|
54 | 9 7 7.3 9.1 | |||
|
|
55 | 9 8 1.5 -6.6 | |||
|
|
56 | 9 9 -5.5 1.9 | |||
|
|
57 | 10 0 -3.6 0.0 | |||
|
|
58 | 10 1 -3.9 1.3 | |||
|
|
59 | 10 2 2.4 0.4 | |||
|
|
60 | 10 3 -5.3 3.1 | |||
|
|
61 | 10 4 -2.4 5.6 | |||
|
|
62 | 10 5 4.4 -4.2 | |||
|
|
63 | 10 6 3.0 -0.5 | |||
|
|
64 | 10 7 1.2 -1.5 | |||
|
|
65 | 10 8 2.2 3.8 | |||
|
|
66 | 10 9 2.9 -0.5 | |||
|
|
67 | 10 10 0.0 -6.2 | |||
| @@ -0,0 +1,66 | |||||
|
|
1 | IGRF90 1990.00 10 8 0 1990.00 1995.00 -1.0 600.0 IGRF90 | |||
|
|
2 | 0 1-29775.4 .0 18.0 .0 IGRF90 1 | |||
|
|
3 | 1 1 -1851.0 5410.9 10.6 -16.1 IGRF90 2 | |||
|
|
4 | 0 2 -2135.8 .0 -12.9 .0 IGRF90 3 | |||
|
|
5 | 1 2 3058.2 -2277.7 2.4 -15.8 IGRF90 4 | |||
|
|
6 | 2 2 1693.2 -380.0 -.0 -13.8 IGRF90 5 | |||
|
|
7 | 0 3 1314.6 .0 3.3 .0 IGRF90 6 | |||
|
|
8 | 1 3 -2240.2 -286.5 -6.7 4.4 IGRF90 7 | |||
|
|
9 | 2 3 1245.6 293.3 .0 1.6 IGRF90 8 | |||
|
|
10 | 3 3 806.5 -348.5 -5.9 -10.6 IGRF90 9 | |||
|
|
11 | 0 4 938.9 .0 .5 .0 IGRF90 10 | |||
|
|
12 | 1 4 782.3 248.1 .6 2.6 IGRF90 11 | |||
|
|
13 | 2 4 323.9 -239.5 -7.0 1.8 IGRF90 12 | |||
|
|
14 | 3 4 -422.7 87.0 .5 3.1 IGRF90 13 | |||
|
|
15 | 4 4 141.7 -299.4 -5.5 -1.4 IGRF90 14 | |||
|
|
16 | 0 5 -211.0 .0 .6 .0 IGRF90 15 | |||
|
|
17 | 1 5 352.5 47.2 -.1 -.1 IGRF90 16 | |||
|
|
18 | 2 5 243.8 153.5 -1.6 .5 IGRF90 17 | |||
|
|
19 | 3 5 -110.8 -154.4 -3.1 .4 IGRF90 18 | |||
|
|
20 | 4 5 -165.6 -69.2 -.0 1.7 IGRF90 19 | |||
|
|
21 | 5 5 -37.0 97.7 2.3 .4 IGRF90 20 | |||
|
|
22 | 0 6 60.7 .0 1.3 .0 IGRF90 21 | |||
|
|
23 | 1 6 63.9 -15.8 -.2 .2 IGRF90 22 | |||
|
|
24 | 2 6 60.4 82.7 1.8 -1.3 IGRF90 23 | |||
|
|
25 | 3 6 -177.5 68.3 1.3 .0 IGRF90 24 | |||
|
|
26 | 4 6 2.0 -52.5 -.2 -.9 IGRF90 25 | |||
|
|
27 | 5 6 16.7 1.8 .1 .5 IGRF90 26 | |||
|
|
28 | 6 6 -96.3 26.9 1.2 1.2 IGRF90 27 | |||
|
|
29 | 0 7 76.6 .0 .6 .0 IGRF90 28 | |||
|
|
30 | 1 7 -64.2 -81.1 -.5 .6 IGRF90 29 | |||
|
|
31 | 2 7 3.7 -27.3 -.3 .2 IGRF90 30 | |||
|
|
32 | 3 7 27.5 .6 .6 .8 IGRF90 31 | |||
|
|
33 | 4 7 .9 20.4 1.6 -.5 IGRF90 32 | |||
|
|
34 | 5 7 5.7 16.4 .2 -.2 IGRF90 33 | |||
|
|
35 | 6 7 9.8 -22.6 .2 .0 IGRF90 34 | |||
|
|
36 | 7 7 -.5 -5.0 .3 -.0 IGRF90 35 | |||
|
|
37 | 0 8 22.4 .0 .2 .0 IGRF90 36 | |||
|
|
38 | 1 8 5.1 9.7 -.7 .5 IGRF90 37 | |||
|
|
39 | 2 8 -.9 -19.9 -.2 -.2 IGRF90 38 | |||
|
|
40 | 3 8 -10.8 7.1 .1 .3 IGRF90 39 | |||
|
|
41 | 4 8 -12.4 -22.1 -1.1 .3 IGRF90 40 | |||
|
|
42 | 5 8 3.8 11.9 -.0 .4 IGRF90 41 | |||
|
|
43 | 6 8 3.8 11.0 -.0 -.5 IGRF90 42 | |||
|
|
44 | 7 8 2.6 -16.0 -.5 -.3 IGRF90 43 | |||
|
|
45 | 8 8 -6.0 -10.7 -.6 .6 IGRF90 44 | |||
|
|
46 | 0 9 4.4 .0 .0 .0 IGRF90 45 | |||
|
|
47 | 1 9 9.9 -20.8 .0 .0 IGRF90 46 | |||
|
|
48 | 2 9 .8 15.4 .0 .0 IGRF90 47 | |||
|
|
49 | 3 9 -12.0 9.5 .0 .0 IGRF90 48 | |||
|
|
50 | 4 9 9.3 -5.7 .0 .0 IGRF90 49 | |||
|
|
51 | 5 9 -3.9 -6.4 .0 .0 IGRF90 50 | |||
|
|
52 | 6 9 -1.4 8.6 .0 .0 IGRF90 51 | |||
|
|
53 | 7 9 7.3 9.1 .0 .0 IGRF90 52 | |||
|
|
54 | 8 9 1.5 -6.6 .0 .0 IGRF90 53 | |||
|
|
55 | 9 9 -5.5 1.9 .0 .0 IGRF90 54 | |||
|
|
56 | 010 -3.6 .0 .0 .0 IGRF90 55 | |||
|
|
57 | 110 -3.9 1.3 .0 .0 IGRF90 56 | |||
|
|
58 | 210 2.4 .4 .0 .0 IGRF90 57 | |||
|
|
59 | 310 -5.3 3.1 .0 .0 IGRF90 58 | |||
|
|
60 | 410 -2.4 5.6 .0 .0 IGRF90 59 | |||
|
|
61 | 510 4.4 -4.2 .0 .0 IGRF90 60 | |||
|
|
62 | 610 3.0 -.5 .0 .0 IGRF90 61 | |||
|
|
63 | 710 1.2 -1.5 .0 .0 IGRF90 62 | |||
|
|
64 | 810 2.2 3.8 .0 .0 IGRF90 63 | |||
|
|
65 | 910 2.9 -.5 .0 .0 IGRF90 64 | |||
|
|
66 | 1010 .0 -6.2 .0 .0 IGRF90 65 | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf90s | |||
|
|
2 | 8 6371.2 1995.0 | |||
|
|
3 | 1 0 18.0 0.0 | |||
|
|
4 | 1 1 10.6 -16.1 | |||
|
|
5 | 2 0 -12.9 0.0 | |||
|
|
6 | 2 1 2.4 -15.8 | |||
|
|
7 | 2 2 0.0 -13.8 | |||
|
|
8 | 3 0 3.3 0.0 | |||
|
|
9 | 3 1 -6.7 4.4 | |||
|
|
10 | 3 2 0.0 1.6 | |||
|
|
11 | 3 3 -5.9 -10.6 | |||
|
|
12 | 4 0 0.5 0.0 | |||
|
|
13 | 4 1 0.6 2.6 | |||
|
|
14 | 4 2 -7.0 1.8 | |||
|
|
15 | 4 3 0.5 3.1 | |||
|
|
16 | 4 4 -5.5 -1.4 | |||
|
|
17 | 5 0 0.6 0.0 | |||
|
|
18 | 5 1 -0.1 -0.1 | |||
|
|
19 | 5 2 -1.6 0.5 | |||
|
|
20 | 5 3 -3.1 0.4 | |||
|
|
21 | 5 4 0.0 1.7 | |||
|
|
22 | 5 5 2.3 0.4 | |||
|
|
23 | 6 0 1.3 0.0 | |||
|
|
24 | 6 1 -0.2 0.2 | |||
|
|
25 | 6 2 1.8 -1.3 | |||
|
|
26 | 6 3 1.3 0.0 | |||
|
|
27 | 6 4 -0.2 -0.9 | |||
|
|
28 | 6 5 0.1 0.5 | |||
|
|
29 | 6 6 1.2 1.2 | |||
|
|
30 | 7 0 0.6 0.0 | |||
|
|
31 | 7 1 -0.5 0.6 | |||
|
|
32 | 7 2 -0.3 0.2 | |||
|
|
33 | 7 3 0.6 0.8 | |||
|
|
34 | 7 4 1.6 -0.5 | |||
|
|
35 | 7 5 0.2 -0.2 | |||
|
|
36 | 7 6 0.2 0.0 | |||
|
|
37 | 7 7 0.3 0.0 | |||
|
|
38 | 8 0 0.2 0.0 | |||
|
|
39 | 8 1 -0.7 0.5 | |||
|
|
40 | 8 2 -0.2 -0.2 | |||
|
|
41 | 8 3 0.1 0.3 | |||
|
|
42 | 8 4 -1.1 0.3 | |||
|
|
43 | 8 5 0.0 0.4 | |||
|
|
44 | 8 6 0.0 -0.5 | |||
|
|
45 | 8 7 -0.5 -0.3 | |||
|
|
46 | 8 8 -0.6 0.6 | |||
| @@ -0,0 +1,67 | |||||
|
|
1 | igrf95 | |||
|
|
2 | 10 6371.2 1995.0 | |||
|
|
3 | 1 0 -29682. 0.0 | |||
|
|
4 | 1 1 -1789. 5318. | |||
|
|
5 | 2 0 -2197. 0.0 | |||
|
|
6 | 2 1 3074. -2356. | |||
|
|
7 | 2 2 1685. -425. | |||
|
|
8 | 3 0 1329. 0.0 | |||
|
|
9 | 3 1 -2268. -263. | |||
|
|
10 | 3 2 1249. 302. | |||
|
|
11 | 3 3 769. -406. | |||
|
|
12 | 4 0 941. .0 | |||
|
|
13 | 4 1 782. 262. | |||
|
|
14 | 4 2 291. -232. | |||
|
|
15 | 4 3 -421. 98. | |||
|
|
16 | 4 4 116. -301. | |||
|
|
17 | 5 0 -210. .0 | |||
|
|
18 | 5 1 352. 44. | |||
|
|
19 | 5 2 237. 157. | |||
|
|
20 | 5 3 -122. -152. | |||
|
|
21 | 5 4 -167. -64. | |||
|
|
22 | 5 5 -26. 99. | |||
|
|
23 | 6 0 66. .0 | |||
|
|
24 | 6 1 64. -16. | |||
|
|
25 | 6 2 65. 77. | |||
|
|
26 | 6 3 -172. 67. | |||
|
|
27 | 6 4 2. -57. | |||
|
|
28 | 6 5 17. 4. | |||
|
|
29 | 6 6 -94. 28. | |||
|
|
30 | 7 0 78. -.0 | |||
|
|
31 | 7 1 -67. -77. | |||
|
|
32 | 7 2 1. -25. | |||
|
|
33 | 7 3 29. 3. | |||
|
|
34 | 7 4 4. 22. | |||
|
|
35 | 7 5 8. 16. | |||
|
|
36 | 7 6 10. -23. | |||
|
|
37 | 7 7 -2. -3. | |||
|
|
38 | 8 0 24. .0 | |||
|
|
39 | 8 1 4. 12. | |||
|
|
40 | 8 2 -1. -20. | |||
|
|
41 | 8 3 -9. 7. | |||
|
|
42 | 8 4 -14. -21. | |||
|
|
43 | 8 5 4. 12. | |||
|
|
44 | 8 6 5. 10. | |||
|
|
45 | 8 7 0. -17. | |||
|
|
46 | 8 8 -7. -10. | |||
|
|
47 | 9 0 4. .0 | |||
|
|
48 | 9 1 9. -19. | |||
|
|
49 | 9 2 1. 15. | |||
|
|
50 | 9 3 -12. 11. | |||
|
|
51 | 9 4 9. -7. | |||
|
|
52 | 9 5 -4. -7. | |||
|
|
53 | 9 6 -2. 9. | |||
|
|
54 | 9 7 7. 7. | |||
|
|
55 | 9 8 0. -8. | |||
|
|
56 | 9 9 -6. 1. | |||
|
|
57 | 10 0 -3. .0 | |||
|
|
58 | 10 1 -4. 2. | |||
|
|
59 | 10 2 2. 1. | |||
|
|
60 | 10 3 -5. 3. | |||
|
|
61 | 10 4 -2. 6. | |||
|
|
62 | 10 5 4. -4. | |||
|
|
63 | 10 6 3. 0. | |||
|
|
64 | 10 7 1. -2. | |||
|
|
65 | 10 8 3. 3. | |||
|
|
66 | 10 9 3. -1. | |||
|
|
67 | 10 10 0. -6. | |||
| @@ -0,0 +1,46 | |||||
|
|
1 | igrf95s | |||
|
|
2 | 8 6371.2 2000.0 | |||
|
|
3 | 1 0 17.6 0. | |||
|
|
4 | 1 1 13.0 -18.3 | |||
|
|
5 | 2 0 -13.2 0. | |||
|
|
6 | 2 1 3.7 -15.0 | |||
|
|
7 | 2 2 -0.8 -8.8 | |||
|
|
8 | 3 0 1.5 0. | |||
|
|
9 | 3 1 -6.4 4.1 | |||
|
|
10 | 3 2 -0.2 2.2 | |||
|
|
11 | 3 3 -8.1 -12.1 | |||
|
|
12 | 4 0 0.8 0. | |||
|
|
13 | 4 1 0.9 1.8 | |||
|
|
14 | 4 2 -6.9 1.2 | |||
|
|
15 | 4 3 0.5 2.7 | |||
|
|
16 | 4 4 -4.6 -1.0 | |||
|
|
17 | 5 0 0.8 0. | |||
|
|
18 | 5 1 0.1 0.2 | |||
|
|
19 | 5 2 -1.5 1.2 | |||
|
|
20 | 5 3 -2.0 0.3 | |||
|
|
21 | 5 4 -0.1 1.8 | |||
|
|
22 | 5 5 2.3 0.9 | |||
|
|
23 | 6 0 0.5 0. | |||
|
|
24 | 6 1 -0.4 0.3 | |||
|
|
25 | 6 2 0.6 -1.6 | |||
|
|
26 | 6 3 1.9 -0.2 | |||
|
|
27 | 6 4 -0.2 -0.9 | |||
|
|
28 | 6 5 -0.2 1.0 | |||
|
|
29 | 6 6 .0 2.2 | |||
|
|
30 | 7 0 -0.2 0. | |||
|
|
31 | 7 1 -0.8 0.8 | |||
|
|
32 | 7 2 -0.6 0.2 | |||
|
|
33 | 7 3 0.6 0.6 | |||
|
|
34 | 7 4 1.2 -0.4 | |||
|
|
35 | 7 5 0.1 0.0 | |||
|
|
36 | 7 6 0.2 -0.3 | |||
|
|
37 | 7 7 -0.6 0. | |||
|
|
38 | 8 0 0.3 0. | |||
|
|
39 | 8 1 -0.2 0.4 | |||
|
|
40 | 8 2 0.1 -0.2 | |||
|
|
41 | 8 3 0.4 0.2 | |||
|
|
42 | 8 4 -1.1 0.7 | |||
|
|
43 | 8 5 0.3 0.0 | |||
|
|
44 | 8 6 0.2 -1.2 | |||
|
|
45 | 8 7 -0.9 -0.7 | |||
|
|
46 | 8 8 -0.3 -0.6 | |||
| @@ -0,0 +1,10 | |||||
|
|
1 | { | |||
|
|
2 | if($1 < 10) | |||
|
|
3 | { | |||
|
|
4 | printf(" %d %d %8.1f %8.1f\n",$2,$1,$3,$4); | |||
|
|
5 | } | |||
|
|
6 | else | |||
|
|
7 | { | |||
|
|
8 | printf(" 10 %d %8.1f %8.1f\n",$1/100,$2,$3); | |||
|
|
9 | } | |||
|
|
10 | } No newline at end of file | |||
| @@ -0,0 +1,10 | |||||
|
|
1 | { | |||
|
|
2 | if($1 < 10) | |||
|
|
3 | { | |||
|
|
4 | printf(" %d %d %8.1f %8.1f\n",$2,$1,$5,$6); | |||
|
|
5 | } | |||
|
|
6 | else | |||
|
|
7 | { | |||
|
|
8 | printf(" 10 %d %8.1f %8.1f\n",$1/100,$4,$5); | |||
|
|
9 | } | |||
|
|
10 | } No newline at end of file | |||
| @@ -0,0 +1,164 | |||||
|
|
1 | c parameter(nn=20,kk=4) | |||
|
|
2 | c real ta(nn+kk),bcoef(nn) | |||
|
|
3 | ||||
|
|
4 | c k=kk | |||
|
|
5 | c n=nn | |||
|
|
6 | ||||
|
|
7 | c do i=1,n+k | |||
|
|
8 | c ta(i)=float(i) | |||
|
|
9 | c end do | |||
|
|
10 | ||||
|
|
11 | c do i=1,n | |||
|
|
12 | c bcoef(i)=float(i) | |||
|
|
13 | c end do | |||
|
|
14 | ||||
|
|
15 | c do i=3,n+1 | |||
|
|
16 | c write(*,*) ta(i)+0.5, bvalue (ta, bcoef, n, k, ta(i)+0.5, 0 ) | |||
|
|
17 | c end do | |||
|
|
18 | ||||
|
|
19 | c stop | |||
|
|
20 | c end | |||
|
|
21 | ||||
|
|
22 | ||||
|
|
23 | real function bvalue ( t, bcoef, n, k, x, jderiv ) | |||
|
|
24 | c from * a practical guide to splines * by c. de boor | |||
|
|
25 | calls interv | |||
|
|
26 | c | |||
|
|
27 | calculates value at x of jderiv-th derivative of spline from b-repr. | |||
|
|
28 | c the spline is taken to be continuous from the right, EXCEPT at the | |||
|
|
29 | c rightmost knot, where it is taken to be continuous from the left. | |||
|
|
30 | c | |||
|
|
31 | c****** i n p u t ****** | |||
|
|
32 | c t, bcoef, n, k......forms the b-representation of the spline f to | |||
|
|
33 | c be evaluated. specifically, | |||
|
|
34 | c t.....knot sequence, of length n+k, assumed nondecreasing. | |||
|
|
35 | c bcoef.....b-coefficient sequence, of length n . | |||
|
|
36 | c n.....length of bcoef and dimension of spline(k,t), | |||
|
|
37 | c a s s u m e d positive . | |||
|
|
38 | c k.....order of the spline . | |||
|
|
39 | c | |||
|
|
40 | c w a r n i n g . . . the restriction k .le. kmax (=20) is imposed | |||
|
|
41 | c arbitrarily by the dimension statement for aj, dl, dr below, | |||
|
|
42 | c but is n o w h e r e c h e c k e d for. | |||
|
|
43 | c | |||
|
|
44 | c x.....the point at which to evaluate . | |||
|
|
45 | c jderiv.....integer giving the order of the derivative to be evaluated | |||
|
|
46 | c a s s u m e d to be zero or positive. | |||
|
|
47 | c | |||
|
|
48 | c****** o u t p u t ****** | |||
|
|
49 | c bvalue.....the value of the (jderiv)-th derivative of f at x . | |||
|
|
50 | c | |||
|
|
51 | c****** m e t h o d ****** | |||
|
|
52 | c The nontrivial knot interval (t(i),t(i+1)) containing x is lo- | |||
|
|
53 | c cated with the aid of interv . The k b-coeffs of f relevant for | |||
|
|
54 | c this interval are then obtained from bcoef (or taken to be zero if | |||
|
|
55 | c not explicitly available) and are then differenced jderiv times to | |||
|
|
56 | c obtain the b-coeffs of (d**jderiv)f relevant for that interval. | |||
|
|
57 | c Precisely, with j = jderiv, we have from x.(12) of the text that | |||
|
|
58 | c | |||
|
|
59 | c (d**j)f = sum ( bcoef(.,j)*b(.,k-j,t) ) | |||
|
|
60 | c | |||
|
|
61 | c where | |||
|
|
62 | c / bcoef(.), , j .eq. 0 | |||
|
|
63 | c / | |||
|
|
64 | c bcoef(.,j) = / bcoef(.,j-1) - bcoef(.-1,j-1) | |||
|
|
65 | c / ----------------------------- , j .gt. 0 | |||
|
|
66 | c / (t(.+k-j) - t(.))/(k-j) | |||
|
|
67 | c | |||
|
|
68 | c Then, we use repeatedly the fact that | |||
|
|
69 | c | |||
|
|
70 | c sum ( a(.)*b(.,m,t)(x) ) = sum ( a(.,x)*b(.,m-1,t)(x) ) | |||
|
|
71 | c with | |||
|
|
72 | c (x - t(.))*a(.) + (t(.+m-1) - x)*a(.-1) | |||
|
|
73 | c a(.,x) = --------------------------------------- | |||
|
|
74 | c (x - t(.)) + (t(.+m-1) - x) | |||
|
|
75 | c | |||
|
|
76 | c to write (d**j)f(x) eventually as a linear combination of b-splines | |||
|
|
77 | c of order 1 , and the coefficient for b(i,1,t)(x) must then be the | |||
|
|
78 | c desired number (d**j)f(x). (see x.(17)-(19) of text). | |||
|
|
79 | c | |||
|
|
80 | parameter (kmax = 20) | |||
|
|
81 | integer jderiv,k,n,i,ilo,imk,j,jc,jcmin,jcmax,jj, | |||
|
|
82 | c * kmax, | |||
|
|
83 | * kmj,km1 | |||
|
|
84 | * ,mflag,nmi,jdrvp1 | |||
|
|
85 | C real bcoef(n),t(1),x, aj(20),dl(20),dr(20),fkmj | |||
|
|
86 | real bcoef(n),x, aj(kmax),dl(kmax),dr(kmax),fkmj | |||
|
|
87 | dimension t(n+k) | |||
|
|
88 | c former fortran standard made it impossible to specify the length of t | |||
|
|
89 | c precisely without the introduction of otherwise superfluous addition- | |||
|
|
90 | c al arguments. | |||
|
|
91 | bvalue = 0. | |||
|
|
92 | if (jderiv .ge. k) go to 99 | |||
|
|
93 | c | |||
|
|
94 | c *** Find i s.t. 1 .le. i .lt. n+k and t(i) .lt. t(i+1) and | |||
|
|
95 | c t(i) .le. x .lt. t(i+1) . If no such i can be found, x lies | |||
|
|
96 | c outside the support of the spline f , hence bvalue = 0. | |||
|
|
97 | c (The asymmetry in this choice of i makes f rightcontinuous, except | |||
|
|
98 | c at t(n+k) where it is leftcontinuous.) | |||
|
|
99 | call interv ( t, n+k, x, i, mflag ) | |||
|
|
100 | if (mflag .ne. 0) go to 99 | |||
|
|
101 | c *** if k = 1 (and jderiv = 0), bvalue = bcoef(i). | |||
|
|
102 | km1 = k - 1 | |||
|
|
103 | if (km1 .gt. 0) go to 1 | |||
|
|
104 | bvalue = bcoef(i) | |||
|
|
105 | go to 99 | |||
|
|
106 | c | |||
|
|
107 | c *** store the k b-spline coefficients relevant for the knot interval | |||
|
|
108 | c (t(i),t(i+1)) in aj(1),...,aj(k) and compute dl(j) = x - t(i+1-j), | |||
|
|
109 | c dr(j) = t(i+j) - x, j=1,...,k-1 . set any of the aj not obtainable | |||
|
|
110 | c from input to zero. set any t.s not obtainable equal to t(1) or | |||
|
|
111 | c to t(n+k) appropriately. | |||
|
|
112 | 1 jcmin = 1 | |||
|
|
113 | imk = i - k | |||
|
|
114 | if (imk .ge. 0) go to 8 | |||
|
|
115 | jcmin = 1 - imk | |||
|
|
116 | do 5 j=1,i | |||
|
|
117 | 5 dl(j) = x - t(i+1-j) | |||
|
|
118 | do 6 j=i,km1 | |||
|
|
119 | aj(k-j) = 0. | |||
|
|
120 | 6 dl(j) = dl(i) | |||
|
|
121 | go to 10 | |||
|
|
122 | 8 do 9 j=1,km1 | |||
|
|
123 | 9 dl(j) = x - t(i+1-j) | |||
|
|
124 | c | |||
|
|
125 | 10 jcmax = k | |||
|
|
126 | nmi = n - i | |||
|
|
127 | if (nmi .ge. 0) go to 18 | |||
|
|
128 | jcmax = k + nmi | |||
|
|
129 | do 15 j=1,jcmax | |||
|
|
130 | 15 dr(j) = t(i+j) - x | |||
|
|
131 | do 16 j=jcmax,km1 | |||
|
|
132 | aj(j+1) = 0. | |||
|
|
133 | 16 dr(j) = dr(jcmax) | |||
|
|
134 | go to 20 | |||
|
|
135 | 18 do 19 j=1,km1 | |||
|
|
136 | 19 dr(j) = t(i+j) - x | |||
|
|
137 | c | |||
|
|
138 | 20 do 21 jc=jcmin,jcmax | |||
|
|
139 | 21 aj(jc) = bcoef(imk + jc) | |||
|
|
140 | c | |||
|
|
141 | c *** difference the coefficients jderiv times. | |||
|
|
142 | if (jderiv .eq. 0) go to 30 | |||
|
|
143 | do 23 j=1,jderiv | |||
|
|
144 | kmj = k-j | |||
|
|
145 | fkmj = float(kmj) | |||
|
|
146 | ilo = kmj | |||
|
|
147 | do 23 jj=1,kmj | |||
|
|
148 | aj(jj) = ((aj(jj+1) - aj(jj))/(dl(ilo) + dr(jj)))*fkmj | |||
|
|
149 | 23 ilo = ilo - 1 | |||
|
|
150 | c | |||
|
|
151 | c *** compute value at x in (t(i),t(i+1)) of jderiv-th derivative, | |||
|
|
152 | c given its relevant b-spline coeffs in aj(1),...,aj(k-jderiv). | |||
|
|
153 | 30 if (jderiv .eq. km1) go to 39 | |||
|
|
154 | jdrvp1 = jderiv + 1 | |||
|
|
155 | do 33 j=jdrvp1,km1 | |||
|
|
156 | kmj = k-j | |||
|
|
157 | ilo = kmj | |||
|
|
158 | do 33 jj=1,kmj | |||
|
|
159 | aj(jj) = (aj(jj+1)*dl(ilo) + aj(jj)*dr(jj))/(dl(ilo)+dr(jj)) | |||
|
|
160 | 33 ilo = ilo - 1 | |||
|
|
161 | 39 bvalue = aj(1) | |||
|
|
162 | c | |||
|
|
163 | 99 return | |||
|
|
164 | end | |||
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| @@ -0,0 +1,101 | |||||
|
|
1 | *DECK CACAI | |||
|
|
2 | SUBROUTINE CACAI (Z, FNU, KODE, MR, N, Y, NZ, RL, TOL, ELIM, ALIM) | |||
|
|
3 | C***BEGIN PROLOGUE CACAI | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CAIRY | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CACAI-A, ZACAI-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CACAI APPLIES THE ANALYTIC CONTINUATION FORMULA | |||
|
|
12 | C | |||
|
|
13 | C K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN) | |||
|
|
14 | C MP=PI*MR*CMPLX(0.0,1.0) | |||
|
|
15 | C | |||
|
|
16 | C TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT | |||
|
|
17 | C HALF Z PLANE FOR USE WITH CAIRY WHERE FNU=1/3 OR 2/3 AND N=1. | |||
|
|
18 | C CACAI IS THE SAME AS CACON WITH THE PARTS FOR LARGER ORDERS AND | |||
|
|
19 | C RECURRENCE REMOVED. A RECURSIVE CALL TO CACON CAN RESULT IF CACON | |||
|
|
20 | C IS CALLED FROM CAIRY. | |||
|
|
21 | C | |||
|
|
22 | C***SEE ALSO CAIRY | |||
|
|
23 | C***ROUTINES CALLED CASYI, CBKNU, CMLRI, CS1S2, CSERI, R1MACH | |||
|
|
24 | C***REVISION HISTORY (YYMMDD) | |||
|
|
25 | C 830501 DATE WRITTEN | |||
|
|
26 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
27 | C***END PROLOGUE CACAI | |||
|
|
28 | COMPLEX CSGN, CSPN, C1, C2, Y, Z, ZN, CY | |||
|
|
29 | REAL ALIM, ARG, ASCLE, AZ, CPN, DFNU, ELIM, FMR, FNU, PI, RL, | |||
|
|
30 | * SGN, SPN, TOL, YY, R1MACH | |||
|
|
31 | INTEGER INU, IUF, KODE, MR, N, NN, NW, NZ | |||
|
|
32 | DIMENSION Y(N), CY(2) | |||
|
|
33 | DATA PI / 3.14159265358979324E0 / | |||
|
|
34 | C***FIRST EXECUTABLE STATEMENT CACAI | |||
|
|
35 | NZ = 0 | |||
|
|
36 | ZN = -Z | |||
|
|
37 | AZ = ABS(Z) | |||
|
|
38 | NN = N | |||
|
|
39 | DFNU = FNU + (N-1) | |||
|
|
40 | IF (AZ.LE.2.0E0) GO TO 10 | |||
|
|
41 | IF (AZ*AZ*0.25E0.GT.DFNU+1.0E0) GO TO 20 | |||
|
|
42 | 10 CONTINUE | |||
|
|
43 | C----------------------------------------------------------------------- | |||
|
|
44 | C POWER SERIES FOR THE I FUNCTION | |||
|
|
45 | C----------------------------------------------------------------------- | |||
|
|
46 | CALL CSERI(ZN, FNU, KODE, NN, Y, NW, TOL, ELIM, ALIM) | |||
|
|
47 | GO TO 40 | |||
|
|
48 | 20 CONTINUE | |||
|
|
49 | IF (AZ.LT.RL) GO TO 30 | |||
|
|
50 | C----------------------------------------------------------------------- | |||
|
|
51 | C ASYMPTOTIC EXPANSION FOR LARGE Z FOR THE I FUNCTION | |||
|
|
52 | C----------------------------------------------------------------------- | |||
|
|
53 | CALL CASYI(ZN, FNU, KODE, NN, Y, NW, RL, TOL, ELIM, ALIM) | |||
|
|
54 | IF (NW.LT.0) GO TO 70 | |||
|
|
55 | GO TO 40 | |||
|
|
56 | 30 CONTINUE | |||
|
|
57 | C----------------------------------------------------------------------- | |||
|
|
58 | C MILLER ALGORITHM NORMALIZED BY THE SERIES FOR THE I FUNCTION | |||
|
|
59 | C----------------------------------------------------------------------- | |||
|
|
60 | CALL CMLRI(ZN, FNU, KODE, NN, Y, NW, TOL) | |||
|
|
61 | IF(NW.LT.0) GO TO 70 | |||
|
|
62 | 40 CONTINUE | |||
|
|
63 | C----------------------------------------------------------------------- | |||
|
|
64 | C ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION | |||
|
|
65 | C----------------------------------------------------------------------- | |||
|
|
66 | CALL CBKNU(ZN, FNU, KODE, 1, CY, NW, TOL, ELIM, ALIM) | |||
|
|
67 | IF (NW.NE.0) GO TO 70 | |||
|
|
68 | FMR = MR | |||
|
|
69 | SGN = -SIGN(PI,FMR) | |||
|
|
70 | CSGN = CMPLX(0.0E0,SGN) | |||
|
|
71 | IF (KODE.EQ.1) GO TO 50 | |||
|
|
72 | YY = -AIMAG(ZN) | |||
|
|
73 | CPN = COS(YY) | |||
|
|
74 | SPN = SIN(YY) | |||
|
|
75 | CSGN = CSGN*CMPLX(CPN,SPN) | |||
|
|
76 | 50 CONTINUE | |||
|
|
77 | C----------------------------------------------------------------------- | |||
|
|
78 | C CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE | |||
|
|
79 | C WHEN FNU IS LARGE | |||
|
|
80 | C----------------------------------------------------------------------- | |||
|
|
81 | INU = FNU | |||
|
|
82 | ARG = (FNU-INU)*SGN | |||
|
|
83 | CPN = COS(ARG) | |||
|
|
84 | SPN = SIN(ARG) | |||
|
|
85 | CSPN = CMPLX(CPN,SPN) | |||
|
|
86 | IF (MOD(INU,2).EQ.1) CSPN = -CSPN | |||
|
|
87 | C1 = CY(1) | |||
|
|
88 | C2 = Y(1) | |||
|
|
89 | IF (KODE.EQ.1) GO TO 60 | |||
|
|
90 | IUF = 0 | |||
|
|
91 | ASCLE = 1.0E+3*R1MACH(1)/TOL | |||
|
|
92 | CALL CS1S2(ZN, C1, C2, NW, ASCLE, ALIM, IUF) | |||
|
|
93 | NZ = NZ + NW | |||
|
|
94 | 60 CONTINUE | |||
|
|
95 | Y(1) = CSPN*C1 + CSGN*C2 | |||
|
|
96 | RETURN | |||
|
|
97 | 70 CONTINUE | |||
|
|
98 | NZ = -1 | |||
|
|
99 | IF(NW.EQ.(-2)) NZ=-2 | |||
|
|
100 | RETURN | |||
|
|
101 | END | |||
| @@ -0,0 +1,342 | |||||
|
|
1 | *DECK CAIRY | |||
|
|
2 | SUBROUTINE CAIRY (Z, ID, KODE, AI, NZ, IERR) | |||
|
|
3 | C***BEGIN PROLOGUE CAIRY | |||
|
|
4 | C***PURPOSE Compute the Airy function Ai(z) or its derivative dAi/dz | |||
|
|
5 | C for complex argument z. A scaling option is available | |||
|
|
6 | C to help avoid underflow and overflow. | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***CATEGORY C10D | |||
|
|
9 | C***TYPE COMPLEX (CAIRY-C, ZAIRY-C) | |||
|
|
10 | C***KEYWORDS AIRY FUNCTION, BESSEL FUNCTION OF ORDER ONE THIRD, | |||
|
|
11 | C BESSEL FUNCTION OF ORDER TWO THIRDS | |||
|
|
12 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
13 | C***DESCRIPTION | |||
|
|
14 | C | |||
|
|
15 | C On KODE=1, CAIRY computes the complex Airy function Ai(z) | |||
|
|
16 | C or its derivative dAi/dz on ID=0 or ID=1 respectively. On | |||
|
|
17 | C KODE=2, a scaling option exp(zeta)*Ai(z) or exp(zeta)*dAi/dz | |||
|
|
18 | C is provided to remove the exponential decay in -pi/3<arg(z) | |||
|
|
19 | C <pi/3 and the exponential growth in pi/3<abs(arg(z))<pi where | |||
|
|
20 | C zeta=(2/3)*z**(3/2). | |||
|
|
21 | C | |||
|
|
22 | C While the Airy functions Ai(z) and dAi/dz are analytic in | |||
|
|
23 | C the whole z-plane, the corresponding scaled functions defined | |||
|
|
24 | C for KODE=2 have a cut along the negative real axis. | |||
|
|
25 | C | |||
|
|
26 | C Input | |||
|
|
27 | C Z - Argument of type COMPLEX | |||
|
|
28 | C ID - Order of derivative, ID=0 or ID=1 | |||
|
|
29 | C KODE - A parameter to indicate the scaling option | |||
|
|
30 | C KODE=1 returns | |||
|
|
31 | C AI=Ai(z) on ID=0 | |||
|
|
32 | C AI=dAi/dz on ID=1 | |||
|
|
33 | C at z=Z | |||
|
|
34 | C =2 returns | |||
|
|
35 | C AI=exp(zeta)*Ai(z) on ID=0 | |||
|
|
36 | C AI=exp(zeta)*dAi/dz on ID=1 | |||
|
|
37 | C at z=Z where zeta=(2/3)*z**(3/2) | |||
|
|
38 | C | |||
|
|
39 | C Output | |||
|
|
40 | C AI - Result of type COMPLEX | |||
|
|
41 | C NZ - Underflow indicator | |||
|
|
42 | C NZ=0 Normal return | |||
|
|
43 | C NZ=1 AI=0 due to underflow in | |||
|
|
44 | C -pi/3<arg(Z)<pi/3 on KODE=1 | |||
|
|
45 | C IERR - Error flag | |||
|
|
46 | C IERR=0 Normal return - COMPUTATION COMPLETED | |||
|
|
47 | C IERR=1 Input error - NO COMPUTATION | |||
|
|
48 | C IERR=2 Overflow - NO COMPUTATION | |||
|
|
49 | C (Re(Z) too large with KODE=1) | |||
|
|
50 | C IERR=3 Precision warning - COMPUTATION COMPLETED | |||
|
|
51 | C (Result has less than half precision) | |||
|
|
52 | C IERR=4 Precision error - NO COMPUTATION | |||
|
|
53 | C (Result has no precision) | |||
|
|
54 | C IERR=5 Algorithmic error - NO COMPUTATION | |||
|
|
55 | C (Termination condition not met) | |||
|
|
56 | C | |||
|
|
57 | C *Long Description: | |||
|
|
58 | C | |||
|
|
59 | C Ai(z) and dAi/dz are computed from K Bessel functions by | |||
|
|
60 | C | |||
|
|
61 | C Ai(z) = c*sqrt(z)*K(1/3,zeta) | |||
|
|
62 | C dAi/dz = -c* z *K(2/3,zeta) | |||
|
|
63 | C c = 1/(pi*sqrt(3)) | |||
|
|
64 | C zeta = (2/3)*z**(3/2) | |||
|
|
65 | C | |||
|
|
66 | C when abs(z)>1 and from power series when abs(z)<=1. | |||
|
|
67 | C | |||
|
|
68 | C In most complex variable computation, one must evaluate ele- | |||
|
|
69 | C mentary functions. When the magnitude of Z is large, losses | |||
|
|
70 | C of significance by argument reduction occur. Consequently, if | |||
|
|
71 | C the magnitude of ZETA=(2/3)*Z**(3/2) exceeds U1=SQRT(0.5/UR), | |||
|
|
72 | C then losses exceeding half precision are likely and an error | |||
|
|
73 | C flag IERR=3 is triggered where UR=R1MACH(4)=UNIT ROUNDOFF. | |||
|
|
74 | C Also, if the magnitude of ZETA is larger than U2=0.5/UR, then | |||
|
|
75 | C all significance is lost and IERR=4. In order to use the INT | |||
|
|
76 | C function, ZETA must be further restricted not to exceed | |||
|
|
77 | C U3=I1MACH(9)=LARGEST INTEGER. Thus, the magnitude of ZETA | |||
|
|
78 | C must be restricted by MIN(U2,U3). In IEEE arithmetic, U1,U2, | |||
|
|
79 | C and U3 are approximately 2.0E+3, 4.2E+6, 2.1E+9 in single | |||
|
|
80 | C precision and 4.7E+7, 2.3E+15, 2.1E+9 in double precision. | |||
|
|
81 | C This makes U2 limiting is single precision and U3 limiting | |||
|
|
82 | C in double precision. This means that the magnitude of Z | |||
|
|
83 | C cannot exceed approximately 3.4E+4 in single precision and | |||
|
|
84 | C 2.1E+6 in double precision. This also means that one can | |||
|
|
85 | C expect to retain, in the worst cases on 32-bit machines, | |||
|
|
86 | C no digits in single precision and only 6 digits in double | |||
|
|
87 | C precision. | |||
|
|
88 | C | |||
|
|
89 | C The approximate relative error in the magnitude of a complex | |||
|
|
90 | C Bessel function can be expressed as P*10**S where P=MAX(UNIT | |||
|
|
91 | C ROUNDOFF,1.0E-18) is the nominal precision and 10**S repre- | |||
|
|
92 | C sents the increase in error due to argument reduction in the | |||
|
|
93 | C elementary functions. Here, S=MAX(1,ABS(LOG10(ABS(Z))), | |||
|
|
94 | C ABS(LOG10(FNU))) approximately (i.e., S=MAX(1,ABS(EXPONENT OF | |||
|
|
95 | C ABS(Z),ABS(EXPONENT OF FNU)) ). However, the phase angle may | |||
|
|
96 | C have only absolute accuracy. This is most likely to occur | |||
|
|
97 | C when one component (in magnitude) is larger than the other by | |||
|
|
98 | C several orders of magnitude. If one component is 10**K larger | |||
|
|
99 | C than the other, then one can expect only MAX(ABS(LOG10(P))-K, | |||
|
|
100 | C 0) significant digits; or, stated another way, when K exceeds | |||
|
|
101 | C the exponent of P, no significant digits remain in the smaller | |||
|
|
102 | C component. However, the phase angle retains absolute accuracy | |||
|
|
103 | C because, in complex arithmetic with precision P, the smaller | |||
|
|
104 | C component will not (as a rule) decrease below P times the | |||
|
|
105 | C magnitude of the larger component. In these extreme cases, | |||
|
|
106 | C the principal phase angle is on the order of +P, -P, PI/2-P, | |||
|
|
107 | C or -PI/2+P. | |||
|
|
108 | C | |||
|
|
109 | C***REFERENCES 1. M. Abramowitz and I. A. Stegun, Handbook of Mathe- | |||
|
|
110 | C matical Functions, National Bureau of Standards | |||
|
|
111 | C Applied Mathematics Series 55, U. S. Department | |||
|
|
112 | C of Commerce, Tenth Printing (1972) or later. | |||
|
|
113 | C 2. D. E. Amos, Computation of Bessel Functions of | |||
|
|
114 | C Complex Argument and Large Order, Report SAND83-0643, | |||
|
|
115 | C Sandia National Laboratories, Albuquerque, NM, May | |||
|
|
116 | C 1983. | |||
|
|
117 | C 3. D. E. Amos, A Subroutine Package for Bessel Functions | |||
|
|
118 | C of a Complex Argument and Nonnegative Order, Report | |||
|
|
119 | C SAND85-1018, Sandia National Laboratory, Albuquerque, | |||
|
|
120 | C NM, May 1985. | |||
|
|
121 | C 4. D. E. Amos, A portable package for Bessel functions | |||
|
|
122 | C of a complex argument and nonnegative order, ACM | |||
|
|
123 | C Transactions on Mathematical Software, 12 (September | |||
|
|
124 | C 1986), pp. 265-273. | |||
|
|
125 | C | |||
|
|
126 | C***ROUTINES CALLED CACAI, CBKNU, I1MACH, R1MACH | |||
|
|
127 | C***REVISION HISTORY (YYMMDD) | |||
|
|
128 | C 830501 DATE WRITTEN | |||
|
|
129 | C 890801 REVISION DATE from Version 3.2 | |||
|
|
130 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
131 | C 920128 Category corrected. (WRB) | |||
|
|
132 | C 920811 Prologue revised. (DWL) | |||
|
|
133 | C***END PROLOGUE CAIRY | |||
|
|
134 | COMPLEX AI, CONE, CSQ, CY, S1, S2, TRM1, TRM2, Z, ZTA, Z3 | |||
|
|
135 | REAL AA, AD, AK, ALIM, ATRM, AZ, AZ3, BK, CK, COEF, C1, C2, DIG, | |||
|
|
136 | * DK, D1, D2, ELIM, FID, FNU, RL, R1M5, SFAC, TOL, TTH, ZI, ZR, | |||
|
|
137 | * Z3I, Z3R, R1MACH, BB, ALAZ | |||
|
|
138 | INTEGER ID, IERR, IFLAG, K, KODE, K1, K2, MR, NN, NZ, I1MACH | |||
|
|
139 | DIMENSION CY(1) | |||
|
|
140 | DATA TTH, C1, C2, COEF /6.66666666666666667E-01, | |||
|
|
141 | * 3.55028053887817240E-01,2.58819403792806799E-01, | |||
|
|
142 | * 1.83776298473930683E-01/ | |||
|
|
143 | DATA CONE / (1.0E0,0.0E0) / | |||
|
|
144 | C***FIRST EXECUTABLE STATEMENT CAIRY | |||
|
|
145 | IERR = 0 | |||
|
|
146 | NZ=0 | |||
|
|
147 | IF (ID.LT.0 .OR. ID.GT.1) IERR=1 | |||
|
|
148 | IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 | |||
|
|
149 | IF (IERR.NE.0) RETURN | |||
|
|
150 | AZ = ABS(Z) | |||
|
|
151 | TOL = MAX(R1MACH(4),1.0E-18) | |||
|
|
152 | FID = ID | |||
|
|
153 | IF (AZ.GT.1.0E0) GO TO 60 | |||
|
|
154 | C----------------------------------------------------------------------- | |||
|
|
155 | C POWER SERIES FOR ABS(Z).LE.1. | |||
|
|
156 | C----------------------------------------------------------------------- | |||
|
|
157 | S1 = CONE | |||
|
|
158 | S2 = CONE | |||
|
|
159 | IF (AZ.LT.TOL) GO TO 160 | |||
|
|
160 | AA = AZ*AZ | |||
|
|
161 | IF (AA.LT.TOL/AZ) GO TO 40 | |||
|
|
162 | TRM1 = CONE | |||
|
|
163 | TRM2 = CONE | |||
|
|
164 | ATRM = 1.0E0 | |||
|
|
165 | Z3 = Z*Z*Z | |||
|
|
166 | AZ3 = AZ*AA | |||
|
|
167 | AK = 2.0E0 + FID | |||
|
|
168 | BK = 3.0E0 - FID - FID | |||
|
|
169 | CK = 4.0E0 - FID | |||
|
|
170 | DK = 3.0E0 + FID + FID | |||
|
|
171 | D1 = AK*DK | |||
|
|
172 | D2 = BK*CK | |||
|
|
173 | AD = MIN(D1,D2) | |||
|
|
174 | AK = 24.0E0 + 9.0E0*FID | |||
|
|
175 | BK = 30.0E0 - 9.0E0*FID | |||
|
|
176 | Z3R = REAL(Z3) | |||
|
|
177 | Z3I = AIMAG(Z3) | |||
|
|
178 | DO 30 K=1,25 | |||
|
|
179 | TRM1 = TRM1*CMPLX(Z3R/D1,Z3I/D1) | |||
|
|
180 | S1 = S1 + TRM1 | |||
|
|
181 | TRM2 = TRM2*CMPLX(Z3R/D2,Z3I/D2) | |||
|
|
182 | S2 = S2 + TRM2 | |||
|
|
183 | ATRM = ATRM*AZ3/AD | |||
|
|
184 | D1 = D1 + AK | |||
|
|
185 | D2 = D2 + BK | |||
|
|
186 | AD = MIN(D1,D2) | |||
|
|
187 | IF (ATRM.LT.TOL*AD) GO TO 40 | |||
|
|
188 | AK = AK + 18.0E0 | |||
|
|
189 | BK = BK + 18.0E0 | |||
|
|
190 | 30 CONTINUE | |||
|
|
191 | 40 CONTINUE | |||
|
|
192 | IF (ID.EQ.1) GO TO 50 | |||
|
|
193 | AI = S1*CMPLX(C1,0.0E0) - Z*S2*CMPLX(C2,0.0E0) | |||
|
|
194 | IF (KODE.EQ.1) RETURN | |||
|
|
195 | ZTA = Z*CSQRT(Z)*CMPLX(TTH,0.0E0) | |||
|
|
196 | AI = AI*CEXP(ZTA) | |||
|
|
197 | RETURN | |||
|
|
198 | 50 CONTINUE | |||
|
|
199 | AI = -S2*CMPLX(C2,0.0E0) | |||
|
|
200 | IF (AZ.GT.TOL) AI = AI + Z*Z*S1*CMPLX(C1/(1.0E0+FID),0.0E0) | |||
|
|
201 | IF (KODE.EQ.1) RETURN | |||
|
|
202 | ZTA = Z*CSQRT(Z)*CMPLX(TTH,0.0E0) | |||
|
|
203 | AI = AI*CEXP(ZTA) | |||
|
|
204 | RETURN | |||
|
|
205 | C----------------------------------------------------------------------- | |||
|
|
206 | C CASE FOR ABS(Z).GT.1.0 | |||
|
|
207 | C----------------------------------------------------------------------- | |||
|
|
208 | 60 CONTINUE | |||
|
|
209 | FNU = (1.0E0+FID)/3.0E0 | |||
|
|
210 | C----------------------------------------------------------------------- | |||
|
|
211 | C SET PARAMETERS RELATED TO MACHINE CONSTANTS. | |||
|
|
212 | C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. | |||
|
|
213 | C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. | |||
|
|
214 | C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND | |||
|
|
215 | C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR | |||
|
|
216 | C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. | |||
|
|
217 | C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. | |||
|
|
218 | C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). | |||
|
|
219 | C----------------------------------------------------------------------- | |||
|
|
220 | K1 = I1MACH(12) | |||
|
|
221 | K2 = I1MACH(13) | |||
|
|
222 | R1M5 = R1MACH(5) | |||
|
|
223 | K = MIN(ABS(K1),ABS(K2)) | |||
|
|
224 | ELIM = 2.303E0*(K*R1M5-3.0E0) | |||
|
|
225 | K1 = I1MACH(11) - 1 | |||
|
|
226 | AA = R1M5*K1 | |||
|
|
227 | DIG = MIN(AA,18.0E0) | |||
|
|
228 | AA = AA*2.303E0 | |||
|
|
229 | ALIM = ELIM + MAX(-AA,-41.45E0) | |||
|
|
230 | RL = 1.2E0*DIG + 3.0E0 | |||
|
|
231 | ALAZ=ALOG(AZ) | |||
|
|
232 | C----------------------------------------------------------------------- | |||
|
|
233 | C TEST FOR RANGE | |||
|
|
234 | C----------------------------------------------------------------------- | |||
|
|
235 | AA=0.5E0/TOL | |||
|
|
236 | BB=I1MACH(9)*0.5E0 | |||
|
|
237 | AA=MIN(AA,BB) | |||
|
|
238 | AA=AA**TTH | |||
|
|
239 | IF (AZ.GT.AA) GO TO 260 | |||
|
|
240 | AA=SQRT(AA) | |||
|
|
241 | IF (AZ.GT.AA) IERR=3 | |||
|
|
242 | CSQ=CSQRT(Z) | |||
|
|
243 | ZTA=Z*CSQ*CMPLX(TTH,0.0E0) | |||
|
|
244 | C----------------------------------------------------------------------- | |||
|
|
245 | C RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL | |||
|
|
246 | C----------------------------------------------------------------------- | |||
|
|
247 | IFLAG = 0 | |||
|
|
248 | SFAC = 1.0E0 | |||
|
|
249 | ZI = AIMAG(Z) | |||
|
|
250 | ZR = REAL(Z) | |||
|
|
251 | AK = AIMAG(ZTA) | |||
|
|
252 | IF (ZR.GE.0.0E0) GO TO 70 | |||
|
|
253 | BK = REAL(ZTA) | |||
|
|
254 | CK = -ABS(BK) | |||
|
|
255 | ZTA = CMPLX(CK,AK) | |||
|
|
256 | 70 CONTINUE | |||
|
|
257 | IF (ZI.NE.0.0E0) GO TO 80 | |||
|
|
258 | IF (ZR.GT.0.0E0) GO TO 80 | |||
|
|
259 | ZTA = CMPLX(0.0E0,AK) | |||
|
|
260 | 80 CONTINUE | |||
|
|
261 | AA = REAL(ZTA) | |||
|
|
262 | IF (AA.GE.0.0E0 .AND. ZR.GT.0.0E0) GO TO 100 | |||
|
|
263 | IF (KODE.EQ.2) GO TO 90 | |||
|
|
264 | C----------------------------------------------------------------------- | |||
|
|
265 | C OVERFLOW TEST | |||
|
|
266 | C----------------------------------------------------------------------- | |||
|
|
267 | IF (AA.GT.(-ALIM)) GO TO 90 | |||
|
|
268 | AA = -AA + 0.25E0*ALAZ | |||
|
|
269 | IFLAG = 1 | |||
|
|
270 | SFAC = TOL | |||
|
|
271 | IF (AA.GT.ELIM) GO TO 240 | |||
|
|
272 | 90 CONTINUE | |||
|
|
273 | C----------------------------------------------------------------------- | |||
|
|
274 | C CBKNU AND CACAI RETURN EXP(ZTA)*K(FNU,ZTA) ON KODE=2 | |||
|
|
275 | C----------------------------------------------------------------------- | |||
|
|
276 | MR = 1 | |||
|
|
277 | IF (ZI.LT.0.0E0) MR = -1 | |||
|
|
278 | CALL CACAI(ZTA, FNU, KODE, MR, 1, CY, NN, RL, TOL, ELIM, ALIM) | |||
|
|
279 | IF (NN.LT.0) GO TO 250 | |||
|
|
280 | NZ = NZ + NN | |||
|
|
281 | GO TO 120 | |||
|
|
282 | 100 CONTINUE | |||
|
|
283 | IF (KODE.EQ.2) GO TO 110 | |||
|
|
284 | C----------------------------------------------------------------------- | |||
|
|
285 | C UNDERFLOW TEST | |||
|
|
286 | C----------------------------------------------------------------------- | |||
|
|
287 | IF (AA.LT.ALIM) GO TO 110 | |||
|
|
288 | AA = -AA - 0.25E0*ALAZ | |||
|
|
289 | IFLAG = 2 | |||
|
|
290 | SFAC = 1.0E0/TOL | |||
|
|
291 | IF (AA.LT.(-ELIM)) GO TO 180 | |||
|
|
292 | 110 CONTINUE | |||
|
|
293 | CALL CBKNU(ZTA, FNU, KODE, 1, CY, NZ, TOL, ELIM, ALIM) | |||
|
|
294 | 120 CONTINUE | |||
|
|
295 | S1 = CY(1)*CMPLX(COEF,0.0E0) | |||
|
|
296 | IF (IFLAG.NE.0) GO TO 140 | |||
|
|
297 | IF (ID.EQ.1) GO TO 130 | |||
|
|
298 | AI = CSQ*S1 | |||
|
|
299 | RETURN | |||
|
|
300 | 130 AI = -Z*S1 | |||
|
|
301 | RETURN | |||
|
|
302 | 140 CONTINUE | |||
|
|
303 | S1 = S1*CMPLX(SFAC,0.0E0) | |||
|
|
304 | IF (ID.EQ.1) GO TO 150 | |||
|
|
305 | S1 = S1*CSQ | |||
|
|
306 | AI = S1*CMPLX(1.0E0/SFAC,0.0E0) | |||
|
|
307 | RETURN | |||
|
|
308 | 150 CONTINUE | |||
|
|
309 | S1 = -S1*Z | |||
|
|
310 | AI = S1*CMPLX(1.0E0/SFAC,0.0E0) | |||
|
|
311 | RETURN | |||
|
|
312 | 160 CONTINUE | |||
|
|
313 | AA = 1.0E+3*R1MACH(1) | |||
|
|
314 | S1 = CMPLX(0.0E0,0.0E0) | |||
|
|
315 | IF (ID.EQ.1) GO TO 170 | |||
|
|
316 | IF (AZ.GT.AA) S1 = CMPLX(C2,0.0E0)*Z | |||
|
|
317 | AI = CMPLX(C1,0.0E0) - S1 | |||
|
|
318 | RETURN | |||
|
|
319 | 170 CONTINUE | |||
|
|
320 | AI = -CMPLX(C2,0.0E0) | |||
|
|
321 | AA = SQRT(AA) | |||
|
|
322 | IF (AZ.GT.AA) S1 = Z*Z*CMPLX(0.5E0,0.0E0) | |||
|
|
323 | AI = AI + S1*CMPLX(C1,0.0E0) | |||
|
|
324 | RETURN | |||
|
|
325 | 180 CONTINUE | |||
|
|
326 | NZ = 1 | |||
|
|
327 | AI = CMPLX(0.0E0,0.0E0) | |||
|
|
328 | RETURN | |||
|
|
329 | 240 CONTINUE | |||
|
|
330 | NZ = 0 | |||
|
|
331 | IERR=2 | |||
|
|
332 | RETURN | |||
|
|
333 | 250 CONTINUE | |||
|
|
334 | IF(NN.EQ.(-1)) GO TO 240 | |||
|
|
335 | NZ=0 | |||
|
|
336 | IERR=5 | |||
|
|
337 | RETURN | |||
|
|
338 | 260 CONTINUE | |||
|
|
339 | IERR=4 | |||
|
|
340 | NZ=0 | |||
|
|
341 | RETURN | |||
|
|
342 | END | |||
| @@ -0,0 +1,136 | |||||
|
|
1 | *DECK CASYI | |||
|
|
2 | SUBROUTINE CASYI (Z, FNU, KODE, N, Y, NZ, RL, TOL, ELIM, ALIM) | |||
|
|
3 | C***BEGIN PROLOGUE CASYI | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CASYI-A, ZASYI-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CASYI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY | |||
|
|
12 | C MEANS OF THE ASYMPTOTIC EXPANSION FOR LARGE ABS(Z) IN THE | |||
|
|
13 | C REGION ABS(Z).GT.MAX(RL,FNU*FNU/2). NZ=0 IS A NORMAL RETURN. | |||
|
|
14 | C NZ.LT.0 INDICATES AN OVERFLOW ON KODE=1. | |||
|
|
15 | C | |||
|
|
16 | C***SEE ALSO CBESI, CBESK | |||
|
|
17 | C***ROUTINES CALLED R1MACH | |||
|
|
18 | C***REVISION HISTORY (YYMMDD) | |||
|
|
19 | C 830501 DATE WRITTEN | |||
|
|
20 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
21 | C***END PROLOGUE CASYI | |||
|
|
22 | COMPLEX AK1, CK, CONE, CS1, CS2, CZ, CZERO, DK, EZ, P1, RZ, S2, | |||
|
|
23 | * Y, Z | |||
|
|
24 | REAL AA, ACZ, AEZ, AK, ALIM, ARG, ARM, ATOL, AZ, BB, BK, DFNU, | |||
|
|
25 | * DNU2, ELIM, FDN, FNU, PI, RL, RTPI, RTR1, S, SGN, SQK, TOL, X, | |||
|
|
26 | * YY, R1MACH | |||
|
|
27 | INTEGER I, IB, IL, INU, J, JL, K, KODE, KODED, M, N, NN, NZ | |||
|
|
28 | DIMENSION Y(N) | |||
|
|
29 | DATA PI, RTPI /3.14159265358979324E0 , 0.159154943091895336E0 / | |||
|
|
30 | DATA CZERO, CONE / (0.0E0,0.0E0), (1.0E0,0.0E0) / | |||
|
|
31 | C***FIRST EXECUTABLE STATEMENT CASYI | |||
|
|
32 | NZ = 0 | |||
|
|
33 | AZ = ABS(Z) | |||
|
|
34 | X = REAL(Z) | |||
|
|
35 | ARM = 1.0E+3*R1MACH(1) | |||
|
|
36 | RTR1 = SQRT(ARM) | |||
|
|
37 | IL = MIN(2,N) | |||
|
|
38 | DFNU = FNU + (N-IL) | |||
|
|
39 | C----------------------------------------------------------------------- | |||
|
|
40 | C OVERFLOW TEST | |||
|
|
41 | C----------------------------------------------------------------------- | |||
|
|
42 | AK1 = CMPLX(RTPI,0.0E0)/Z | |||
|
|
43 | AK1 = CSQRT(AK1) | |||
|
|
44 | CZ = Z | |||
|
|
45 | IF (KODE.EQ.2) CZ = Z - CMPLX(X,0.0E0) | |||
|
|
46 | ACZ = REAL(CZ) | |||
|
|
47 | IF (ABS(ACZ).GT.ELIM) GO TO 80 | |||
|
|
48 | DNU2 = DFNU + DFNU | |||
|
|
49 | KODED = 1 | |||
|
|
50 | IF ((ABS(ACZ).GT.ALIM) .AND. (N.GT.2)) GO TO 10 | |||
|
|
51 | KODED = 0 | |||
|
|
52 | AK1 = AK1*CEXP(CZ) | |||
|
|
53 | 10 CONTINUE | |||
|
|
54 | FDN = 0.0E0 | |||
|
|
55 | IF (DNU2.GT.RTR1) FDN = DNU2*DNU2 | |||
|
|
56 | EZ = Z*CMPLX(8.0E0,0.0E0) | |||
|
|
57 | C----------------------------------------------------------------------- | |||
|
|
58 | C WHEN Z IS IMAGINARY, THE ERROR TEST MUST BE MADE RELATIVE TO THE | |||
|
|
59 | C FIRST RECIPROCAL POWER SINCE THIS IS THE LEADING TERM OF THE | |||
|
|
60 | C EXPANSION FOR THE IMAGINARY PART. | |||
|
|
61 | C----------------------------------------------------------------------- | |||
|
|
62 | AEZ = 8.0E0*AZ | |||
|
|
63 | S = TOL/AEZ | |||
|
|
64 | JL = RL+RL + 2 | |||
|
|
65 | YY = AIMAG(Z) | |||
|
|
66 | P1 = CZERO | |||
|
|
67 | IF (YY.EQ.0.0E0) GO TO 20 | |||
|
|
68 | C----------------------------------------------------------------------- | |||
|
|
69 | C CALCULATE EXP(PI*(0.5+FNU+N-IL)*I) TO MINIMIZE LOSSES OF | |||
|
|
70 | C SIGNIFICANCE WHEN FNU OR N IS LARGE | |||
|
|
71 | C----------------------------------------------------------------------- | |||
|
|
72 | INU = FNU | |||
|
|
73 | ARG = (FNU-INU)*PI | |||
|
|
74 | INU = INU + N - IL | |||
|
|
75 | AK = -SIN(ARG) | |||
|
|
76 | BK = COS(ARG) | |||
|
|
77 | IF (YY.LT.0.0E0) BK = -BK | |||
|
|
78 | P1 = CMPLX(AK,BK) | |||
|
|
79 | IF (MOD(INU,2).EQ.1) P1 = -P1 | |||
|
|
80 | 20 CONTINUE | |||
|
|
81 | DO 50 K=1,IL | |||
|
|
82 | SQK = FDN - 1.0E0 | |||
|
|
83 | ATOL = S*ABS(SQK) | |||
|
|
84 | SGN = 1.0E0 | |||
|
|
85 | CS1 = CONE | |||
|
|
86 | CS2 = CONE | |||
|
|
87 | CK = CONE | |||
|
|
88 | AK = 0.0E0 | |||
|
|
89 | AA = 1.0E0 | |||
|
|
90 | BB = AEZ | |||
|
|
91 | DK = EZ | |||
|
|
92 | DO 30 J=1,JL | |||
|
|
93 | CK = CK*CMPLX(SQK,0.0E0)/DK | |||
|
|
94 | CS2 = CS2 + CK | |||
|
|
95 | SGN = -SGN | |||
|
|
96 | CS1 = CS1 + CK*CMPLX(SGN,0.0E0) | |||
|
|
97 | DK = DK + EZ | |||
|
|
98 | AA = AA*ABS(SQK)/BB | |||
|
|
99 | BB = BB + AEZ | |||
|
|
100 | AK = AK + 8.0E0 | |||
|
|
101 | SQK = SQK - AK | |||
|
|
102 | IF (AA.LE.ATOL) GO TO 40 | |||
|
|
103 | 30 CONTINUE | |||
|
|
104 | GO TO 90 | |||
|
|
105 | 40 CONTINUE | |||
|
|
106 | S2 = CS1 | |||
|
|
107 | IF (X+X.LT.ELIM) S2 = S2 + P1*CS2*CEXP(-Z-Z) | |||
|
|
108 | FDN = FDN + 8.0E0*DFNU + 4.0E0 | |||
|
|
109 | P1 = -P1 | |||
|
|
110 | M = N - IL + K | |||
|
|
111 | Y(M) = S2*AK1 | |||
|
|
112 | 50 CONTINUE | |||
|
|
113 | IF (N.LE.2) RETURN | |||
|
|
114 | NN = N | |||
|
|
115 | K = NN - 2 | |||
|
|
116 | AK = K | |||
|
|
117 | RZ = (CONE+CONE)/Z | |||
|
|
118 | IB = 3 | |||
|
|
119 | DO 60 I=IB,NN | |||
|
|
120 | Y(K) = CMPLX(AK+FNU,0.0E0)*RZ*Y(K+1) + Y(K+2) | |||
|
|
121 | AK = AK - 1.0E0 | |||
|
|
122 | K = K - 1 | |||
|
|
123 | 60 CONTINUE | |||
|
|
124 | IF (KODED.EQ.0) RETURN | |||
|
|
125 | CK = CEXP(CZ) | |||
|
|
126 | DO 70 I=1,NN | |||
|
|
127 | Y(I) = Y(I)*CK | |||
|
|
128 | 70 CONTINUE | |||
|
|
129 | RETURN | |||
|
|
130 | 80 CONTINUE | |||
|
|
131 | NZ = -1 | |||
|
|
132 | RETURN | |||
|
|
133 | 90 CONTINUE | |||
|
|
134 | NZ=-2 | |||
|
|
135 | RETURN | |||
|
|
136 | END | |||
| @@ -0,0 +1,139 | |||||
|
|
1 | *> \brief \b CAXPY | |||
|
|
2 | * | |||
|
|
3 | * =========== DOCUMENTATION =========== | |||
|
|
4 | * | |||
|
|
5 | * Online html documentation available at | |||
|
|
6 | * http://www.netlib.org/lapack/explore-html/ | |||
|
|
7 | * | |||
|
|
8 | * Definition: | |||
|
|
9 | * =========== | |||
|
|
10 | * | |||
|
|
11 | * SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY) | |||
|
|
12 | * | |||
|
|
13 | * .. Scalar Arguments .. | |||
|
|
14 | * COMPLEX CA | |||
|
|
15 | * INTEGER INCX,INCY,N | |||
|
|
16 | * .. | |||
|
|
17 | * .. Array Arguments .. | |||
|
|
18 | * COMPLEX CX(*),CY(*) | |||
|
|
19 | * .. | |||
|
|
20 | * | |||
|
|
21 | * | |||
|
|
22 | *> \par Purpose: | |||
|
|
23 | * ============= | |||
|
|
24 | *> | |||
|
|
25 | *> \verbatim | |||
|
|
26 | *> | |||
|
|
27 | *> CAXPY constant times a vector plus a vector. | |||
|
|
28 | *> \endverbatim | |||
|
|
29 | * | |||
|
|
30 | * Arguments: | |||
|
|
31 | * ========== | |||
|
|
32 | * | |||
|
|
33 | *> \param[in] N | |||
|
|
34 | *> \verbatim | |||
|
|
35 | *> N is INTEGER | |||
|
|
36 | *> number of elements in input vector(s) | |||
|
|
37 | *> \endverbatim | |||
|
|
38 | *> | |||
|
|
39 | *> \param[in] CA | |||
|
|
40 | *> \verbatim | |||
|
|
41 | *> CA is COMPLEX | |||
|
|
42 | *> On entry, CA specifies the scalar alpha. | |||
|
|
43 | *> \endverbatim | |||
|
|
44 | *> | |||
|
|
45 | *> \param[in] CX | |||
|
|
46 | *> \verbatim | |||
|
|
47 | *> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) | |||
|
|
48 | *> \endverbatim | |||
|
|
49 | *> | |||
|
|
50 | *> \param[in] INCX | |||
|
|
51 | *> \verbatim | |||
|
|
52 | *> INCX is INTEGER | |||
|
|
53 | *> storage spacing between elements of CX | |||
|
|
54 | *> \endverbatim | |||
|
|
55 | *> | |||
|
|
56 | *> \param[in,out] CY | |||
|
|
57 | *> \verbatim | |||
|
|
58 | *> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) | |||
|
|
59 | *> \endverbatim | |||
|
|
60 | *> | |||
|
|
61 | *> \param[in] INCY | |||
|
|
62 | *> \verbatim | |||
|
|
63 | *> INCY is INTEGER | |||
|
|
64 | *> storage spacing between elements of CY | |||
|
|
65 | *> \endverbatim | |||
|
|
66 | * | |||
|
|
67 | * Authors: | |||
|
|
68 | * ======== | |||
|
|
69 | * | |||
|
|
70 | *> \author Univ. of Tennessee | |||
|
|
71 | *> \author Univ. of California Berkeley | |||
|
|
72 | *> \author Univ. of Colorado Denver | |||
|
|
73 | *> \author NAG Ltd. | |||
|
|
74 | * | |||
|
|
75 | *> \date November 2017 | |||
|
|
76 | * | |||
|
|
77 | *> \ingroup complex_blas_level1 | |||
|
|
78 | * | |||
|
|
79 | *> \par Further Details: | |||
|
|
80 | * ===================== | |||
|
|
81 | *> | |||
|
|
82 | *> \verbatim | |||
|
|
83 | *> | |||
|
|
84 | *> jack dongarra, linpack, 3/11/78. | |||
|
|
85 | *> modified 12/3/93, array(1) declarations changed to array(*) | |||
|
|
86 | *> \endverbatim | |||
|
|
87 | *> | |||
|
|
88 | * ===================================================================== | |||
|
|
89 | SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY) | |||
|
|
90 | * | |||
|
|
91 | * -- Reference BLAS level1 routine (version 3.8.0) -- | |||
|
|
92 | * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- | |||
|
|
93 | * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- | |||
|
|
94 | * November 2017 | |||
|
|
95 | * | |||
|
|
96 | * .. Scalar Arguments .. | |||
|
|
97 | COMPLEX CA | |||
|
|
98 | INTEGER INCX,INCY,N | |||
|
|
99 | * .. | |||
|
|
100 | * .. Array Arguments .. | |||
|
|
101 | COMPLEX CX(*),CY(*) | |||
|
|
102 | * .. | |||
|
|
103 | * | |||
|
|
104 | * ===================================================================== | |||
|
|
105 | * | |||
|
|
106 | * .. Local Scalars .. | |||
|
|
107 | INTEGER I,IX,IY | |||
|
|
108 | * .. | |||
|
|
109 | * .. External Functions .. | |||
|
|
110 | REAL SCABS1 | |||
|
|
111 | EXTERNAL SCABS1 | |||
|
|
112 | * .. | |||
|
|
113 | IF (N.LE.0) RETURN | |||
|
|
114 | IF (SCABS1(CA).EQ.0.0E+0) RETURN | |||
|
|
115 | IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN | |||
|
|
116 | * | |||
|
|
117 | * code for both increments equal to 1 | |||
|
|
118 | * | |||
|
|
119 | DO I = 1,N | |||
|
|
120 | CY(I) = CY(I) + CA*CX(I) | |||
|
|
121 | END DO | |||
|
|
122 | ELSE | |||
|
|
123 | * | |||
|
|
124 | * code for unequal increments or equal increments | |||
|
|
125 | * not equal to 1 | |||
|
|
126 | * | |||
|
|
127 | IX = 1 | |||
|
|
128 | IY = 1 | |||
|
|
129 | IF (INCX.LT.0) IX = (-N+1)*INCX + 1 | |||
|
|
130 | IF (INCY.LT.0) IY = (-N+1)*INCY + 1 | |||
|
|
131 | DO I = 1,N | |||
|
|
132 | CY(IY) = CY(IY) + CA*CX(IX) | |||
|
|
133 | IX = IX + INCX | |||
|
|
134 | IY = IY + INCY | |||
|
|
135 | END DO | |||
|
|
136 | END IF | |||
|
|
137 | * | |||
|
|
138 | RETURN | |||
|
|
139 | END | |||
| @@ -0,0 +1,261 | |||||
|
|
1 | *DECK CBESI | |||
|
|
2 | SUBROUTINE CBESI (Z, FNU, KODE, N, CY, NZ, IERR) | |||
|
|
3 | C***BEGIN PROLOGUE CBESI | |||
|
|
4 | C***PURPOSE Compute a sequence of the Bessel functions I(a,z) for | |||
|
|
5 | C complex argument z and real nonnegative orders a=b,b+1, | |||
|
|
6 | C b+2,... where b>0. A scaling option is available to | |||
|
|
7 | C help avoid overflow. | |||
|
|
8 | C***LIBRARY SLATEC | |||
|
|
9 | C***CATEGORY C10B4 | |||
|
|
10 | C***TYPE COMPLEX (CBESI-C, ZBESI-C) | |||
|
|
11 | C***KEYWORDS BESSEL FUNCTIONS OF COMPLEX ARGUMENT, I BESSEL FUNCTIONS, | |||
|
|
12 | C MODIFIED BESSEL FUNCTIONS | |||
|
|
13 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
14 | C***DESCRIPTION | |||
|
|
15 | C | |||
|
|
16 | C On KODE=1, CBESI computes an N-member sequence of complex | |||
|
|
17 | C Bessel functions CY(L)=I(FNU+L-1,Z) for real nonnegative | |||
|
|
18 | C orders FNU+L-1, L=1,...,N and complex Z in the cut plane | |||
|
|
19 | C -pi<arg(Z)<=pi. On KODE=2, CBESI returns the scaled functions | |||
|
|
20 | C | |||
|
|
21 | C CY(L) = exp(-abs(X))*I(FNU+L-1,Z), L=1,...,N and X=Re(Z) | |||
|
|
22 | C | |||
|
|
23 | C which removes the exponential growth in both the left and | |||
|
|
24 | C right half-planes as Z goes to infinity. | |||
|
|
25 | C | |||
|
|
26 | C Input | |||
|
|
27 | C Z - Argument of type COMPLEX | |||
|
|
28 | C FNU - Initial order of type REAL, FNU>=0 | |||
|
|
29 | C KODE - A parameter to indicate the scaling option | |||
|
|
30 | C KODE=1 returns | |||
|
|
31 | C CY(L)=I(FNU+L-1,Z), L=1,...,N | |||
|
|
32 | C =2 returns | |||
|
|
33 | C CY(L)=exp(-abs(X))*I(FNU+L-1,Z), L=1,...,N | |||
|
|
34 | C where X=Re(Z) | |||
|
|
35 | C N - Number of terms in the sequence, N>=1 | |||
|
|
36 | C | |||
|
|
37 | C Output | |||
|
|
38 | C CY - Result vector of type COMPLEX | |||
|
|
39 | C NZ - Number of underflows set to zero | |||
|
|
40 | C NZ=0 Normal return | |||
|
|
41 | C NZ>0 CY(L)=0, L=N-NZ+1,...,N | |||
|
|
42 | C IERR - Error flag | |||
|
|
43 | C IERR=0 Normal return - COMPUTATION COMPLETED | |||
|
|
44 | C IERR=1 Input error - NO COMPUTATION | |||
|
|
45 | C IERR=2 Overflow - NO COMPUTATION | |||
|
|
46 | C (Re(Z) too large on KODE=1) | |||
|
|
47 | C IERR=3 Precision warning - COMPUTATION COMPLETED | |||
|
|
48 | C (Result has half precision or less | |||
|
|
49 | C because abs(Z) or FNU+N-1 is large) | |||
|
|
50 | C IERR=4 Precision error - NO COMPUTATION | |||
|
|
51 | C (Result has no precision because | |||
|
|
52 | C abs(Z) or FNU+N-1 is too large) | |||
|
|
53 | C IERR=5 Algorithmic error - NO COMPUTATION | |||
|
|
54 | C (Termination condition not met) | |||
|
|
55 | C | |||
|
|
56 | C *Long Description: | |||
|
|
57 | C | |||
|
|
58 | C The computation of I(a,z) is carried out by the power series | |||
|
|
59 | C for small abs(z), the asymptotic expansion for large abs(z), | |||
|
|
60 | C the Miller algorithm normalized by the Wronskian and a | |||
|
|
61 | C Neumann series for intermediate magnitudes of z, and the | |||
|
|
62 | C uniform asymptotic expansions for I(a,z) and J(a,z) for | |||
|
|
63 | C large orders a. Backward recurrence is used to generate | |||
|
|
64 | C sequences or reduce orders when necessary. | |||
|
|
65 | C | |||
|
|
66 | C The calculations above are done in the right half plane and | |||
|
|
67 | C continued into the left half plane by the formula | |||
|
|
68 | C | |||
|
|
69 | C I(a,z*exp(t)) = exp(t*a)*I(a,z), Re(z)>0 | |||
|
|
70 | C t = i*pi or -i*pi | |||
|
|
71 | C | |||
|
|
72 | C For negative orders, the formula | |||
|
|
73 | C | |||
|
|
74 | C I(-a,z) = I(a,z) + (2/pi)*sin(pi*a)*K(a,z) | |||
|
|
75 | C | |||
|
|
76 | C can be used. However, for large orders close to integers the | |||
|
|
77 | C the function changes radically. When a is a large positive | |||
|
|
78 | C integer, the magnitude of I(-a,z)=I(a,z) is a large | |||
|
|
79 | C negative power of ten. But when a is not an integer, | |||
|
|
80 | C K(a,z) dominates in magnitude with a large positive power of | |||
|
|
81 | C ten and the most that the second term can be reduced is by | |||
|
|
82 | C unit roundoff from the coefficient. Thus, wide changes can | |||
|
|
83 | C occur within unit roundoff of a large integer for a. Here, | |||
|
|
84 | C large means a>abs(z). | |||
|
|
85 | C | |||
|
|
86 | C In most complex variable computation, one must evaluate ele- | |||
|
|
87 | C mentary functions. When the magnitude of Z or FNU+N-1 is | |||
|
|
88 | C large, losses of significance by argument reduction occur. | |||
|
|
89 | C Consequently, if either one exceeds U1=SQRT(0.5/UR), then | |||
|
|
90 | C losses exceeding half precision are likely and an error flag | |||
|
|
91 | C IERR=3 is triggered where UR=R1MACH(4)=UNIT ROUNDOFF. Also, | |||
|
|
92 | C if either is larger than U2=0.5/UR, then all significance is | |||
|
|
93 | C lost and IERR=4. In order to use the INT function, arguments | |||
|
|
94 | C must be further restricted not to exceed the largest machine | |||
|
|
95 | C integer, U3=I1MACH(9). Thus, the magnitude of Z and FNU+N-1 | |||
|
|
96 | C is restricted by MIN(U2,U3). In IEEE arithmetic, U1,U2, and | |||
|
|
97 | C U3 approximate 2.0E+3, 4.2E+6, 2.1E+9 in single precision | |||
|
|
98 | C and 4.7E+7, 2.3E+15 and 2.1E+9 in double precision. This | |||
|
|
99 | C makes U2 limiting in single precision and U3 limiting in | |||
|
|
100 | C double precision. This means that one can expect to retain, | |||
|
|
101 | C in the worst cases on IEEE machines, no digits in single pre- | |||
|
|
102 | C cision and only 6 digits in double precision. Similar con- | |||
|
|
103 | C siderations hold for other machines. | |||
|
|
104 | C | |||
|
|
105 | C The approximate relative error in the magnitude of a complex | |||
|
|
106 | C Bessel function can be expressed as P*10**S where P=MAX(UNIT | |||
|
|
107 | C ROUNDOFF,1.0E-18) is the nominal precision and 10**S repre- | |||
|
|
108 | C sents the increase in error due to argument reduction in the | |||
|
|
109 | C elementary functions. Here, S=MAX(1,ABS(LOG10(ABS(Z))), | |||
|
|
110 | C ABS(LOG10(FNU))) approximately (i.e., S=MAX(1,ABS(EXPONENT OF | |||
|
|
111 | C ABS(Z),ABS(EXPONENT OF FNU)) ). However, the phase angle may | |||
|
|
112 | C have only absolute accuracy. This is most likely to occur | |||
|
|
113 | C when one component (in magnitude) is larger than the other by | |||
|
|
114 | C several orders of magnitude. If one component is 10**K larger | |||
|
|
115 | C than the other, then one can expect only MAX(ABS(LOG10(P))-K, | |||
|
|
116 | C 0) significant digits; or, stated another way, when K exceeds | |||
|
|
117 | C the exponent of P, no significant digits remain in the smaller | |||
|
|
118 | C component. However, the phase angle retains absolute accuracy | |||
|
|
119 | C because, in complex arithmetic with precision P, the smaller | |||
|
|
120 | C component will not (as a rule) decrease below P times the | |||
|
|
121 | C magnitude of the larger component. In these extreme cases, | |||
|
|
122 | C the principal phase angle is on the order of +P, -P, PI/2-P, | |||
|
|
123 | C or -PI/2+P. | |||
|
|
124 | C | |||
|
|
125 | C***REFERENCES 1. M. Abramowitz and I. A. Stegun, Handbook of Mathe- | |||
|
|
126 | C matical Functions, National Bureau of Standards | |||
|
|
127 | C Applied Mathematics Series 55, U. S. Department | |||
|
|
128 | C of Commerce, Tenth Printing (1972) or later. | |||
|
|
129 | C 2. D. E. Amos, Computation of Bessel Functions of | |||
|
|
130 | C Complex Argument, Report SAND83-0086, Sandia National | |||
|
|
131 | C Laboratories, Albuquerque, NM, May 1983. | |||
|
|
132 | C 3. D. E. Amos, Computation of Bessel Functions of | |||
|
|
133 | C Complex Argument and Large Order, Report SAND83-0643, | |||
|
|
134 | C Sandia National Laboratories, Albuquerque, NM, May | |||
|
|
135 | C 1983. | |||
|
|
136 | C 4. D. E. Amos, A Subroutine Package for Bessel Functions | |||
|
|
137 | C of a Complex Argument and Nonnegative Order, Report | |||
|
|
138 | C SAND85-1018, Sandia National Laboratory, Albuquerque, | |||
|
|
139 | C NM, May 1985. | |||
|
|
140 | C 5. D. E. Amos, A portable package for Bessel functions | |||
|
|
141 | C of a complex argument and nonnegative order, ACM | |||
|
|
142 | C Transactions on Mathematical Software, 12 (September | |||
|
|
143 | C 1986), pp. 265-273. | |||
|
|
144 | C | |||
|
|
145 | C***ROUTINES CALLED CBINU, I1MACH, R1MACH | |||
|
|
146 | C***REVISION HISTORY (YYMMDD) | |||
|
|
147 | C 830501 DATE WRITTEN | |||
|
|
148 | C 890801 REVISION DATE from Version 3.2 | |||
|
|
149 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
150 | C 920128 Category corrected. (WRB) | |||
|
|
151 | C 920811 Prologue revised. (DWL) | |||
|
|
152 | C***END PROLOGUE CBESI | |||
|
|
153 | COMPLEX CONE, CSGN, CY, Z, ZN | |||
|
|
154 | REAL AA, ALIM, ARG, DIG, ELIM, FNU, FNUL, PI, RL, R1M5, S1, S2, | |||
|
|
155 | * TOL, XX, YY, R1MACH, AZ, FN, BB, ASCLE, RTOL, ATOL | |||
|
|
156 | INTEGER I, IERR, INU, K, KODE, K1, K2, N, NN, NZ, I1MACH | |||
|
|
157 | DIMENSION CY(N) | |||
|
|
158 | DATA PI /3.14159265358979324E0/ | |||
|
|
159 | DATA CONE / (1.0E0,0.0E0) / | |||
|
|
160 | C | |||
|
|
161 | C***FIRST EXECUTABLE STATEMENT CBESI | |||
|
|
162 | IERR = 0 | |||
|
|
163 | NZ=0 | |||
|
|
164 | IF (FNU.LT.0.0E0) IERR=1 | |||
|
|
165 | IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1 | |||
|
|
166 | IF (N.LT.1) IERR=1 | |||
|
|
167 | IF (IERR.NE.0) RETURN | |||
|
|
168 | XX = REAL(Z) | |||
|
|
169 | YY = AIMAG(Z) | |||
|
|
170 | C----------------------------------------------------------------------- | |||
|
|
171 | C SET PARAMETERS RELATED TO MACHINE CONSTANTS. | |||
|
|
172 | C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18. | |||
|
|
173 | C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT. | |||
|
|
174 | C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND | |||
|
|
175 | C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR | |||
|
|
176 | C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE. | |||
|
|
177 | C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z. | |||
|
|
178 | C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG). | |||
|
|
179 | C FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU. | |||
|
|
180 | C----------------------------------------------------------------------- | |||
|
|
181 | TOL = MAX(R1MACH(4),1.0E-18) | |||
|
|
182 | K1 = I1MACH(12) | |||
|
|
183 | K2 = I1MACH(13) | |||
|
|
184 | R1M5 = R1MACH(5) | |||
|
|
185 | K = MIN(ABS(K1),ABS(K2)) | |||
|
|
186 | ELIM = 2.303E0*(K*R1M5-3.0E0) | |||
|
|
187 | K1 = I1MACH(11) - 1 | |||
|
|
188 | AA = R1M5*K1 | |||
|
|
189 | DIG = MIN(AA,18.0E0) | |||
|
|
190 | AA = AA*2.303E0 | |||
|
|
191 | ALIM = ELIM + MAX(-AA,-41.45E0) | |||
|
|
192 | RL = 1.2E0*DIG + 3.0E0 | |||
|
|
193 | FNUL = 10.0E0 + 6.0E0*(DIG-3.0E0) | |||
|
|
194 | AZ = ABS(Z) | |||
|
|
195 | C----------------------------------------------------------------------- | |||
|
|
196 | C TEST FOR RANGE | |||
|
|
197 | C----------------------------------------------------------------------- | |||
|
|
198 | AA = 0.5E0/TOL | |||
|
|
199 | BB=I1MACH(9)*0.5E0 | |||
|
|
200 | AA=MIN(AA,BB) | |||
|
|
201 | IF(AZ.GT.AA) GO TO 140 | |||
|
|
202 | FN=FNU+(N-1) | |||
|
|
203 | IF(FN.GT.AA) GO TO 140 | |||
|
|
204 | AA=SQRT(AA) | |||
|
|
205 | IF(AZ.GT.AA) IERR=3 | |||
|
|
206 | IF(FN.GT.AA) IERR=3 | |||
|
|
207 | ZN = Z | |||
|
|
208 | CSGN = CONE | |||
|
|
209 | IF (XX.GE.0.0E0) GO TO 40 | |||
|
|
210 | ZN = -Z | |||
|
|
211 | C----------------------------------------------------------------------- | |||
|
|
212 | C CALCULATE CSGN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE | |||
|
|
213 | C WHEN FNU IS LARGE | |||
|
|
214 | C----------------------------------------------------------------------- | |||
|
|
215 | INU = FNU | |||
|
|
216 | ARG = (FNU-INU)*PI | |||
|
|
217 | IF (YY.LT.0.0E0) ARG = -ARG | |||
|
|
218 | S1 = COS(ARG) | |||
|
|
219 | S2 = SIN(ARG) | |||
|
|
220 | CSGN = CMPLX(S1,S2) | |||
|
|
221 | IF (MOD(INU,2).EQ.1) CSGN = -CSGN | |||
|
|
222 | 40 CONTINUE | |||
|
|
223 | CALL CBINU(ZN, FNU, KODE, N, CY, NZ, RL, FNUL, TOL, ELIM, ALIM) | |||
|
|
224 | IF (NZ.LT.0) GO TO 120 | |||
|
|
225 | IF (XX.GE.0.0E0) RETURN | |||
|
|
226 | C----------------------------------------------------------------------- | |||
|
|
227 | C ANALYTIC CONTINUATION TO THE LEFT HALF PLANE | |||
|
|
228 | C----------------------------------------------------------------------- | |||
|
|
229 | NN = N - NZ | |||
|
|
230 | IF (NN.EQ.0) RETURN | |||
|
|
231 | RTOL = 1.0E0/TOL | |||
|
|
232 | ASCLE = R1MACH(1)*RTOL*1.0E+3 | |||
|
|
233 | DO 50 I=1,NN | |||
|
|
234 | C CY(I) = CY(I)*CSGN | |||
|
|
235 | ZN=CY(I) | |||
|
|
236 | AA=REAL(ZN) | |||
|
|
237 | BB=AIMAG(ZN) | |||
|
|
238 | ATOL=1.0E0 | |||
|
|
239 | IF (MAX(ABS(AA),ABS(BB)).GT.ASCLE) GO TO 55 | |||
|
|
240 | ZN = ZN*CMPLX(RTOL,0.0E0) | |||
|
|
241 | ATOL = TOL | |||
|
|
242 | 55 CONTINUE | |||
|
|
243 | ZN = ZN*CSGN | |||
|
|
244 | CY(I) = ZN*CMPLX(ATOL,0.0E0) | |||
|
|
245 | CSGN = -CSGN | |||
|
|
246 | 50 CONTINUE | |||
|
|
247 | RETURN | |||
|
|
248 | 120 CONTINUE | |||
|
|
249 | IF(NZ.EQ.(-2)) GO TO 130 | |||
|
|
250 | NZ = 0 | |||
|
|
251 | IERR=2 | |||
|
|
252 | RETURN | |||
|
|
253 | 130 CONTINUE | |||
|
|
254 | NZ=0 | |||
|
|
255 | IERR=5 | |||
|
|
256 | RETURN | |||
|
|
257 | 140 CONTINUE | |||
|
|
258 | NZ=0 | |||
|
|
259 | IERR=4 | |||
|
|
260 | RETURN | |||
|
|
261 | END | |||
| @@ -0,0 +1,115 | |||||
|
|
1 | *DECK CBINU | |||
|
|
2 | SUBROUTINE CBINU (Z, FNU, KODE, N, CY, NZ, RL, FNUL, TOL, ELIM, | |||
|
|
3 | + ALIM) | |||
|
|
4 | C***BEGIN PROLOGUE CBINU | |||
|
|
5 | C***SUBSIDIARY | |||
|
|
6 | C***PURPOSE Subsidiary to CAIRY, CBESH, CBESI, CBESJ, CBESK and CBIRY | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***TYPE ALL (CBINU-A, ZBINU-A) | |||
|
|
9 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
10 | C***DESCRIPTION | |||
|
|
11 | C | |||
|
|
12 | C CBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE | |||
|
|
13 | C | |||
|
|
14 | C***SEE ALSO CAIRY, CBESH, CBESI, CBESJ, CBESK, CBIRY | |||
|
|
15 | C***ROUTINES CALLED CASYI, CBUNI, CMLRI, CSERI, CUOIK, CWRSK | |||
|
|
16 | C***REVISION HISTORY (YYMMDD) | |||
|
|
17 | C 830501 DATE WRITTEN | |||
|
|
18 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
19 | C***END PROLOGUE CBINU | |||
|
|
20 | COMPLEX CW, CY, CZERO, Z | |||
|
|
21 | REAL ALIM, AZ, DFNU, ELIM, FNU, FNUL, RL, TOL | |||
|
|
22 | INTEGER I, INW, KODE, N, NLAST, NN, NUI, NW, NZ | |||
|
|
23 | DIMENSION CY(N), CW(2) | |||
|
|
24 | DATA CZERO / (0.0E0,0.0E0) / | |||
|
|
25 | C***FIRST EXECUTABLE STATEMENT CBINU | |||
|
|
26 | NZ = 0 | |||
|
|
27 | AZ = ABS(Z) | |||
|
|
28 | NN = N | |||
|
|
29 | DFNU = FNU + (N-1) | |||
|
|
30 | IF (AZ.LE.2.0E0) GO TO 10 | |||
|
|
31 | IF (AZ*AZ*0.25E0.GT.DFNU+1.0E0) GO TO 20 | |||
|
|
32 | 10 CONTINUE | |||
|
|
33 | C----------------------------------------------------------------------- | |||
|
|
34 | C POWER SERIES | |||
|
|
35 | C----------------------------------------------------------------------- | |||
|
|
36 | CALL CSERI(Z, FNU, KODE, NN, CY, NW, TOL, ELIM, ALIM) | |||
|
|
37 | INW = ABS(NW) | |||
|
|
38 | NZ = NZ + INW | |||
|
|
39 | NN = NN - INW | |||
|
|
40 | IF (NN.EQ.0) RETURN | |||
|
|
41 | IF (NW.GE.0) GO TO 120 | |||
|
|
42 | DFNU = FNU + (NN-1) | |||
|
|
43 | 20 CONTINUE | |||
|
|
44 | IF (AZ.LT.RL) GO TO 40 | |||
|
|
45 | IF (DFNU.LE.1.0E0) GO TO 30 | |||
|
|
46 | IF (AZ+AZ.LT.DFNU*DFNU) GO TO 50 | |||
|
|
47 | C----------------------------------------------------------------------- | |||
|
|
48 | C ASYMPTOTIC EXPANSION FOR LARGE Z | |||
|
|
49 | C----------------------------------------------------------------------- | |||
|
|
50 | 30 CONTINUE | |||
|
|
51 | CALL CASYI(Z, FNU, KODE, NN, CY, NW, RL, TOL, ELIM, ALIM) | |||
|
|
52 | IF (NW.LT.0) GO TO 130 | |||
|
|
53 | GO TO 120 | |||
|
|
54 | 40 CONTINUE | |||
|
|
55 | IF (DFNU.LE.1.0E0) GO TO 70 | |||
|
|
56 | 50 CONTINUE | |||
|
|
57 | C----------------------------------------------------------------------- | |||
|
|
58 | C OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM | |||
|
|
59 | C----------------------------------------------------------------------- | |||
|
|
60 | CALL CUOIK(Z, FNU, KODE, 1, NN, CY, NW, TOL, ELIM, ALIM) | |||
|
|
61 | IF (NW.LT.0) GO TO 130 | |||
|
|
62 | NZ = NZ + NW | |||
|
|
63 | NN = NN - NW | |||
|
|
64 | IF (NN.EQ.0) RETURN | |||
|
|
65 | DFNU = FNU+(NN-1) | |||
|
|
66 | IF (DFNU.GT.FNUL) GO TO 110 | |||
|
|
67 | IF (AZ.GT.FNUL) GO TO 110 | |||
|
|
68 | 60 CONTINUE | |||
|
|
69 | IF (AZ.GT.RL) GO TO 80 | |||
|
|
70 | 70 CONTINUE | |||
|
|
71 | C----------------------------------------------------------------------- | |||
|
|
72 | C MILLER ALGORITHM NORMALIZED BY THE SERIES | |||
|
|
73 | C----------------------------------------------------------------------- | |||
|
|
74 | CALL CMLRI(Z, FNU, KODE, NN, CY, NW, TOL) | |||
|
|
75 | IF(NW.LT.0) GO TO 130 | |||
|
|
76 | GO TO 120 | |||
|
|
77 | 80 CONTINUE | |||
|
|
78 | C----------------------------------------------------------------------- | |||
|
|
79 | C MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN | |||
|
|
80 | C----------------------------------------------------------------------- | |||
|
|
81 | C----------------------------------------------------------------------- | |||
|
|
82 | C OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN | |||
|
|
83 | C----------------------------------------------------------------------- | |||
|
|
84 | CALL CUOIK(Z, FNU, KODE, 2, 2, CW, NW, TOL, ELIM, ALIM) | |||
|
|
85 | IF (NW.GE.0) GO TO 100 | |||
|
|
86 | NZ = NN | |||
|
|
87 | DO 90 I=1,NN | |||
|
|
88 | CY(I) = CZERO | |||
|
|
89 | 90 CONTINUE | |||
|
|
90 | RETURN | |||
|
|
91 | 100 CONTINUE | |||
|
|
92 | IF (NW.GT.0) GO TO 130 | |||
|
|
93 | CALL CWRSK(Z, FNU, KODE, NN, CY, NW, CW, TOL, ELIM, ALIM) | |||
|
|
94 | IF (NW.LT.0) GO TO 130 | |||
|
|
95 | GO TO 120 | |||
|
|
96 | 110 CONTINUE | |||
|
|
97 | C----------------------------------------------------------------------- | |||
|
|
98 | C INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD | |||
|
|
99 | C----------------------------------------------------------------------- | |||
|
|
100 | NUI = FNUL-DFNU + 1 | |||
|
|
101 | NUI = MAX(NUI,0) | |||
|
|
102 | CALL CBUNI(Z, FNU, KODE, NN, CY, NW, NUI, NLAST, FNUL, TOL, ELIM, | |||
|
|
103 | * ALIM) | |||
|
|
104 | IF (NW.LT.0) GO TO 130 | |||
|
|
105 | NZ = NZ + NW | |||
|
|
106 | IF (NLAST.EQ.0) GO TO 120 | |||
|
|
107 | NN = NLAST | |||
|
|
108 | GO TO 60 | |||
|
|
109 | 120 CONTINUE | |||
|
|
110 | RETURN | |||
|
|
111 | 130 CONTINUE | |||
|
|
112 | NZ = -1 | |||
|
|
113 | IF(NW.EQ.(-2)) NZ=-2 | |||
|
|
114 | RETURN | |||
|
|
115 | END | |||
| @@ -0,0 +1,466 | |||||
|
|
1 | *DECK CBKNU | |||
|
|
2 | SUBROUTINE CBKNU (Z, FNU, KODE, N, Y, NZ, TOL, ELIM, ALIM) | |||
|
|
3 | C***BEGIN PROLOGUE CBKNU | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CAIRY, CBESH, CBESI and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CBKNU-A, ZBKNU-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CBKNU COMPUTES THE K BESSEL FUNCTION IN THE RIGHT HALF Z PLANE | |||
|
|
12 | C | |||
|
|
13 | C***SEE ALSO CAIRY, CBESH, CBESI, CBESK | |||
|
|
14 | C***ROUTINES CALLED CKSCL, CSHCH, CUCHK, GAMLN, I1MACH, R1MACH | |||
|
|
15 | C***REVISION HISTORY (YYMMDD) | |||
|
|
16 | C 830501 DATE WRITTEN | |||
|
|
17 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
18 | C***END PROLOGUE CBKNU | |||
|
|
19 | C | |||
|
|
20 | COMPLEX CCH, CK, COEF, CONE, CRSC, CS, CSCL, CSH, CSR, CSS, CTWO, | |||
|
|
21 | * CZ, CZERO, F, FMU, P, PT, P1, P2, Q, RZ, SMU, ST, S1, S2, Y, Z, | |||
|
|
22 | * ZD, CELM, CY | |||
|
|
23 | REAL AA, AK, ALIM, ASCLE, A1, A2, BB, BK, BRY, CAZ, CC, DNU, | |||
|
|
24 | * DNU2, ELIM, ETEST, FC, FHS, FK, FKS, FNU, FPI, G1, G2, HPI, PI, | |||
|
|
25 | * P2I, P2M, P2R, RK, RTHPI, R1, S, SPI, TM, TOL, TTH, T1, T2, XX, | |||
|
|
26 | * YY, GAMLN, R1MACH, HELIM, ELM, XD, YD, ALAS, AS | |||
|
|
27 | INTEGER I, IDUM, IFLAG, INU, K, KFLAG, KK, KMAX, KODE, KODED, N, | |||
|
|
28 | * NZ, I1MACH, NW, J, IC, INUB | |||
|
|
29 | DIMENSION BRY(3), CC(8), CSS(3), CSR(3), Y(N), CY(2) | |||
|
|
30 | C | |||
|
|
31 | DATA KMAX / 30 / | |||
|
|
32 | DATA R1 / 2.0E0 / | |||
|
|
33 | DATA CZERO,CONE,CTWO /(0.0E0,0.0E0),(1.0E0,0.0E0),(2.0E0,0.0E0)/ | |||
|
|
34 | C | |||
|
|
35 | DATA PI, RTHPI, SPI ,HPI, FPI, TTH / | |||
|
|
36 | 1 3.14159265358979324E0, 1.25331413731550025E0, | |||
|
|
37 | 2 1.90985931710274403E0, 1.57079632679489662E0, | |||
|
|
38 | 3 1.89769999331517738E0, 6.66666666666666666E-01/ | |||
|
|
39 | C | |||
|
|
40 | DATA CC(1), CC(2), CC(3), CC(4), CC(5), CC(6), CC(7), CC(8)/ | |||
|
|
41 | 1 5.77215664901532861E-01, -4.20026350340952355E-02, | |||
|
|
42 | 2 -4.21977345555443367E-02, 7.21894324666309954E-03, | |||
|
|
43 | 3 -2.15241674114950973E-04, -2.01348547807882387E-05, | |||
|
|
44 | 4 1.13302723198169588E-06, 6.11609510448141582E-09/ | |||
|
|
45 | C | |||
|
|
46 | C***FIRST EXECUTABLE STATEMENT CBKNU | |||
|
|
47 | XX = REAL(Z) | |||
|
|
48 | YY = AIMAG(Z) | |||
|
|
49 | CAZ = ABS(Z) | |||
|
|
50 | CSCL = CMPLX(1.0E0/TOL,0.0E0) | |||
|
|
51 | CRSC = CMPLX(TOL,0.0E0) | |||
|
|
52 | CSS(1) = CSCL | |||
|
|
53 | CSS(2) = CONE | |||
|
|
54 | CSS(3) = CRSC | |||
|
|
55 | CSR(1) = CRSC | |||
|
|
56 | CSR(2) = CONE | |||
|
|
57 | CSR(3) = CSCL | |||
|
|
58 | BRY(1) = 1.0E+3*R1MACH(1)/TOL | |||
|
|
59 | BRY(2) = 1.0E0/BRY(1) | |||
|
|
60 | BRY(3) = R1MACH(2) | |||
|
|
61 | NZ = 0 | |||
|
|
62 | IFLAG = 0 | |||
|
|
63 | KODED = KODE | |||
|
|
64 | RZ = CTWO/Z | |||
|
|
65 | INU = FNU+0.5E0 | |||
|
|
66 | DNU = FNU - INU | |||
|
|
67 | IF (ABS(DNU).EQ.0.5E0) GO TO 110 | |||
|
|
68 | DNU2 = 0.0E0 | |||
|
|
69 | IF (ABS(DNU).GT.TOL) DNU2 = DNU*DNU | |||
|
|
70 | IF (CAZ.GT.R1) GO TO 110 | |||
|
|
71 | C----------------------------------------------------------------------- | |||
|
|
72 | C SERIES FOR ABS(Z).LE.R1 | |||
|
|
73 | C----------------------------------------------------------------------- | |||
|
|
74 | FC = 1.0E0 | |||
|
|
75 | SMU = CLOG(RZ) | |||
|
|
76 | FMU = SMU*CMPLX(DNU,0.0E0) | |||
|
|
77 | CALL CSHCH(FMU, CSH, CCH) | |||
|
|
78 | IF (DNU.EQ.0.0E0) GO TO 10 | |||
|
|
79 | FC = DNU*PI | |||
|
|
80 | FC = FC/SIN(FC) | |||
|
|
81 | SMU = CSH*CMPLX(1.0E0/DNU,0.0E0) | |||
|
|
82 | 10 CONTINUE | |||
|
|
83 | A2 = 1.0E0 + DNU | |||
|
|
84 | C----------------------------------------------------------------------- | |||
|
|
85 | C GAM(1-Z)*GAM(1+Z)=PI*Z/SIN(PI*Z), T1=1/GAM(1-DNU), T2=1/GAM(1+DNU) | |||
|
|
86 | C----------------------------------------------------------------------- | |||
|
|
87 | T2 = EXP(-GAMLN(A2,IDUM)) | |||
|
|
88 | T1 = 1.0E0/(T2*FC) | |||
|
|
89 | IF (ABS(DNU).GT.0.1E0) GO TO 40 | |||
|
|
90 | C----------------------------------------------------------------------- | |||
|
|
91 | C SERIES FOR F0 TO RESOLVE INDETERMINACY FOR SMALL ABS(DNU) | |||
|
|
92 | C----------------------------------------------------------------------- | |||
|
|
93 | AK = 1.0E0 | |||
|
|
94 | S = CC(1) | |||
|
|
95 | DO 20 K=2,8 | |||
|
|
96 | AK = AK*DNU2 | |||
|
|
97 | TM = CC(K)*AK | |||
|
|
98 | S = S + TM | |||
|
|
99 | IF (ABS(TM).LT.TOL) GO TO 30 | |||
|
|
100 | 20 CONTINUE | |||
|
|
101 | 30 G1 = -S | |||
|
|
102 | GO TO 50 | |||
|
|
103 | 40 CONTINUE | |||
|
|
104 | G1 = (T1-T2)/(DNU+DNU) | |||
|
|
105 | 50 CONTINUE | |||
|
|
106 | G2 = 0.5E0*(T1+T2)*FC | |||
|
|
107 | G1 = G1*FC | |||
|
|
108 | F = CMPLX(G1,0.0E0)*CCH + SMU*CMPLX(G2,0.0E0) | |||
|
|
109 | PT = CEXP(FMU) | |||
|
|
110 | P = CMPLX(0.5E0/T2,0.0E0)*PT | |||
|
|
111 | Q = CMPLX(0.5E0/T1,0.0E0)/PT | |||
|
|
112 | S1 = F | |||
|
|
113 | S2 = P | |||
|
|
114 | AK = 1.0E0 | |||
|
|
115 | A1 = 1.0E0 | |||
|
|
116 | CK = CONE | |||
|
|
117 | BK = 1.0E0 - DNU2 | |||
|
|
118 | IF (INU.GT.0 .OR. N.GT.1) GO TO 80 | |||
|
|
119 | C----------------------------------------------------------------------- | |||
|
|
120 | C GENERATE K(FNU,Z), 0.0D0 .LE. FNU .LT. 0.5D0 AND N=1 | |||
|
|
121 | C----------------------------------------------------------------------- | |||
|
|
122 | IF (CAZ.LT.TOL) GO TO 70 | |||
|
|
123 | CZ = Z*Z*CMPLX(0.25E0,0.0E0) | |||
|
|
124 | T1 = 0.25E0*CAZ*CAZ | |||
|
|
125 | 60 CONTINUE | |||
|
|
126 | F = (F*CMPLX(AK,0.0E0)+P+Q)*CMPLX(1.0E0/BK,0.0E0) | |||
|
|
127 | P = P*CMPLX(1.0E0/(AK-DNU),0.0E0) | |||
|
|
128 | Q = Q*CMPLX(1.0E0/(AK+DNU),0.0E0) | |||
|
|
129 | RK = 1.0E0/AK | |||
|
|
130 | CK = CK*CZ*CMPLX(RK,0.0) | |||
|
|
131 | S1 = S1 + CK*F | |||
|
|
132 | A1 = A1*T1*RK | |||
|
|
133 | BK = BK + AK + AK + 1.0E0 | |||
|
|
134 | AK = AK + 1.0E0 | |||
|
|
135 | IF (A1.GT.TOL) GO TO 60 | |||
|
|
136 | 70 CONTINUE | |||
|
|
137 | Y(1) = S1 | |||
|
|
138 | IF (KODED.EQ.1) RETURN | |||
|
|
139 | Y(1) = S1*CEXP(Z) | |||
|
|
140 | RETURN | |||
|
|
141 | C----------------------------------------------------------------------- | |||
|
|
142 | C GENERATE K(DNU,Z) AND K(DNU+1,Z) FOR FORWARD RECURRENCE | |||
|
|
143 | C----------------------------------------------------------------------- | |||
|
|
144 | 80 CONTINUE | |||
|
|
145 | IF (CAZ.LT.TOL) GO TO 100 | |||
|
|
146 | CZ = Z*Z*CMPLX(0.25E0,0.0E0) | |||
|
|
147 | T1 = 0.25E0*CAZ*CAZ | |||
|
|
148 | 90 CONTINUE | |||
|
|
149 | F = (F*CMPLX(AK,0.0E0)+P+Q)*CMPLX(1.0E0/BK,0.0E0) | |||
|
|
150 | P = P*CMPLX(1.0E0/(AK-DNU),0.0E0) | |||
|
|
151 | Q = Q*CMPLX(1.0E0/(AK+DNU),0.0E0) | |||
|
|
152 | RK = 1.0E0/AK | |||
|
|
153 | CK = CK*CZ*CMPLX(RK,0.0E0) | |||
|
|
154 | S1 = S1 + CK*F | |||
|
|
155 | S2 = S2 + CK*(P-F*CMPLX(AK,0.0E0)) | |||
|
|
156 | A1 = A1*T1*RK | |||
|
|
157 | BK = BK + AK + AK + 1.0E0 | |||
|
|
158 | AK = AK + 1.0E0 | |||
|
|
159 | IF (A1.GT.TOL) GO TO 90 | |||
|
|
160 | 100 CONTINUE | |||
|
|
161 | KFLAG = 2 | |||
|
|
162 | BK = REAL(SMU) | |||
|
|
163 | A1 = FNU + 1.0E0 | |||
|
|
164 | AK = A1*ABS(BK) | |||
|
|
165 | IF (AK.GT.ALIM) KFLAG = 3 | |||
|
|
166 | P2 = S2*CSS(KFLAG) | |||
|
|
167 | S2 = P2*RZ | |||
|
|
168 | S1 = S1*CSS(KFLAG) | |||
|
|
169 | IF (KODED.EQ.1) GO TO 210 | |||
|
|
170 | F = CEXP(Z) | |||
|
|
171 | S1 = S1*F | |||
|
|
172 | S2 = S2*F | |||
|
|
173 | GO TO 210 | |||
|
|
174 | C----------------------------------------------------------------------- | |||
|
|
175 | C IFLAG=0 MEANS NO UNDERFLOW OCCURRED | |||
|
|
176 | C IFLAG=1 MEANS AN UNDERFLOW OCCURRED- COMPUTATION PROCEEDS WITH | |||
|
|
177 | C KODED=2 AND A TEST FOR ON SCALE VALUES IS MADE DURING FORWARD | |||
|
|
178 | C RECURSION | |||
|
|
179 | C----------------------------------------------------------------------- | |||
|
|
180 | 110 CONTINUE | |||
|
|
181 | COEF = CMPLX(RTHPI,0.0E0)/CSQRT(Z) | |||
|
|
182 | KFLAG = 2 | |||
|
|
183 | IF (KODED.EQ.2) GO TO 120 | |||
|
|
184 | IF (XX.GT.ALIM) GO TO 290 | |||
|
|
185 | C BLANK LINE | |||
|
|
186 | A1 = EXP(-XX)*REAL(CSS(KFLAG)) | |||
|
|
187 | PT = CMPLX(A1,0.0E0)*CMPLX(COS(YY),-SIN(YY)) | |||
|
|
188 | COEF = COEF*PT | |||
|
|
189 | 120 CONTINUE | |||
|
|
190 | IF (ABS(DNU).EQ.0.5E0) GO TO 300 | |||
|
|
191 | C----------------------------------------------------------------------- | |||
|
|
192 | C MILLER ALGORITHM FOR ABS(Z).GT.R1 | |||
|
|
193 | C----------------------------------------------------------------------- | |||
|
|
194 | AK = COS(PI*DNU) | |||
|
|
195 | AK = ABS(AK) | |||
|
|
196 | IF (AK.EQ.0.0E0) GO TO 300 | |||
|
|
197 | FHS = ABS(0.25E0-DNU2) | |||
|
|
198 | IF (FHS.EQ.0.0E0) GO TO 300 | |||
|
|
199 | C----------------------------------------------------------------------- | |||
|
|
200 | C COMPUTE R2=F(E). IF ABS(Z).GE.R2, USE FORWARD RECURRENCE TO | |||
|
|
201 | C DETERMINE THE BACKWARD INDEX K. R2=F(E) IS A STRAIGHT LINE ON | |||
|
|
202 | C 12.LE.E.LE.60. E IS COMPUTED FROM 2**(-E)=B**(1-I1MACH(11))= | |||
|
|
203 | C TOL WHERE B IS THE BASE OF THE ARITHMETIC. | |||
|
|
204 | C----------------------------------------------------------------------- | |||
|
|
205 | T1 = (I1MACH(11)-1)*R1MACH(5)*3.321928094E0 | |||
|
|
206 | T1 = MAX(T1,12.0E0) | |||
|
|
207 | T1 = MIN(T1,60.0E0) | |||
|
|
208 | T2 = TTH*T1 - 6.0E0 | |||
|
|
209 | IF (XX.NE.0.0E0) GO TO 130 | |||
|
|
210 | T1 = HPI | |||
|
|
211 | GO TO 140 | |||
|
|
212 | 130 CONTINUE | |||
|
|
213 | T1 = ATAN(YY/XX) | |||
|
|
214 | T1 = ABS(T1) | |||
|
|
215 | 140 CONTINUE | |||
|
|
216 | IF (T2.GT.CAZ) GO TO 170 | |||
|
|
217 | C----------------------------------------------------------------------- | |||
|
|
218 | C FORWARD RECURRENCE LOOP WHEN ABS(Z).GE.R2 | |||
|
|
219 | C----------------------------------------------------------------------- | |||
|
|
220 | ETEST = AK/(PI*CAZ*TOL) | |||
|
|
221 | FK = 1.0E0 | |||
|
|
222 | IF (ETEST.LT.1.0E0) GO TO 180 | |||
|
|
223 | FKS = 2.0E0 | |||
|
|
224 | RK = CAZ + CAZ + 2.0E0 | |||
|
|
225 | A1 = 0.0E0 | |||
|
|
226 | A2 = 1.0E0 | |||
|
|
227 | DO 150 I=1,KMAX | |||
|
|
228 | AK = FHS/FKS | |||
|
|
229 | BK = RK/(FK+1.0E0) | |||
|
|
230 | TM = A2 | |||
|
|
231 | A2 = BK*A2 - AK*A1 | |||
|
|
232 | A1 = TM | |||
|
|
233 | RK = RK + 2.0E0 | |||
|
|
234 | FKS = FKS + FK + FK + 2.0E0 | |||
|
|
235 | FHS = FHS + FK + FK | |||
|
|
236 | FK = FK + 1.0E0 | |||
|
|
237 | TM = ABS(A2)*FK | |||
|
|
238 | IF (ETEST.LT.TM) GO TO 160 | |||
|
|
239 | 150 CONTINUE | |||
|
|
240 | GO TO 310 | |||
|
|
241 | 160 CONTINUE | |||
|
|
242 | FK = FK + SPI*T1*SQRT(T2/CAZ) | |||
|
|
243 | FHS = ABS(0.25E0-DNU2) | |||
|
|
244 | GO TO 180 | |||
|
|
245 | 170 CONTINUE | |||
|
|
246 | C----------------------------------------------------------------------- | |||
|
|
247 | C COMPUTE BACKWARD INDEX K FOR ABS(Z).LT.R2 | |||
|
|
248 | C----------------------------------------------------------------------- | |||
|
|
249 | A2 = SQRT(CAZ) | |||
|
|
250 | AK = FPI*AK/(TOL*SQRT(A2)) | |||
|
|
251 | AA = 3.0E0*T1/(1.0E0+CAZ) | |||
|
|
252 | BB = 14.7E0*T1/(28.0E0+CAZ) | |||
|
|
253 | AK = (ALOG(AK)+CAZ*COS(AA)/(1.0E0+0.008E0*CAZ))/COS(BB) | |||
|
|
254 | FK = 0.12125E0*AK*AK/CAZ + 1.5E0 | |||
|
|
255 | 180 CONTINUE | |||
|
|
256 | K = FK | |||
|
|
257 | C----------------------------------------------------------------------- | |||
|
|
258 | C BACKWARD RECURRENCE LOOP FOR MILLER ALGORITHM | |||
|
|
259 | C----------------------------------------------------------------------- | |||
|
|
260 | FK = K | |||
|
|
261 | FKS = FK*FK | |||
|
|
262 | P1 = CZERO | |||
|
|
263 | P2 = CMPLX(TOL,0.0E0) | |||
|
|
264 | CS = P2 | |||
|
|
265 | DO 190 I=1,K | |||
|
|
266 | A1 = FKS - FK | |||
|
|
267 | A2 = (FKS+FK)/(A1+FHS) | |||
|
|
268 | RK = 2.0E0/(FK+1.0E0) | |||
|
|
269 | T1 = (FK+XX)*RK | |||
|
|
270 | T2 = YY*RK | |||
|
|
271 | PT = P2 | |||
|
|
272 | P2 = (P2*CMPLX(T1,T2)-P1)*CMPLX(A2,0.0E0) | |||
|
|
273 | P1 = PT | |||
|
|
274 | CS = CS + P2 | |||
|
|
275 | FKS = A1 - FK + 1.0E0 | |||
|
|
276 | FK = FK - 1.0E0 | |||
|
|
277 | 190 CONTINUE | |||
|
|
278 | C----------------------------------------------------------------------- | |||
|
|
279 | C COMPUTE (P2/CS)=(P2/ABS(CS))*(CONJG(CS)/ABS(CS)) FOR BETTER | |||
|
|
280 | C SCALING | |||
|
|
281 | C----------------------------------------------------------------------- | |||
|
|
282 | TM = ABS(CS) | |||
|
|
283 | PT = CMPLX(1.0E0/TM,0.0E0) | |||
|
|
284 | S1 = PT*P2 | |||
|
|
285 | CS = CONJG(CS)*PT | |||
|
|
286 | S1 = COEF*S1*CS | |||
|
|
287 | IF (INU.GT.0 .OR. N.GT.1) GO TO 200 | |||
|
|
288 | ZD = Z | |||
|
|
289 | IF(IFLAG.EQ.1) GO TO 270 | |||
|
|
290 | GO TO 240 | |||
|
|
291 | 200 CONTINUE | |||
|
|
292 | C----------------------------------------------------------------------- | |||
|
|
293 | C COMPUTE P1/P2=(P1/ABS(P2)*CONJG(P2)/ABS(P2) FOR SCALING | |||
|
|
294 | C----------------------------------------------------------------------- | |||
|
|
295 | TM = ABS(P2) | |||
|
|
296 | PT = CMPLX(1.0E0/TM,0.0E0) | |||
|
|
297 | P1 = PT*P1 | |||
|
|
298 | P2 = CONJG(P2)*PT | |||
|
|
299 | PT = P1*P2 | |||
|
|
300 | S2 = S1*(CONE+(CMPLX(DNU+0.5E0,0.0E0)-PT)/Z) | |||
|
|
301 | C----------------------------------------------------------------------- | |||
|
|
302 | C FORWARD RECURSION ON THE THREE TERM RECURSION RELATION WITH | |||
|
|
303 | C SCALING NEAR EXPONENT EXTREMES ON KFLAG=1 OR KFLAG=3 | |||
|
|
304 | C----------------------------------------------------------------------- | |||
|
|
305 | 210 CONTINUE | |||
|
|
306 | CK = CMPLX(DNU+1.0E0,0.0E0)*RZ | |||
|
|
307 | IF (N.EQ.1) INU = INU - 1 | |||
|
|
308 | IF (INU.GT.0) GO TO 220 | |||
|
|
309 | IF (N.EQ.1) S1=S2 | |||
|
|
310 | ZD = Z | |||
|
|
311 | IF(IFLAG.EQ.1) GO TO 270 | |||
|
|
312 | GO TO 240 | |||
|
|
313 | 220 CONTINUE | |||
|
|
314 | INUB = 1 | |||
|
|
315 | IF (IFLAG.EQ.1) GO TO 261 | |||
|
|
316 | 225 CONTINUE | |||
|
|
317 | P1 = CSR(KFLAG) | |||
|
|
318 | ASCLE = BRY(KFLAG) | |||
|
|
319 | DO 230 I=INUB,INU | |||
|
|
320 | ST = S2 | |||
|
|
321 | S2 = CK*S2 + S1 | |||
|
|
322 | S1 = ST | |||
|
|
323 | CK = CK + RZ | |||
|
|
324 | IF (KFLAG.GE.3) GO TO 230 | |||
|
|
325 | P2 = S2*P1 | |||
|
|
326 | P2R = REAL(P2) | |||
|
|
327 | P2I = AIMAG(P2) | |||
|
|
328 | P2R = ABS(P2R) | |||
|
|
329 | P2I = ABS(P2I) | |||
|
|
330 | P2M = MAX(P2R,P2I) | |||
|
|
331 | IF (P2M.LE.ASCLE) GO TO 230 | |||
|
|
332 | KFLAG = KFLAG + 1 | |||
|
|
333 | ASCLE = BRY(KFLAG) | |||
|
|
334 | S1 = S1*P1 | |||
|
|
335 | S2 = P2 | |||
|
|
336 | S1 = S1*CSS(KFLAG) | |||
|
|
337 | S2 = S2*CSS(KFLAG) | |||
|
|
338 | P1 = CSR(KFLAG) | |||
|
|
339 | 230 CONTINUE | |||
|
|
340 | IF (N.EQ.1) S1 = S2 | |||
|
|
341 | 240 CONTINUE | |||
|
|
342 | Y(1) = S1*CSR(KFLAG) | |||
|
|
343 | IF (N.EQ.1) RETURN | |||
|
|
344 | Y(2) = S2*CSR(KFLAG) | |||
|
|
345 | IF (N.EQ.2) RETURN | |||
|
|
346 | KK = 2 | |||
|
|
347 | 250 CONTINUE | |||
|
|
348 | KK = KK + 1 | |||
|
|
349 | IF (KK.GT.N) RETURN | |||
|
|
350 | P1 = CSR(KFLAG) | |||
|
|
351 | ASCLE = BRY(KFLAG) | |||
|
|
352 | DO 260 I=KK,N | |||
|
|
353 | P2 = S2 | |||
|
|
354 | S2 = CK*S2 + S1 | |||
|
|
355 | S1 = P2 | |||
|
|
356 | CK = CK + RZ | |||
|
|
357 | P2 = S2*P1 | |||
|
|
358 | Y(I) = P2 | |||
|
|
359 | IF (KFLAG.GE.3) GO TO 260 | |||
|
|
360 | P2R = REAL(P2) | |||
|
|
361 | P2I = AIMAG(P2) | |||
|
|
362 | P2R = ABS(P2R) | |||
|
|
363 | P2I = ABS(P2I) | |||
|
|
364 | P2M = MAX(P2R,P2I) | |||
|
|
365 | IF (P2M.LE.ASCLE) GO TO 260 | |||
|
|
366 | KFLAG = KFLAG + 1 | |||
|
|
367 | ASCLE = BRY(KFLAG) | |||
|
|
368 | S1 = S1*P1 | |||
|
|
369 | S2 = P2 | |||
|
|
370 | S1 = S1*CSS(KFLAG) | |||
|
|
371 | S2 = S2*CSS(KFLAG) | |||
|
|
372 | P1 = CSR(KFLAG) | |||
|
|
373 | 260 CONTINUE | |||
|
|
374 | RETURN | |||
|
|
375 | C----------------------------------------------------------------------- | |||
|
|
376 | C IFLAG=1 CASES, FORWARD RECURRENCE ON SCALED VALUES ON UNDERFLOW | |||
|
|
377 | C----------------------------------------------------------------------- | |||
|
|
378 | 261 CONTINUE | |||
|
|
379 | HELIM = 0.5E0*ELIM | |||
|
|
380 | ELM = EXP(-ELIM) | |||
|
|
381 | CELM = CMPLX(ELM,0.0) | |||
|
|
382 | ASCLE = BRY(1) | |||
|
|
383 | ZD = Z | |||
|
|
384 | XD = XX | |||
|
|
385 | YD = YY | |||
|
|
386 | IC = -1 | |||
|
|
387 | J = 2 | |||
|
|
388 | DO 262 I=1,INU | |||
|
|
389 | ST = S2 | |||
|
|
390 | S2 = CK*S2+S1 | |||
|
|
391 | S1 = ST | |||
|
|
392 | CK = CK+RZ | |||
|
|
393 | AS = ABS(S2) | |||
|
|
394 | ALAS = ALOG(AS) | |||
|
|
395 | P2R = -XD+ALAS | |||
|
|
396 | IF(P2R.LT.(-ELIM)) GO TO 263 | |||
|
|
397 | P2 = -ZD+CLOG(S2) | |||
|
|
398 | P2R = REAL(P2) | |||
|
|
399 | P2I = AIMAG(P2) | |||
|
|
400 | P2M = EXP(P2R)/TOL | |||
|
|
401 | P1 = CMPLX(P2M,0.0E0)*CMPLX(COS(P2I),SIN(P2I)) | |||
|
|
402 | CALL CUCHK(P1,NW,ASCLE,TOL) | |||
|
|
403 | IF(NW.NE.0) GO TO 263 | |||
|
|
404 | J=3-J | |||
|
|
405 | CY(J) = P1 | |||
|
|
406 | IF(IC.EQ.(I-1)) GO TO 264 | |||
|
|
407 | IC = I | |||
|
|
408 | GO TO 262 | |||
|
|
409 | 263 CONTINUE | |||
|
|
410 | IF(ALAS.LT.HELIM) GO TO 262 | |||
|
|
411 | XD = XD-ELIM | |||
|
|
412 | S1 = S1*CELM | |||
|
|
413 | S2 = S2*CELM | |||
|
|
414 | ZD = CMPLX(XD,YD) | |||
|
|
415 | 262 CONTINUE | |||
|
|
416 | IF(N.EQ.1) S1 = S2 | |||
|
|
417 | GO TO 270 | |||
|
|
418 | 264 CONTINUE | |||
|
|
419 | KFLAG = 1 | |||
|
|
420 | INUB = I+1 | |||
|
|
421 | S2 = CY(J) | |||
|
|
422 | J = 3 - J | |||
|
|
423 | S1 = CY(J) | |||
|
|
424 | IF(INUB.LE.INU) GO TO 225 | |||
|
|
425 | IF(N.EQ.1) S1 = S2 | |||
|
|
426 | GO TO 240 | |||
|
|
427 | 270 CONTINUE | |||
|
|
428 | Y(1) = S1 | |||
|
|
429 | IF (N.EQ.1) GO TO 280 | |||
|
|
430 | Y(2) = S2 | |||
|
|
431 | 280 CONTINUE | |||
|
|
432 | ASCLE = BRY(1) | |||
|
|
433 | CALL CKSCL(ZD, FNU, N, Y, NZ, RZ, ASCLE, TOL, ELIM) | |||
|
|
434 | INU = N - NZ | |||
|
|
435 | IF (INU.LE.0) RETURN | |||
|
|
436 | KK = NZ + 1 | |||
|
|
437 | S1 = Y(KK) | |||
|
|
438 | Y(KK) = S1*CSR(1) | |||
|
|
439 | IF (INU.EQ.1) RETURN | |||
|
|
440 | KK = NZ + 2 | |||
|
|
441 | S2 = Y(KK) | |||
|
|
442 | Y(KK) = S2*CSR(1) | |||
|
|
443 | IF (INU.EQ.2) RETURN | |||
|
|
444 | T2 = FNU + (KK-1) | |||
|
|
445 | CK = CMPLX(T2,0.0E0)*RZ | |||
|
|
446 | KFLAG = 1 | |||
|
|
447 | GO TO 250 | |||
|
|
448 | 290 CONTINUE | |||
|
|
449 | C----------------------------------------------------------------------- | |||
|
|
450 | C SCALE BY EXP(Z), IFLAG = 1 CASES | |||
|
|
451 | C----------------------------------------------------------------------- | |||
|
|
452 | KODED = 2 | |||
|
|
453 | IFLAG = 1 | |||
|
|
454 | KFLAG = 2 | |||
|
|
455 | GO TO 120 | |||
|
|
456 | C----------------------------------------------------------------------- | |||
|
|
457 | C FNU=HALF ODD INTEGER CASE, DNU=-0.5 | |||
|
|
458 | C----------------------------------------------------------------------- | |||
|
|
459 | 300 CONTINUE | |||
|
|
460 | S1 = COEF | |||
|
|
461 | S2 = COEF | |||
|
|
462 | GO TO 210 | |||
|
|
463 | 310 CONTINUE | |||
|
|
464 | NZ=-2 | |||
|
|
465 | RETURN | |||
|
|
466 | END | |||
| @@ -0,0 +1,169 | |||||
|
|
1 | *DECK CBUNI | |||
|
|
2 | SUBROUTINE CBUNI (Z, FNU, KODE, N, Y, NZ, NUI, NLAST, FNUL, TOL, | |||
|
|
3 | + ELIM, ALIM) | |||
|
|
4 | C***BEGIN PROLOGUE CBUNI | |||
|
|
5 | C***SUBSIDIARY | |||
|
|
6 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***TYPE ALL (CBUNI-A, ZBUNI-A) | |||
|
|
9 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
10 | C***DESCRIPTION | |||
|
|
11 | C | |||
|
|
12 | C CBUNI COMPUTES THE I BESSEL FUNCTION FOR LARGE ABS(Z).GT. | |||
|
|
13 | C FNUL AND FNU+N-1.LT.FNUL. THE ORDER IS INCREASED FROM | |||
|
|
14 | C FNU+N-1 GREATER THAN FNUL BY ADDING NUI AND COMPUTING | |||
|
|
15 | C ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR I(FNU,Z) | |||
|
|
16 | C ON IFORM=1 AND THE EXPANSION FOR J(FNU,Z) ON IFORM=2 | |||
|
|
17 | C | |||
|
|
18 | C***SEE ALSO CBESI, CBESK | |||
|
|
19 | C***ROUTINES CALLED CUNI1, CUNI2, R1MACH | |||
|
|
20 | C***REVISION HISTORY (YYMMDD) | |||
|
|
21 | C 830501 DATE WRITTEN | |||
|
|
22 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
23 | C***END PROLOGUE CBUNI | |||
|
|
24 | COMPLEX CSCL, CSCR, CY, RZ, ST, S1, S2, Y, Z | |||
|
|
25 | REAL ALIM, AX, AY, DFNU, ELIM, FNU, FNUI, FNUL, GNU, TOL, XX, YY, | |||
|
|
26 | * ASCLE, BRY, STR, STI, STM, R1MACH | |||
|
|
27 | INTEGER I, IFLAG, IFORM, K, KODE, N, NL, NLAST, NUI, NW, NZ | |||
|
|
28 | DIMENSION Y(N), CY(2), BRY(3) | |||
|
|
29 | C***FIRST EXECUTABLE STATEMENT CBUNI | |||
|
|
30 | NZ = 0 | |||
|
|
31 | XX = REAL(Z) | |||
|
|
32 | YY = AIMAG(Z) | |||
|
|
33 | AX = ABS(XX)*1.7321E0 | |||
|
|
34 | AY = ABS(YY) | |||
|
|
35 | IFORM = 1 | |||
|
|
36 | IF (AY.GT.AX) IFORM = 2 | |||
|
|
37 | IF (NUI.EQ.0) GO TO 60 | |||
|
|
38 | FNUI = NUI | |||
|
|
39 | DFNU = FNU + (N-1) | |||
|
|
40 | GNU = DFNU + FNUI | |||
|
|
41 | IF (IFORM.EQ.2) GO TO 10 | |||
|
|
42 | C----------------------------------------------------------------------- | |||
|
|
43 | C ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN | |||
|
|
44 | C -PI/3.LE.ARG(Z).LE.PI/3 | |||
|
|
45 | C----------------------------------------------------------------------- | |||
|
|
46 | CALL CUNI1(Z, GNU, KODE, 2, CY, NW, NLAST, FNUL, TOL, ELIM, ALIM) | |||
|
|
47 | GO TO 20 | |||
|
|
48 | 10 CONTINUE | |||
|
|
49 | C----------------------------------------------------------------------- | |||
|
|
50 | C ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU | |||
|
|
51 | C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I | |||
|
|
52 | C AND HPI=PI/2 | |||
|
|
53 | C----------------------------------------------------------------------- | |||
|
|
54 | CALL CUNI2(Z, GNU, KODE, 2, CY, NW, NLAST, FNUL, TOL, ELIM, ALIM) | |||
|
|
55 | 20 CONTINUE | |||
|
|
56 | IF (NW.LT.0) GO TO 50 | |||
|
|
57 | IF (NW.NE.0) GO TO 90 | |||
|
|
58 | AY = ABS(CY(1)) | |||
|
|
59 | C---------------------------------------------------------------------- | |||
|
|
60 | C SCALE BACKWARD RECURRENCE, BRY(3) IS DEFINED BUT NEVER USED | |||
|
|
61 | C---------------------------------------------------------------------- | |||
|
|
62 | BRY(1) = 1.0E+3*R1MACH(1)/TOL | |||
|
|
63 | BRY(2) = 1.0E0/BRY(1) | |||
|
|
64 | BRY(3) = BRY(2) | |||
|
|
65 | IFLAG = 2 | |||
|
|
66 | ASCLE = BRY(2) | |||
|
|
67 | AX = 1.0E0 | |||
|
|
68 | CSCL = CMPLX(AX,0.0E0) | |||
|
|
69 | IF (AY.GT.BRY(1)) GO TO 21 | |||
|
|
70 | IFLAG = 1 | |||
|
|
71 | ASCLE = BRY(1) | |||
|
|
72 | AX = 1.0E0/TOL | |||
|
|
73 | CSCL = CMPLX(AX,0.0E0) | |||
|
|
74 | GO TO 25 | |||
|
|
75 | 21 CONTINUE | |||
|
|
76 | IF (AY.LT.BRY(2)) GO TO 25 | |||
|
|
77 | IFLAG = 3 | |||
|
|
78 | ASCLE = BRY(3) | |||
|
|
79 | AX = TOL | |||
|
|
80 | CSCL = CMPLX(AX,0.0E0) | |||
|
|
81 | 25 CONTINUE | |||
|
|
82 | AY = 1.0E0/AX | |||
|
|
83 | CSCR = CMPLX(AY,0.0E0) | |||
|
|
84 | S1 = CY(2)*CSCL | |||
|
|
85 | S2 = CY(1)*CSCL | |||
|
|
86 | RZ = CMPLX(2.0E0,0.0E0)/Z | |||
|
|
87 | DO 30 I=1,NUI | |||
|
|
88 | ST = S2 | |||
|
|
89 | S2 = CMPLX(DFNU+FNUI,0.0E0)*RZ*S2 + S1 | |||
|
|
90 | S1 = ST | |||
|
|
91 | FNUI = FNUI - 1.0E0 | |||
|
|
92 | IF (IFLAG.GE.3) GO TO 30 | |||
|
|
93 | ST = S2*CSCR | |||
|
|
94 | STR = REAL(ST) | |||
|
|
95 | STI = AIMAG(ST) | |||
|
|
96 | STR = ABS(STR) | |||
|
|
97 | STI = ABS(STI) | |||
|
|
98 | STM = MAX(STR,STI) | |||
|
|
99 | IF (STM.LE.ASCLE) GO TO 30 | |||
|
|
100 | IFLAG = IFLAG+1 | |||
|
|
101 | ASCLE = BRY(IFLAG) | |||
|
|
102 | S1 = S1*CSCR | |||
|
|
103 | S2 = ST | |||
|
|
104 | AX = AX*TOL | |||
|
|
105 | AY = 1.0E0/AX | |||
|
|
106 | CSCL = CMPLX(AX,0.0E0) | |||
|
|
107 | CSCR = CMPLX(AY,0.0E0) | |||
|
|
108 | S1 = S1*CSCL | |||
|
|
109 | S2 = S2*CSCL | |||
|
|
110 | 30 CONTINUE | |||
|
|
111 | Y(N) = S2*CSCR | |||
|
|
112 | IF (N.EQ.1) RETURN | |||
|
|
113 | NL = N - 1 | |||
|
|
114 | FNUI = NL | |||
|
|
115 | K = NL | |||
|
|
116 | DO 40 I=1,NL | |||
|
|
117 | ST = S2 | |||
|
|
118 | S2 = CMPLX(FNU+FNUI,0.0E0)*RZ*S2 + S1 | |||
|
|
119 | S1 = ST | |||
|
|
120 | ST = S2*CSCR | |||
|
|
121 | Y(K) = ST | |||
|
|
122 | FNUI = FNUI - 1.0E0 | |||
|
|
123 | K = K - 1 | |||
|
|
124 | IF (IFLAG.GE.3) GO TO 40 | |||
|
|
125 | STR = REAL(ST) | |||
|
|
126 | STI = AIMAG(ST) | |||
|
|
127 | STR = ABS(STR) | |||
|
|
128 | STI = ABS(STI) | |||
|
|
129 | STM = MAX(STR,STI) | |||
|
|
130 | IF (STM.LE.ASCLE) GO TO 40 | |||
|
|
131 | IFLAG = IFLAG+1 | |||
|
|
132 | ASCLE = BRY(IFLAG) | |||
|
|
133 | S1 = S1*CSCR | |||
|
|
134 | S2 = ST | |||
|
|
135 | AX = AX*TOL | |||
|
|
136 | AY = 1.0E0/AX | |||
|
|
137 | CSCL = CMPLX(AX,0.0E0) | |||
|
|
138 | CSCR = CMPLX(AY,0.0E0) | |||
|
|
139 | S1 = S1*CSCL | |||
|
|
140 | S2 = S2*CSCL | |||
|
|
141 | 40 CONTINUE | |||
|
|
142 | RETURN | |||
|
|
143 | 50 CONTINUE | |||
|
|
144 | NZ = -1 | |||
|
|
145 | IF(NW.EQ.(-2)) NZ=-2 | |||
|
|
146 | RETURN | |||
|
|
147 | 60 CONTINUE | |||
|
|
148 | IF (IFORM.EQ.2) GO TO 70 | |||
|
|
149 | C----------------------------------------------------------------------- | |||
|
|
150 | C ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN | |||
|
|
151 | C -PI/3.LE.ARG(Z).LE.PI/3 | |||
|
|
152 | C----------------------------------------------------------------------- | |||
|
|
153 | CALL CUNI1(Z, FNU, KODE, N, Y, NW, NLAST, FNUL, TOL, ELIM, ALIM) | |||
|
|
154 | GO TO 80 | |||
|
|
155 | 70 CONTINUE | |||
|
|
156 | C----------------------------------------------------------------------- | |||
|
|
157 | C ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU | |||
|
|
158 | C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I | |||
|
|
159 | C AND HPI=PI/2 | |||
|
|
160 | C----------------------------------------------------------------------- | |||
|
|
161 | CALL CUNI2(Z, FNU, KODE, N, Y, NW, NLAST, FNUL, TOL, ELIM, ALIM) | |||
|
|
162 | 80 CONTINUE | |||
|
|
163 | IF (NW.LT.0) GO TO 50 | |||
|
|
164 | NZ = NW | |||
|
|
165 | RETURN | |||
|
|
166 | 90 CONTINUE | |||
|
|
167 | NLAST = N | |||
|
|
168 | RETURN | |||
|
|
169 | END | |||
| @@ -0,0 +1,131 | |||||
|
|
1 | *> \brief \b CDOTU | |||
|
|
2 | * | |||
|
|
3 | * =========== DOCUMENTATION =========== | |||
|
|
4 | * | |||
|
|
5 | * Online html documentation available at | |||
|
|
6 | * http://www.netlib.org/lapack/explore-html/ | |||
|
|
7 | * | |||
|
|
8 | * Definition: | |||
|
|
9 | * =========== | |||
|
|
10 | * | |||
|
|
11 | * COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY) | |||
|
|
12 | * | |||
|
|
13 | * .. Scalar Arguments .. | |||
|
|
14 | * INTEGER INCX,INCY,N | |||
|
|
15 | * .. | |||
|
|
16 | * .. Array Arguments .. | |||
|
|
17 | * COMPLEX CX(*),CY(*) | |||
|
|
18 | * .. | |||
|
|
19 | * | |||
|
|
20 | * | |||
|
|
21 | *> \par Purpose: | |||
|
|
22 | * ============= | |||
|
|
23 | *> | |||
|
|
24 | *> \verbatim | |||
|
|
25 | *> | |||
|
|
26 | *> CDOTU forms the dot product of two complex vectors | |||
|
|
27 | *> CDOTU = X^T * Y | |||
|
|
28 | *> | |||
|
|
29 | *> \endverbatim | |||
|
|
30 | * | |||
|
|
31 | * Arguments: | |||
|
|
32 | * ========== | |||
|
|
33 | * | |||
|
|
34 | *> \param[in] N | |||
|
|
35 | *> \verbatim | |||
|
|
36 | *> N is INTEGER | |||
|
|
37 | *> number of elements in input vector(s) | |||
|
|
38 | *> \endverbatim | |||
|
|
39 | *> | |||
|
|
40 | *> \param[in] CX | |||
|
|
41 | *> \verbatim | |||
|
|
42 | *> CX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) | |||
|
|
43 | *> \endverbatim | |||
|
|
44 | *> | |||
|
|
45 | *> \param[in] INCX | |||
|
|
46 | *> \verbatim | |||
|
|
47 | *> INCX is INTEGER | |||
|
|
48 | *> storage spacing between elements of CX | |||
|
|
49 | *> \endverbatim | |||
|
|
50 | *> | |||
|
|
51 | *> \param[in] CY | |||
|
|
52 | *> \verbatim | |||
|
|
53 | *> CY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) | |||
|
|
54 | *> \endverbatim | |||
|
|
55 | *> | |||
|
|
56 | *> \param[in] INCY | |||
|
|
57 | *> \verbatim | |||
|
|
58 | *> INCY is INTEGER | |||
|
|
59 | *> storage spacing between elements of CY | |||
|
|
60 | *> \endverbatim | |||
|
|
61 | * | |||
|
|
62 | * Authors: | |||
|
|
63 | * ======== | |||
|
|
64 | * | |||
|
|
65 | *> \author Univ. of Tennessee | |||
|
|
66 | *> \author Univ. of California Berkeley | |||
|
|
67 | *> \author Univ. of Colorado Denver | |||
|
|
68 | *> \author NAG Ltd. | |||
|
|
69 | * | |||
|
|
70 | *> \date November 2017 | |||
|
|
71 | * | |||
|
|
72 | *> \ingroup complex_blas_level1 | |||
|
|
73 | * | |||
|
|
74 | *> \par Further Details: | |||
|
|
75 | * ===================== | |||
|
|
76 | *> | |||
|
|
77 | *> \verbatim | |||
|
|
78 | *> | |||
|
|
79 | *> jack dongarra, linpack, 3/11/78. | |||
|
|
80 | *> modified 12/3/93, array(1) declarations changed to array(*) | |||
|
|
81 | *> \endverbatim | |||
|
|
82 | *> | |||
|
|
83 | * ===================================================================== | |||
|
|
84 | COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY) | |||
|
|
85 | * | |||
|
|
86 | * -- Reference BLAS level1 routine (version 3.8.0) -- | |||
|
|
87 | * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- | |||
|
|
88 | * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- | |||
|
|
89 | * November 2017 | |||
|
|
90 | * | |||
|
|
91 | * .. Scalar Arguments .. | |||
|
|
92 | INTEGER INCX,INCY,N | |||
|
|
93 | * .. | |||
|
|
94 | * .. Array Arguments .. | |||
|
|
95 | COMPLEX CX(*),CY(*) | |||
|
|
96 | * .. | |||
|
|
97 | * | |||
|
|
98 | * ===================================================================== | |||
|
|
99 | * | |||
|
|
100 | * .. Local Scalars .. | |||
|
|
101 | COMPLEX CTEMP | |||
|
|
102 | INTEGER I,IX,IY | |||
|
|
103 | * .. | |||
|
|
104 | CTEMP = (0.0,0.0) | |||
|
|
105 | CDOTU = (0.0,0.0) | |||
|
|
106 | IF (N.LE.0) RETURN | |||
|
|
107 | IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN | |||
|
|
108 | * | |||
|
|
109 | * code for both increments equal to 1 | |||
|
|
110 | * | |||
|
|
111 | DO I = 1,N | |||
|
|
112 | CTEMP = CTEMP + CX(I)*CY(I) | |||
|
|
113 | END DO | |||
|
|
114 | ELSE | |||
|
|
115 | * | |||
|
|
116 | * code for unequal increments or equal increments | |||
|
|
117 | * not equal to 1 | |||
|
|
118 | * | |||
|
|
119 | IX = 1 | |||
|
|
120 | IY = 1 | |||
|
|
121 | IF (INCX.LT.0) IX = (-N+1)*INCX + 1 | |||
|
|
122 | IF (INCY.LT.0) IY = (-N+1)*INCY + 1 | |||
|
|
123 | DO I = 1,N | |||
|
|
124 | CTEMP = CTEMP + CX(IX)*CY(IY) | |||
|
|
125 | IX = IX + INCX | |||
|
|
126 | IY = IY + INCY | |||
|
|
127 | END DO | |||
|
|
128 | END IF | |||
|
|
129 | CDOTU = CTEMP | |||
|
|
130 | RETURN | |||
|
|
131 | END | |||
| @@ -0,0 +1,112 | |||||
|
|
1 | *DECK CKSCL | |||
|
|
2 | SUBROUTINE CKSCL (ZR, FNU, N, Y, NZ, RZ, ASCLE, TOL, ELIM) | |||
|
|
3 | C***BEGIN PROLOGUE CKSCL | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBKNU, CUNK1 and CUNK2 | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CKSCL-A, ZKSCL-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE | |||
|
|
12 | C ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN | |||
|
|
13 | C RETURN WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL. | |||
|
|
14 | C | |||
|
|
15 | C***SEE ALSO CBKNU, CUNK1, CUNK2 | |||
|
|
16 | C***ROUTINES CALLED CUCHK | |||
|
|
17 | C***REVISION HISTORY (YYMMDD) | |||
|
|
18 | C ?????? DATE WRITTEN | |||
|
|
19 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
20 | C***END PROLOGUE CKSCL | |||
|
|
21 | COMPLEX CK, CS, CY, CZERO, RZ, S1, S2, Y, ZR, ZD, CELM | |||
|
|
22 | REAL AA, ASCLE, ACS, AS, CSI, CSR, ELIM, FN, FNU, TOL, XX, ZRI, | |||
|
|
23 | * ELM, ALAS, HELIM | |||
|
|
24 | INTEGER I, IC, K, KK, N, NN, NW, NZ | |||
|
|
25 | DIMENSION Y(N), CY(2) | |||
|
|
26 | DATA CZERO / (0.0E0,0.0E0) / | |||
|
|
27 | C***FIRST EXECUTABLE STATEMENT CUCHK | |||
|
|
28 | NZ = 0 | |||
|
|
29 | IC = 0 | |||
|
|
30 | XX = REAL(ZR) | |||
|
|
31 | NN = MIN(2,N) | |||
|
|
32 | DO 10 I=1,NN | |||
|
|
33 | S1 = Y(I) | |||
|
|
34 | CY(I) = S1 | |||
|
|
35 | AS = ABS(S1) | |||
|
|
36 | ACS = -XX + ALOG(AS) | |||
|
|
37 | NZ = NZ + 1 | |||
|
|
38 | Y(I) = CZERO | |||
|
|
39 | IF (ACS.LT.(-ELIM)) GO TO 10 | |||
|
|
40 | CS = -ZR + CLOG(S1) | |||
|
|
41 | CSR = REAL(CS) | |||
|
|
42 | CSI = AIMAG(CS) | |||
|
|
43 | AA = EXP(CSR)/TOL | |||
|
|
44 | CS = CMPLX(AA,0.0E0)*CMPLX(COS(CSI),SIN(CSI)) | |||
|
|
45 | CALL CUCHK(CS, NW, ASCLE, TOL) | |||
|
|
46 | IF (NW.NE.0) GO TO 10 | |||
|
|
47 | Y(I) = CS | |||
|
|
48 | NZ = NZ - 1 | |||
|
|
49 | IC = I | |||
|
|
50 | 10 CONTINUE | |||
|
|
51 | IF (N.EQ.1) RETURN | |||
|
|
52 | IF (IC.GT.1) GO TO 20 | |||
|
|
53 | Y(1) = CZERO | |||
|
|
54 | NZ = 2 | |||
|
|
55 | 20 CONTINUE | |||
|
|
56 | IF (N.EQ.2) RETURN | |||
|
|
57 | IF (NZ.EQ.0) RETURN | |||
|
|
58 | FN = FNU + 1.0E0 | |||
|
|
59 | CK = CMPLX(FN,0.0E0)*RZ | |||
|
|
60 | S1 = CY(1) | |||
|
|
61 | S2 = CY(2) | |||
|
|
62 | HELIM = 0.5E0*ELIM | |||
|
|
63 | ELM = EXP(-ELIM) | |||
|
|
64 | CELM = CMPLX(ELM,0.0E0) | |||
|
|
65 | ZRI =AIMAG(ZR) | |||
|
|
66 | ZD = ZR | |||
|
|
67 | C | |||
|
|
68 | C FIND TWO CONSECUTIVE Y VALUES ON SCALE. SCALE RECURRENCE IF | |||
|
|
69 | C S2 GETS LARGER THAN EXP(ELIM/2) | |||
|
|
70 | C | |||
|
|
71 | DO 30 I=3,N | |||
|
|
72 | KK = I | |||
|
|
73 | CS = S2 | |||
|
|
74 | S2 = CK*S2 + S1 | |||
|
|
75 | S1 = CS | |||
|
|
76 | CK = CK + RZ | |||
|
|
77 | AS = ABS(S2) | |||
|
|
78 | ALAS = ALOG(AS) | |||
|
|
79 | ACS = -XX + ALAS | |||
|
|
80 | NZ = NZ + 1 | |||
|
|
81 | Y(I) = CZERO | |||
|
|
82 | IF (ACS.LT.(-ELIM)) GO TO 25 | |||
|
|
83 | CS = -ZD + CLOG(S2) | |||
|
|
84 | CSR = REAL(CS) | |||
|
|
85 | CSI = AIMAG(CS) | |||
|
|
86 | AA = EXP(CSR)/TOL | |||
|
|
87 | CS = CMPLX(AA,0.0E0)*CMPLX(COS(CSI),SIN(CSI)) | |||
|
|
88 | CALL CUCHK(CS, NW, ASCLE, TOL) | |||
|
|
89 | IF (NW.NE.0) GO TO 25 | |||
|
|
90 | Y(I) = CS | |||
|
|
91 | NZ = NZ - 1 | |||
|
|
92 | IF (IC.EQ.(KK-1)) GO TO 40 | |||
|
|
93 | IC = KK | |||
|
|
94 | GO TO 30 | |||
|
|
95 | 25 CONTINUE | |||
|
|
96 | IF(ALAS.LT.HELIM) GO TO 30 | |||
|
|
97 | XX = XX-ELIM | |||
|
|
98 | S1 = S1*CELM | |||
|
|
99 | S2 = S2*CELM | |||
|
|
100 | ZD = CMPLX(XX,ZRI) | |||
|
|
101 | 30 CONTINUE | |||
|
|
102 | NZ = N | |||
|
|
103 | IF(IC.EQ.N) NZ=N-1 | |||
|
|
104 | GO TO 45 | |||
|
|
105 | 40 CONTINUE | |||
|
|
106 | NZ = KK - 2 | |||
|
|
107 | 45 CONTINUE | |||
|
|
108 | DO 50 K=1,NZ | |||
|
|
109 | Y(K) = CZERO | |||
|
|
110 | 50 CONTINUE | |||
|
|
111 | RETURN | |||
|
|
112 | END | |||
| @@ -0,0 +1,166 | |||||
|
|
1 | *DECK CMLRI | |||
|
|
2 | SUBROUTINE CMLRI (Z, FNU, KODE, N, Y, NZ, TOL) | |||
|
|
3 | C***BEGIN PROLOGUE CMLRI | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CMLRI-A, ZMLRI-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CMLRI COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY THE | |||
|
|
12 | C MILLER ALGORITHM NORMALIZED BY A NEUMANN SERIES. | |||
|
|
13 | C | |||
|
|
14 | C***SEE ALSO CBESI, CBESK | |||
|
|
15 | C***ROUTINES CALLED GAMLN, R1MACH | |||
|
|
16 | C***REVISION HISTORY (YYMMDD) | |||
|
|
17 | C 830501 DATE WRITTEN | |||
|
|
18 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
19 | C***END PROLOGUE CMLRI | |||
|
|
20 | COMPLEX CK, CNORM, CONE, CTWO, CZERO, PT, P1, P2, RZ, SUM, Y, Z | |||
|
|
21 | REAL ACK, AK, AP, AT, AZ, BK, FKAP, FKK, FLAM, FNF, FNU, RHO, | |||
|
|
22 | * RHO2, SCLE, TFNF, TOL, TST, X, GAMLN, R1MACH | |||
|
|
23 | INTEGER I, IAZ, IDUM, IFNU, INU, ITIME, K, KK, KM, KODE, M, N, NZ | |||
|
|
24 | DIMENSION Y(N) | |||
|
|
25 | DATA CZERO,CONE,CTWO /(0.0E0,0.0E0),(1.0E0,0.0E0),(2.0E0,0.0E0)/ | |||
|
|
26 | SCLE = 1.0E+3*R1MACH(1)/TOL | |||
|
|
27 | C***FIRST EXECUTABLE STATEMENT CMLRI | |||
|
|
28 | NZ=0 | |||
|
|
29 | AZ = ABS(Z) | |||
|
|
30 | X = REAL(Z) | |||
|
|
31 | IAZ = AZ | |||
|
|
32 | IFNU = FNU | |||
|
|
33 | INU = IFNU + N - 1 | |||
|
|
34 | AT = IAZ + 1.0E0 | |||
|
|
35 | CK = CMPLX(AT,0.0E0)/Z | |||
|
|
36 | RZ = CTWO/Z | |||
|
|
37 | P1 = CZERO | |||
|
|
38 | P2 = CONE | |||
|
|
39 | ACK = (AT+1.0E0)/AZ | |||
|
|
40 | RHO = ACK + SQRT(ACK*ACK-1.0E0) | |||
|
|
41 | RHO2 = RHO*RHO | |||
|
|
42 | TST = (RHO2+RHO2)/((RHO2-1.0E0)*(RHO-1.0E0)) | |||
|
|
43 | TST = TST/TOL | |||
|
|
44 | C----------------------------------------------------------------------- | |||
|
|
45 | C COMPUTE RELATIVE TRUNCATION ERROR INDEX FOR SERIES | |||
|
|
46 | C----------------------------------------------------------------------- | |||
|
|
47 | AK = AT | |||
|
|
48 | DO 10 I=1,80 | |||
|
|
49 | PT = P2 | |||
|
|
50 | P2 = P1 - CK*P2 | |||
|
|
51 | P1 = PT | |||
|
|
52 | CK = CK + RZ | |||
|
|
53 | AP = ABS(P2) | |||
|
|
54 | IF (AP.GT.TST*AK*AK) GO TO 20 | |||
|
|
55 | AK = AK + 1.0E0 | |||
|
|
56 | 10 CONTINUE | |||
|
|
57 | GO TO 110 | |||
|
|
58 | 20 CONTINUE | |||
|
|
59 | I = I + 1 | |||
|
|
60 | K = 0 | |||
|
|
61 | IF (INU.LT.IAZ) GO TO 40 | |||
|
|
62 | C----------------------------------------------------------------------- | |||
|
|
63 | C COMPUTE RELATIVE TRUNCATION ERROR FOR RATIOS | |||
|
|
64 | C----------------------------------------------------------------------- | |||
|
|
65 | P1 = CZERO | |||
|
|
66 | P2 = CONE | |||
|
|
67 | AT = INU + 1.0E0 | |||
|
|
68 | CK = CMPLX(AT,0.0E0)/Z | |||
|
|
69 | ACK = AT/AZ | |||
|
|
70 | TST = SQRT(ACK/TOL) | |||
|
|
71 | ITIME = 1 | |||
|
|
72 | DO 30 K=1,80 | |||
|
|
73 | PT = P2 | |||
|
|
74 | P2 = P1 - CK*P2 | |||
|
|
75 | P1 = PT | |||
|
|
76 | CK = CK + RZ | |||
|
|
77 | AP = ABS(P2) | |||
|
|
78 | IF (AP.LT.TST) GO TO 30 | |||
|
|
79 | IF (ITIME.EQ.2) GO TO 40 | |||
|
|
80 | ACK = ABS(CK) | |||
|
|
81 | FLAM = ACK + SQRT(ACK*ACK-1.0E0) | |||
|
|
82 | FKAP = AP/ABS(P1) | |||
|
|
83 | RHO = MIN(FLAM,FKAP) | |||
|
|
84 | TST = TST*SQRT(RHO/(RHO*RHO-1.0E0)) | |||
|
|
85 | ITIME = 2 | |||
|
|
86 | 30 CONTINUE | |||
|
|
87 | GO TO 110 | |||
|
|
88 | 40 CONTINUE | |||
|
|
89 | C----------------------------------------------------------------------- | |||
|
|
90 | C BACKWARD RECURRENCE AND SUM NORMALIZING RELATION | |||
|
|
91 | C----------------------------------------------------------------------- | |||
|
|
92 | K = K + 1 | |||
|
|
93 | KK = MAX(I+IAZ,K+INU) | |||
|
|
94 | FKK = KK | |||
|
|
95 | P1 = CZERO | |||
|
|
96 | C----------------------------------------------------------------------- | |||
|
|
97 | C SCALE P2 AND SUM BY SCLE | |||
|
|
98 | C----------------------------------------------------------------------- | |||
|
|
99 | P2 = CMPLX(SCLE,0.0E0) | |||
|
|
100 | FNF = FNU - IFNU | |||
|
|
101 | TFNF = FNF + FNF | |||
|
|
102 | BK = GAMLN(FKK+TFNF+1.0E0,IDUM) - GAMLN(FKK+1.0E0,IDUM) | |||
|
|
103 | * -GAMLN(TFNF+1.0E0,IDUM) | |||
|
|
104 | BK = EXP(BK) | |||
|
|
105 | SUM = CZERO | |||
|
|
106 | KM = KK - INU | |||
|
|
107 | DO 50 I=1,KM | |||
|
|
108 | PT = P2 | |||
|
|
109 | P2 = P1 + CMPLX(FKK+FNF,0.0E0)*RZ*P2 | |||
|
|
110 | P1 = PT | |||
|
|
111 | AK = 1.0E0 - TFNF/(FKK+TFNF) | |||
|
|
112 | ACK = BK*AK | |||
|
|
113 | SUM = SUM + CMPLX(ACK+BK,0.0E0)*P1 | |||
|
|
114 | BK = ACK | |||
|
|
115 | FKK = FKK - 1.0E0 | |||
|
|
116 | 50 CONTINUE | |||
|
|
117 | Y(N) = P2 | |||
|
|
118 | IF (N.EQ.1) GO TO 70 | |||
|
|
119 | DO 60 I=2,N | |||
|
|
120 | PT = P2 | |||
|
|
121 | P2 = P1 + CMPLX(FKK+FNF,0.0E0)*RZ*P2 | |||
|
|
122 | P1 = PT | |||
|
|
123 | AK = 1.0E0 - TFNF/(FKK+TFNF) | |||
|
|
124 | ACK = BK*AK | |||
|
|
125 | SUM = SUM + CMPLX(ACK+BK,0.0E0)*P1 | |||
|
|
126 | BK = ACK | |||
|
|
127 | FKK = FKK - 1.0E0 | |||
|
|
128 | M = N - I + 1 | |||
|
|
129 | Y(M) = P2 | |||
|
|
130 | 60 CONTINUE | |||
|
|
131 | 70 CONTINUE | |||
|
|
132 | IF (IFNU.LE.0) GO TO 90 | |||
|
|
133 | DO 80 I=1,IFNU | |||
|
|
134 | PT = P2 | |||
|
|
135 | P2 = P1 + CMPLX(FKK+FNF,0.0E0)*RZ*P2 | |||
|
|
136 | P1 = PT | |||
|
|
137 | AK = 1.0E0 - TFNF/(FKK+TFNF) | |||
|
|
138 | ACK = BK*AK | |||
|
|
139 | SUM = SUM + CMPLX(ACK+BK,0.0E0)*P1 | |||
|
|
140 | BK = ACK | |||
|
|
141 | FKK = FKK - 1.0E0 | |||
|
|
142 | 80 CONTINUE | |||
|
|
143 | 90 CONTINUE | |||
|
|
144 | PT = Z | |||
|
|
145 | IF (KODE.EQ.2) PT = PT - CMPLX(X,0.0E0) | |||
|
|
146 | P1 = -CMPLX(FNF,0.0E0)*CLOG(RZ) + PT | |||
|
|
147 | AP = GAMLN(1.0E0+FNF,IDUM) | |||
|
|
148 | PT = P1 - CMPLX(AP,0.0E0) | |||
|
|
149 | C----------------------------------------------------------------------- | |||
|
|
150 | C THE DIVISION CEXP(PT)/(SUM+P2) IS ALTERED TO AVOID OVERFLOW | |||
|
|
151 | C IN THE DENOMINATOR BY SQUARING LARGE QUANTITIES | |||
|
|
152 | C----------------------------------------------------------------------- | |||
|
|
153 | P2 = P2 + SUM | |||
|
|
154 | AP = ABS(P2) | |||
|
|
155 | P1 = CMPLX(1.0E0/AP,0.0E0) | |||
|
|
156 | CK = CEXP(PT)*P1 | |||
|
|
157 | PT = CONJG(P2)*P1 | |||
|
|
158 | CNORM = CK*PT | |||
|
|
159 | DO 100 I=1,N | |||
|
|
160 | Y(I) = Y(I)*CNORM | |||
|
|
161 | 100 CONTINUE | |||
|
|
162 | RETURN | |||
|
|
163 | 110 CONTINUE | |||
|
|
164 | NZ=-2 | |||
|
|
165 | RETURN | |||
|
|
166 | END | |||
| @@ -0,0 +1,134 | |||||
|
|
1 | #include <math.h> | |||
|
|
2 | ||||
|
|
3 | typedef struct FCOMPLEX {float r,i;} fcomplex; | |||
|
|
4 | ||||
|
|
5 | float Cmod(a) | |||
|
|
6 | fcomplex a; | |||
|
|
7 | { float c; | |||
|
|
8 | c=a.r*a.r+a.i*a.i; | |||
|
|
9 | return c; | |||
|
|
10 | } | |||
|
|
11 | ||||
|
|
12 | fcomplex Cadd(a,b) | |||
|
|
13 | fcomplex a,b; | |||
|
|
14 | { fcomplex c; | |||
|
|
15 | c.r=a.r+b.r; | |||
|
|
16 | c.i=a.i+b.i; | |||
|
|
17 | return c; | |||
|
|
18 | } | |||
|
|
19 | ||||
|
|
20 | fcomplex Csub(a,b) | |||
|
|
21 | fcomplex a,b; | |||
|
|
22 | { fcomplex c; | |||
|
|
23 | c.r=a.r-b.r; | |||
|
|
24 | c.i=a.i-b.i; | |||
|
|
25 | return c; | |||
|
|
26 | } | |||
|
|
27 | ||||
|
|
28 | fcomplex Cmul(a,b) | |||
|
|
29 | fcomplex a,b; | |||
|
|
30 | { fcomplex c; | |||
|
|
31 | c.r=a.r*b.r-a.i*b.i; | |||
|
|
32 | c.i=a.i*b.r+a.r*b.i; | |||
|
|
33 | return c; | |||
|
|
34 | } | |||
|
|
35 | ||||
|
|
36 | fcomplex Complex(re,im) | |||
|
|
37 | float re,im; | |||
|
|
38 | { fcomplex c; | |||
|
|
39 | c.r=re; | |||
|
|
40 | c.i=im; | |||
|
|
41 | return c; | |||
|
|
42 | } | |||
|
|
43 | ||||
|
|
44 | fcomplex Conjg(z) | |||
|
|
45 | fcomplex z; | |||
|
|
46 | { fcomplex c; | |||
|
|
47 | c.r=z.r; | |||
|
|
48 | c.i = -z.i; | |||
|
|
49 | return c; | |||
|
|
50 | } | |||
|
|
51 | ||||
|
|
52 | fcomplex Cdiv(a,b) | |||
|
|
53 | fcomplex a,b; | |||
|
|
54 | { fcomplex c; | |||
|
|
55 | float r,den; | |||
|
|
56 | if (fabs(b.r) >= fabs(b.i)) { | |||
|
|
57 | r=b.i/b.r; | |||
|
|
58 | den=b.r+r*b.i; | |||
|
|
59 | c.r=(a.r+r*a.i)/den; | |||
|
|
60 | c.i=(a.i-r*a.r)/den; | |||
|
|
61 | } else { | |||
|
|
62 | r=b.r/b.i; | |||
|
|
63 | den=b.i+r*b.r; | |||
|
|
64 | c.r=(a.r*r+a.i)/den; | |||
|
|
65 | c.i=(a.i*r-a.r)/den; | |||
|
|
66 | } | |||
|
|
67 | return c; | |||
|
|
68 | } | |||
|
|
69 | ||||
|
|
70 | float Cabs(z) | |||
|
|
71 | fcomplex z; | |||
|
|
72 | { float x,y,ans,temp; | |||
|
|
73 | x=fabs(z.r); | |||
|
|
74 | y=fabs(z.i); | |||
|
|
75 | if (x == 0.0) | |||
|
|
76 | ans=y; | |||
|
|
77 | else if (y == 0.0) | |||
|
|
78 | ans=x; | |||
|
|
79 | else if (x > y) { | |||
|
|
80 | temp=y/x; | |||
|
|
81 | ans=x*sqrt(1.0+temp*temp); | |||
|
|
82 | } else { | |||
|
|
83 | temp=x/y; | |||
|
|
84 | ans=y*sqrt(1.0+temp*temp); | |||
|
|
85 | } | |||
|
|
86 | return ans; | |||
|
|
87 | } | |||
|
|
88 | ||||
|
|
89 | fcomplex Csqrt(z) | |||
|
|
90 | fcomplex z; | |||
|
|
91 | { fcomplex c; | |||
|
|
92 | float x,y,w,r; | |||
|
|
93 | if ((z.r == 0.0) && (z.i == 0.0)) { | |||
|
|
94 | c.r=0.0; | |||
|
|
95 | c.i=0.0; | |||
|
|
96 | return c; | |||
|
|
97 | } else { | |||
|
|
98 | x=fabs(z.r); | |||
|
|
99 | y=fabs(z.i); | |||
|
|
100 | if (x >= y) { | |||
|
|
101 | r=y/x; | |||
|
|
102 | w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r))); | |||
|
|
103 | } else { | |||
|
|
104 | r=x/y; | |||
|
|
105 | w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r))); | |||
|
|
106 | } | |||
|
|
107 | if (z.r >= 0.0) { | |||
|
|
108 | c.r=w; | |||
|
|
109 | c.i=z.i/(2.0*w); | |||
|
|
110 | } else { | |||
|
|
111 | c.i=(z.i >= 0) ? w : -w; | |||
|
|
112 | c.r=z.i/(2.0*c.i); | |||
|
|
113 | } | |||
|
|
114 | return c; | |||
|
|
115 | } | |||
|
|
116 | } | |||
|
|
117 | ||||
|
|
118 | fcomplex RCmul(x,a) | |||
|
|
119 | float x; | |||
|
|
120 | fcomplex a; | |||
|
|
121 | { fcomplex c; | |||
|
|
122 | c.r=x*a.r; | |||
|
|
123 | c.i=x*a.i; | |||
|
|
124 | return c; | |||
|
|
125 | } | |||
|
|
126 | ||||
|
|
127 | fcomplex RCdiv(a,x) | |||
|
|
128 | float x; | |||
|
|
129 | fcomplex a; | |||
|
|
130 | { fcomplex c; | |||
|
|
131 | c.r=a.r/x; | |||
|
|
132 | c.i=a.i/x; | |||
|
|
133 | return c; | |||
|
|
134 | } | |||
| @@ -0,0 +1,13 | |||||
|
|
1 | typedef struct FCOMPLEX {float r,i;} fcomplex; | |||
|
|
2 | ||||
|
|
3 | extern float Cmod(); | |||
|
|
4 | extern fcomplex Cadd(); | |||
|
|
5 | extern fcomplex Csub(); | |||
|
|
6 | extern fcomplex Cmul(); | |||
|
|
7 | extern fcomplex Complex(); | |||
|
|
8 | extern fcomplex Conjg(); | |||
|
|
9 | extern fcomplex Cdiv(); | |||
|
|
10 | extern float Cabs(); | |||
|
|
11 | extern fcomplex Csqrt(); | |||
|
|
12 | extern fcomplex RCmul(); | |||
|
|
13 | extern fcomplex RCdiv(); | |||
| @@ -0,0 +1,111 | |||||
|
|
1 | *DECK CRATI | |||
|
|
2 | SUBROUTINE CRATI (Z, FNU, N, CY, TOL) | |||
|
|
3 | C***BEGIN PROLOGUE CRATI | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBESH, CBESI and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CRATI-A, ZRATI-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CRATI COMPUTES RATIOS OF I BESSEL FUNCTIONS BY BACKWARD | |||
|
|
12 | C RECURRENCE. THE STARTING INDEX IS DETERMINED BY FORWARD | |||
|
|
13 | C RECURRENCE AS DESCRIBED IN J. RES. OF NAT. BUR. OF STANDARDS-B, | |||
|
|
14 | C MATHEMATICAL SCIENCES, VOL 77B, P111-114, SEPTEMBER, 1973, | |||
|
|
15 | C BESSEL FUNCTIONS I AND J OF COMPLEX ARGUMENT AND INTEGER ORDER, | |||
|
|
16 | C BY D. J. SOOKNE. | |||
|
|
17 | C | |||
|
|
18 | C***SEE ALSO CBESH, CBESI, CBESK | |||
|
|
19 | C***ROUTINES CALLED (NONE) | |||
|
|
20 | C***REVISION HISTORY (YYMMDD) | |||
|
|
21 | C 830501 DATE WRITTEN | |||
|
|
22 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
23 | C***END PROLOGUE CRATI | |||
|
|
24 | COMPLEX CDFNU, CONE, CY, CZERO, PT, P1, P2, RZ, T1, Z | |||
|
|
25 | REAL AK, AMAGZ, AP1, AP2, ARG, AZ, DFNU, FDNU, FLAM, FNU, FNUP, | |||
|
|
26 | * RAP1, RHO, TEST, TEST1, TOL | |||
|
|
27 | INTEGER I, ID, IDNU, INU, ITIME, K, KK, MAGZ, N | |||
|
|
28 | DIMENSION CY(N) | |||
|
|
29 | DATA CZERO, CONE / (0.0E0,0.0E0), (1.0E0,0.0E0) / | |||
|
|
30 | C***FIRST EXECUTABLE STATEMENT CRATI | |||
|
|
31 | AZ = ABS(Z) | |||
|
|
32 | INU = FNU | |||
|
|
33 | IDNU = INU + N - 1 | |||
|
|
34 | FDNU = IDNU | |||
|
|
35 | MAGZ = AZ | |||
|
|
36 | AMAGZ = MAGZ+1 | |||
|
|
37 | FNUP = MAX(AMAGZ,FDNU) | |||
|
|
38 | ID = IDNU - MAGZ - 1 | |||
|
|
39 | ITIME = 1 | |||
|
|
40 | K = 1 | |||
|
|
41 | RZ = (CONE+CONE)/Z | |||
|
|
42 | T1 = CMPLX(FNUP,0.0E0)*RZ | |||
|
|
43 | P2 = -T1 | |||
|
|
44 | P1 = CONE | |||
|
|
45 | T1 = T1 + RZ | |||
|
|
46 | IF (ID.GT.0) ID = 0 | |||
|
|
47 | AP2 = ABS(P2) | |||
|
|
48 | AP1 = ABS(P1) | |||
|
|
49 | C----------------------------------------------------------------------- | |||
|
|
50 | C THE OVERFLOW TEST ON K(FNU+I-1,Z) BEFORE THE CALL TO CBKNX | |||
|
|
51 | C GUARANTEES THAT P2 IS ON SCALE. SCALE TEST1 AND ALL SUBSEQUENT | |||
|
|
52 | C P2 VALUES BY AP1 TO ENSURE THAT AN OVERFLOW DOES NOT OCCUR | |||
|
|
53 | C PREMATURELY. | |||
|
|
54 | C----------------------------------------------------------------------- | |||
|
|
55 | ARG = (AP2+AP2)/(AP1*TOL) | |||
|
|
56 | TEST1 = SQRT(ARG) | |||
|
|
57 | TEST = TEST1 | |||
|
|
58 | RAP1 = 1.0E0/AP1 | |||
|
|
59 | P1 = P1*CMPLX(RAP1,0.0E0) | |||
|
|
60 | P2 = P2*CMPLX(RAP1,0.0E0) | |||
|
|
61 | AP2 = AP2*RAP1 | |||
|
|
62 | 10 CONTINUE | |||
|
|
63 | K = K + 1 | |||
|
|
64 | AP1 = AP2 | |||
|
|
65 | PT = P2 | |||
|
|
66 | P2 = P1 - T1*P2 | |||
|
|
67 | P1 = PT | |||
|
|
68 | T1 = T1 + RZ | |||
|
|
69 | AP2 = ABS(P2) | |||
|
|
70 | IF (AP1.LE.TEST) GO TO 10 | |||
|
|
71 | IF (ITIME.EQ.2) GO TO 20 | |||
|
|
72 | AK = ABS(T1)*0.5E0 | |||
|
|
73 | FLAM = AK + SQRT(AK*AK-1.0E0) | |||
|
|
74 | RHO = MIN(AP2/AP1,FLAM) | |||
|
|
75 | TEST = TEST1*SQRT(RHO/(RHO*RHO-1.0E0)) | |||
|
|
76 | ITIME = 2 | |||
|
|
77 | GO TO 10 | |||
|
|
78 | 20 CONTINUE | |||
|
|
79 | KK = K + 1 - ID | |||
|
|
80 | AK = KK | |||
|
|
81 | DFNU = FNU + (N-1) | |||
|
|
82 | CDFNU = CMPLX(DFNU,0.0E0) | |||
|
|
83 | T1 = CMPLX(AK,0.0E0) | |||
|
|
84 | P1 = CMPLX(1.0E0/AP2,0.0E0) | |||
|
|
85 | P2 = CZERO | |||
|
|
86 | DO 30 I=1,KK | |||
|
|
87 | PT = P1 | |||
|
|
88 | P1 = RZ*(CDFNU+T1)*P1 + P2 | |||
|
|
89 | P2 = PT | |||
|
|
90 | T1 = T1 - CONE | |||
|
|
91 | 30 CONTINUE | |||
|
|
92 | IF (REAL(P1).NE.0.0E0 .OR. AIMAG(P1).NE.0.0E0) GO TO 40 | |||
|
|
93 | P1 = CMPLX(TOL,TOL) | |||
|
|
94 | 40 CONTINUE | |||
|
|
95 | CY(N) = P2/P1 | |||
|
|
96 | IF (N.EQ.1) RETURN | |||
|
|
97 | K = N - 1 | |||
|
|
98 | AK = K | |||
|
|
99 | T1 = CMPLX(AK,0.0E0) | |||
|
|
100 | CDFNU = CMPLX(FNU,0.0E0)*RZ | |||
|
|
101 | DO 60 I=2,N | |||
|
|
102 | PT = CDFNU + T1*RZ + CY(K+1) | |||
|
|
103 | IF (REAL(PT).NE.0.0E0 .OR. AIMAG(PT).NE.0.0E0) GO TO 50 | |||
|
|
104 | PT = CMPLX(TOL,TOL) | |||
|
|
105 | 50 CONTINUE | |||
|
|
106 | CY(K) = CONE/PT | |||
|
|
107 | T1 = T1 - CONE | |||
|
|
108 | K = K - 1 | |||
|
|
109 | 60 CONTINUE | |||
|
|
110 | RETURN | |||
|
|
111 | END | |||
| @@ -0,0 +1,55 | |||||
|
|
1 | *DECK CS1S2 | |||
|
|
2 | SUBROUTINE CS1S2 (ZR, S1, S2, NZ, ASCLE, ALIM, IUF) | |||
|
|
3 | C***BEGIN PROLOGUE CS1S2 | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CAIRY and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CS1S2-A, ZS1S2-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CS1S2 TESTS FOR A POSSIBLE UNDERFLOW RESULTING FROM THE | |||
|
|
12 | C ADDITION OF THE I AND K FUNCTIONS IN THE ANALYTIC CON- | |||
|
|
13 | C TINUATION FORMULA WHERE S1=K FUNCTION AND S2=I FUNCTION. | |||
|
|
14 | C ON KODE=1 THE I AND K FUNCTIONS ARE DIFFERENT ORDERS OF | |||
|
|
15 | C MAGNITUDE, BUT FOR KODE=2 THEY CAN BE OF THE SAME ORDER | |||
|
|
16 | C OF MAGNITUDE AND THE MAXIMUM MUST BE AT LEAST ONE | |||
|
|
17 | C PRECISION ABOVE THE UNDERFLOW LIMIT. | |||
|
|
18 | C | |||
|
|
19 | C***SEE ALSO CAIRY, CBESK | |||
|
|
20 | C***ROUTINES CALLED (NONE) | |||
|
|
21 | C***REVISION HISTORY (YYMMDD) | |||
|
|
22 | C 830501 DATE WRITTEN | |||
|
|
23 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
24 | C***END PROLOGUE CS1S2 | |||
|
|
25 | COMPLEX CZERO, C1, S1, S1D, S2, ZR | |||
|
|
26 | REAL AA, ALIM, ALN, ASCLE, AS1, AS2, XX | |||
|
|
27 | INTEGER IUF, NZ | |||
|
|
28 | DATA CZERO / (0.0E0,0.0E0) / | |||
|
|
29 | C***FIRST EXECUTABLE STATEMENT CS1S2 | |||
|
|
30 | NZ = 0 | |||
|
|
31 | AS1 = ABS(S1) | |||
|
|
32 | AS2 = ABS(S2) | |||
|
|
33 | AA = REAL(S1) | |||
|
|
34 | ALN = AIMAG(S1) | |||
|
|
35 | IF (AA.EQ.0.0E0 .AND. ALN.EQ.0.0E0) GO TO 10 | |||
|
|
36 | IF (AS1.EQ.0.0E0) GO TO 10 | |||
|
|
37 | XX = REAL(ZR) | |||
|
|
38 | ALN = -XX - XX + ALOG(AS1) | |||
|
|
39 | S1D = S1 | |||
|
|
40 | S1 = CZERO | |||
|
|
41 | AS1 = 0.0E0 | |||
|
|
42 | IF (ALN.LT.(-ALIM)) GO TO 10 | |||
|
|
43 | C1 = CLOG(S1D) - ZR - ZR | |||
|
|
44 | S1 = CEXP(C1) | |||
|
|
45 | AS1 = ABS(S1) | |||
|
|
46 | IUF = IUF + 1 | |||
|
|
47 | 10 CONTINUE | |||
|
|
48 | AA = MAX(AS1,AS2) | |||
|
|
49 | IF (AA.GT.ASCLE) RETURN | |||
|
|
50 | S1 = CZERO | |||
|
|
51 | S2 = CZERO | |||
|
|
52 | NZ = 1 | |||
|
|
53 | IUF = 0 | |||
|
|
54 | RETURN | |||
|
|
55 | END | |||
| @@ -0,0 +1,164 | |||||
|
|
1 | *DECK CSERI | |||
|
|
2 | SUBROUTINE CSERI (Z, FNU, KODE, N, Y, NZ, TOL, ELIM, ALIM) | |||
|
|
3 | C***BEGIN PROLOGUE CSERI | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CSERI-A, ZSERI-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CSERI COMPUTES THE I BESSEL FUNCTION FOR REAL(Z).GE.0.0 BY | |||
|
|
12 | C MEANS OF THE POWER SERIES FOR LARGE ABS(Z) IN THE | |||
|
|
13 | C REGION ABS(Z).LE.2*SQRT(FNU+1). NZ=0 IS A NORMAL RETURN. | |||
|
|
14 | C NZ.GT.0 MEANS THAT THE LAST NZ COMPONENTS WERE SET TO ZERO | |||
|
|
15 | C DUE TO UNDERFLOW. NZ.LT.0 MEANS UNDERFLOW OCCURRED, BUT THE | |||
|
|
16 | C CONDITION ABS(Z).LE.2*SQRT(FNU+1) WAS VIOLATED AND THE | |||
|
|
17 | C COMPUTATION MUST BE COMPLETED IN ANOTHER ROUTINE WITH N=N-ABS(NZ). | |||
|
|
18 | C | |||
|
|
19 | C***SEE ALSO CBESI, CBESK | |||
|
|
20 | C***ROUTINES CALLED CUCHK, GAMLN, R1MACH | |||
|
|
21 | C***REVISION HISTORY (YYMMDD) | |||
|
|
22 | C 830501 DATE WRITTEN | |||
|
|
23 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
24 | C***END PROLOGUE CSERI | |||
|
|
25 | COMPLEX AK1, CK, COEF, CONE, CRSC, CZ, CZERO, HZ, RZ, S1, S2, W, | |||
|
|
26 | * Y, Z | |||
|
|
27 | REAL AA, ACZ, AK, ALIM, ARM, ASCLE, ATOL, AZ, DFNU, ELIM, FNU, | |||
|
|
28 | * FNUP, RAK1, RS, RTR1, S, SS, TOL, X, GAMLN, R1MACH | |||
|
|
29 | INTEGER I, IB, IDUM, IFLAG, IL, K, KODE, L, M, N, NN, NW, NZ | |||
|
|
30 | DIMENSION Y(N), W(2) | |||
|
|
31 | DATA CZERO, CONE / (0.0E0,0.0E0), (1.0E0,0.0E0) / | |||
|
|
32 | C***FIRST EXECUTABLE STATEMENT CSERI | |||
|
|
33 | NZ = 0 | |||
|
|
34 | AZ = ABS(Z) | |||
|
|
35 | IF (AZ.EQ.0.0E0) GO TO 150 | |||
|
|
36 | X = REAL(Z) | |||
|
|
37 | ARM = 1.0E+3*R1MACH(1) | |||
|
|
38 | RTR1 = SQRT(ARM) | |||
|
|
39 | CRSC = CMPLX(1.0E0,0.0E0) | |||
|
|
40 | IFLAG = 0 | |||
|
|
41 | IF (AZ.LT.ARM) GO TO 140 | |||
|
|
42 | HZ = Z*CMPLX(0.5E0,0.0E0) | |||
|
|
43 | CZ = CZERO | |||
|
|
44 | IF (AZ.GT.RTR1) CZ = HZ*HZ | |||
|
|
45 | ACZ = ABS(CZ) | |||
|
|
46 | NN = N | |||
|
|
47 | CK = CLOG(HZ) | |||
|
|
48 | 10 CONTINUE | |||
|
|
49 | DFNU = FNU + (NN-1) | |||
|
|
50 | FNUP = DFNU + 1.0E0 | |||
|
|
51 | C----------------------------------------------------------------------- | |||
|
|
52 | C UNDERFLOW TEST | |||
|
|
53 | C----------------------------------------------------------------------- | |||
|
|
54 | AK1 = CK*CMPLX(DFNU,0.0E0) | |||
|
|
55 | AK = GAMLN(FNUP,IDUM) | |||
|
|
56 | AK1 = AK1 - CMPLX(AK,0.0E0) | |||
|
|
57 | IF (KODE.EQ.2) AK1 = AK1 - CMPLX(X,0.0E0) | |||
|
|
58 | RAK1 = REAL(AK1) | |||
|
|
59 | IF (RAK1.GT.(-ELIM)) GO TO 30 | |||
|
|
60 | 20 CONTINUE | |||
|
|
61 | NZ = NZ + 1 | |||
|
|
62 | Y(NN) = CZERO | |||
|
|
63 | IF (ACZ.GT.DFNU) GO TO 170 | |||
|
|
64 | NN = NN - 1 | |||
|
|
65 | IF (NN.EQ.0) RETURN | |||
|
|
66 | GO TO 10 | |||
|
|
67 | 30 CONTINUE | |||
|
|
68 | IF (RAK1.GT.(-ALIM)) GO TO 40 | |||
|
|
69 | IFLAG = 1 | |||
|
|
70 | SS = 1.0E0/TOL | |||
|
|
71 | CRSC = CMPLX(TOL,0.0E0) | |||
|
|
72 | ASCLE = ARM*SS | |||
|
|
73 | 40 CONTINUE | |||
|
|
74 | AK = AIMAG(AK1) | |||
|
|
75 | AA = EXP(RAK1) | |||
|
|
76 | IF (IFLAG.EQ.1) AA = AA*SS | |||
|
|
77 | COEF = CMPLX(AA,0.0E0)*CMPLX(COS(AK),SIN(AK)) | |||
|
|
78 | ATOL = TOL*ACZ/FNUP | |||
|
|
79 | IL = MIN(2,NN) | |||
|
|
80 | DO 80 I=1,IL | |||
|
|
81 | DFNU = FNU + (NN-I) | |||
|
|
82 | FNUP = DFNU + 1.0E0 | |||
|
|
83 | S1 = CONE | |||
|
|
84 | IF (ACZ.LT.TOL*FNUP) GO TO 60 | |||
|
|
85 | AK1 = CONE | |||
|
|
86 | AK = FNUP + 2.0E0 | |||
|
|
87 | S = FNUP | |||
|
|
88 | AA = 2.0E0 | |||
|
|
89 | 50 CONTINUE | |||
|
|
90 | RS = 1.0E0/S | |||
|
|
91 | AK1 = AK1*CZ*CMPLX(RS,0.0E0) | |||
|
|
92 | S1 = S1 + AK1 | |||
|
|
93 | S = S + AK | |||
|
|
94 | AK = AK + 2.0E0 | |||
|
|
95 | AA = AA*ACZ*RS | |||
|
|
96 | IF (AA.GT.ATOL) GO TO 50 | |||
|
|
97 | 60 CONTINUE | |||
|
|
98 | M = NN - I + 1 | |||
|
|
99 | S2 = S1*COEF | |||
|
|
100 | W(I) = S2 | |||
|
|
101 | IF (IFLAG.EQ.0) GO TO 70 | |||
|
|
102 | CALL CUCHK(S2, NW, ASCLE, TOL) | |||
|
|
103 | IF (NW.NE.0) GO TO 20 | |||
|
|
104 | 70 CONTINUE | |||
|
|
105 | Y(M) = S2*CRSC | |||
|
|
106 | IF (I.NE.IL) COEF = COEF*CMPLX(DFNU,0.0E0)/HZ | |||
|
|
107 | 80 CONTINUE | |||
|
|
108 | IF (NN.LE.2) RETURN | |||
|
|
109 | K = NN - 2 | |||
|
|
110 | AK = K | |||
|
|
111 | RZ = (CONE+CONE)/Z | |||
|
|
112 | IF (IFLAG.EQ.1) GO TO 110 | |||
|
|
113 | IB = 3 | |||
|
|
114 | 90 CONTINUE | |||
|
|
115 | DO 100 I=IB,NN | |||
|
|
116 | Y(K) = CMPLX(AK+FNU,0.0E0)*RZ*Y(K+1) + Y(K+2) | |||
|
|
117 | AK = AK - 1.0E0 | |||
|
|
118 | K = K - 1 | |||
|
|
119 | 100 CONTINUE | |||
|
|
120 | RETURN | |||
|
|
121 | C----------------------------------------------------------------------- | |||
|
|
122 | C RECUR BACKWARD WITH SCALED VALUES | |||
|
|
123 | C----------------------------------------------------------------------- | |||
|
|
124 | 110 CONTINUE | |||
|
|
125 | C----------------------------------------------------------------------- | |||
|
|
126 | C EXP(-ALIM)=EXP(-ELIM)/TOL=APPROX. ONE PRECISION ABOVE THE | |||
|
|
127 | C UNDERFLOW LIMIT = ASCLE = R1MACH(1)*CSCL*1.0E+3 | |||
|
|
128 | C----------------------------------------------------------------------- | |||
|
|
129 | S1 = W(1) | |||
|
|
130 | S2 = W(2) | |||
|
|
131 | DO 120 L=3,NN | |||
|
|
132 | CK = S2 | |||
|
|
133 | S2 = S1 + CMPLX(AK+FNU,0.0E0)*RZ*S2 | |||
|
|
134 | S1 = CK | |||
|
|
135 | CK = S2*CRSC | |||
|
|
136 | Y(K) = CK | |||
|
|
137 | AK = AK - 1.0E0 | |||
|
|
138 | K = K - 1 | |||
|
|
139 | IF (ABS(CK).GT.ASCLE) GO TO 130 | |||
|
|
140 | 120 CONTINUE | |||
|
|
141 | RETURN | |||
|
|
142 | 130 CONTINUE | |||
|
|
143 | IB = L + 1 | |||
|
|
144 | IF (IB.GT.NN) RETURN | |||
|
|
145 | GO TO 90 | |||
|
|
146 | 140 CONTINUE | |||
|
|
147 | NZ = N | |||
|
|
148 | IF (FNU.EQ.0.0E0) NZ = NZ - 1 | |||
|
|
149 | 150 CONTINUE | |||
|
|
150 | Y(1) = CZERO | |||
|
|
151 | IF (FNU.EQ.0.0E0) Y(1) = CONE | |||
|
|
152 | IF (N.EQ.1) RETURN | |||
|
|
153 | DO 160 I=2,N | |||
|
|
154 | Y(I) = CZERO | |||
|
|
155 | 160 CONTINUE | |||
|
|
156 | RETURN | |||
|
|
157 | C----------------------------------------------------------------------- | |||
|
|
158 | C RETURN WITH NZ.LT.0 IF ABS(Z*Z/4).GT.FNU+N-NZ-1 COMPLETE | |||
|
|
159 | C THE CALCULATION IN CBINU WITH N=N-ABS(NZ) | |||
|
|
160 | C----------------------------------------------------------------------- | |||
|
|
161 | 170 CONTINUE | |||
|
|
162 | NZ = -NZ | |||
|
|
163 | RETURN | |||
|
|
164 | END | |||
| @@ -0,0 +1,36 | |||||
|
|
1 | *DECK CSHCH | |||
|
|
2 | SUBROUTINE CSHCH (Z, CSH, CCH) | |||
|
|
3 | C***BEGIN PROLOGUE CSHCH | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBESH and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CSHCH-A, ZSHCH-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CSHCH COMPUTES THE COMPLEX HYPERBOLIC FUNCTIONS CSH=SINH(X+I*Y) | |||
|
|
12 | C AND CCH=COSH(X+I*Y), WHERE I**2=-1. | |||
|
|
13 | C | |||
|
|
14 | C***SEE ALSO CBESH, CBESK | |||
|
|
15 | C***ROUTINES CALLED (NONE) | |||
|
|
16 | C***REVISION HISTORY (YYMMDD) | |||
|
|
17 | C 830501 DATE WRITTEN | |||
|
|
18 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
19 | C***END PROLOGUE CSHCH | |||
|
|
20 | COMPLEX CCH, CSH, Z | |||
|
|
21 | REAL CCHI, CCHR, CH, CN, CSHI, CSHR, SH, SN, X, Y | |||
|
|
22 | C***FIRST EXECUTABLE STATEMENT CSHCH | |||
|
|
23 | X = REAL(Z) | |||
|
|
24 | Y = AIMAG(Z) | |||
|
|
25 | SH = SINH(X) | |||
|
|
26 | CH = COSH(X) | |||
|
|
27 | SN = SIN(Y) | |||
|
|
28 | CN = COS(Y) | |||
|
|
29 | CSHR = SH*CN | |||
|
|
30 | CSHI = CH*SN | |||
|
|
31 | CSH = CMPLX(CSHR,CSHI) | |||
|
|
32 | CCHR = CH*CN | |||
|
|
33 | CCHI = SH*SN | |||
|
|
34 | CCH = CMPLX(CCHR,CCHI) | |||
|
|
35 | RETURN | |||
|
|
36 | END | |||
| @@ -0,0 +1,171 | |||||
|
|
1 | subroutine csisl(a,lda,n,kpvt,b) | |||
|
|
2 | integer lda,n,kpvt(1) | |||
|
|
3 | complex a(lda,1),b(1) | |||
|
|
4 | c | |||
|
|
5 | c csisl solves the complex symmetric system | |||
|
|
6 | c a * x = b | |||
|
|
7 | c using the factors computed by csifa. | |||
|
|
8 | c | |||
|
|
9 | c on entry | |||
|
|
10 | c | |||
|
|
11 | c a complex(lda,n) | |||
|
|
12 | c the output from csifa. | |||
|
|
13 | c | |||
|
|
14 | c lda integer | |||
|
|
15 | c the leading dimension of the array a . | |||
|
|
16 | c | |||
|
|
17 | c n integer | |||
|
|
18 | c the order of the matrix a . | |||
|
|
19 | c | |||
|
|
20 | c kpvt integer(n) | |||
|
|
21 | c the pivot vector from csifa. | |||
|
|
22 | c | |||
|
|
23 | c b complex(n) | |||
|
|
24 | c the right hand side vector. | |||
|
|
25 | c | |||
|
|
26 | c on return | |||
|
|
27 | c | |||
|
|
28 | c b the solution vector x . | |||
|
|
29 | c | |||
|
|
30 | c error condition | |||
|
|
31 | c | |||
|
|
32 | c a division by zero may occur if csico has set rcond .eq. 0.0 | |||
|
|
33 | c or csifa has set info .ne. 0 . | |||
|
|
34 | c | |||
|
|
35 | c to compute inverse(a) * c where c is a matrix | |||
|
|
36 | c with p columns | |||
|
|
37 | c call csifa(a,lda,n,kpvt,info) | |||
|
|
38 | c if (info .ne. 0) go to ... | |||
|
|
39 | c do 10 j = 1, p | |||
|
|
40 | c call csisl(a,lda,n,kpvt,c(1,j)) | |||
|
|
41 | c 10 continue | |||
|
|
42 | c | |||
|
|
43 | c linpack. this version dated 08/14/78 . | |||
|
|
44 | c james bunch, univ. calif. san diego, argonne nat. lab. | |||
|
|
45 | c | |||
|
|
46 | c subroutines and functions | |||
|
|
47 | c | |||
|
|
48 | c blas caxpy,cdotu | |||
|
|
49 | c fortran iabs | |||
|
|
50 | c | |||
|
|
51 | c internal variables. | |||
|
|
52 | c | |||
|
|
53 | complex ak,akm1,bk,bkm1,cdotu,denom,temp | |||
|
|
54 | integer k,kp | |||
|
|
55 | c | |||
|
|
56 | c loop backward applying the transformations and | |||
|
|
57 | c d inverse to b. | |||
|
|
58 | c | |||
|
|
59 | k = n | |||
|
|
60 | 10 if (k .eq. 0) go to 80 | |||
|
|
61 | if (kpvt(k) .lt. 0) go to 40 | |||
|
|
62 | c | |||
|
|
63 | c 1 x 1 pivot block. | |||
|
|
64 | c | |||
|
|
65 | if (k .eq. 1) go to 30 | |||
|
|
66 | kp = kpvt(k) | |||
|
|
67 | if (kp .eq. k) go to 20 | |||
|
|
68 | c | |||
|
|
69 | c interchange. | |||
|
|
70 | c | |||
|
|
71 | temp = b(k) | |||
|
|
72 | b(k) = b(kp) | |||
|
|
73 | b(kp) = temp | |||
|
|
74 | 20 continue | |||
|
|
75 | c | |||
|
|
76 | c apply the transformation. | |||
|
|
77 | c | |||
|
|
78 | call caxpy(k-1,b(k),a(1,k),1,b(1),1) | |||
|
|
79 | 30 continue | |||
|
|
80 | c | |||
|
|
81 | c apply d inverse. | |||
|
|
82 | c | |||
|
|
83 | b(k) = b(k)/a(k,k) | |||
|
|
84 | k = k - 1 | |||
|
|
85 | go to 70 | |||
|
|
86 | 40 continue | |||
|
|
87 | c | |||
|
|
88 | c 2 x 2 pivot block. | |||
|
|
89 | c | |||
|
|
90 | if (k .eq. 2) go to 60 | |||
|
|
91 | kp = iabs(kpvt(k)) | |||
|
|
92 | if (kp .eq. k - 1) go to 50 | |||
|
|
93 | c | |||
|
|
94 | c interchange. | |||
|
|
95 | c | |||
|
|
96 | temp = b(k-1) | |||
|
|
97 | b(k-1) = b(kp) | |||
|
|
98 | b(kp) = temp | |||
|
|
99 | 50 continue | |||
|
|
100 | c | |||
|
|
101 | c apply the transformation. | |||
|
|
102 | c | |||
|
|
103 | call caxpy(k-2,b(k),a(1,k),1,b(1),1) | |||
|
|
104 | call caxpy(k-2,b(k-1),a(1,k-1),1,b(1),1) | |||
|
|
105 | 60 continue | |||
|
|
106 | c | |||
|
|
107 | c apply d inverse. | |||
|
|
108 | c | |||
|
|
109 | ak = a(k,k)/a(k-1,k) | |||
|
|
110 | akm1 = a(k-1,k-1)/a(k-1,k) | |||
|
|
111 | bk = b(k)/a(k-1,k) | |||
|
|
112 | bkm1 = b(k-1)/a(k-1,k) | |||
|
|
113 | denom = ak*akm1 - 1.0e0 | |||
|
|
114 | b(k) = (akm1*bk - bkm1)/denom | |||
|
|
115 | b(k-1) = (ak*bkm1 - bk)/denom | |||
|
|
116 | k = k - 2 | |||
|
|
117 | 70 continue | |||
|
|
118 | go to 10 | |||
|
|
119 | 80 continue | |||
|
|
120 | c | |||
|
|
121 | c loop forward applying the transformations. | |||
|
|
122 | c | |||
|
|
123 | k = 1 | |||
|
|
124 | 90 if (k .gt. n) go to 160 | |||
|
|
125 | if (kpvt(k) .lt. 0) go to 120 | |||
|
|
126 | c | |||
|
|
127 | c 1 x 1 pivot block. | |||
|
|
128 | c | |||
|
|
129 | if (k .eq. 1) go to 110 | |||
|
|
130 | c | |||
|
|
131 | c apply the transformation. | |||
|
|
132 | c | |||
|
|
133 | b(k) = b(k) + cdotu(k-1,a(1,k),1,b(1),1) | |||
|
|
134 | kp = kpvt(k) | |||
|
|
135 | if (kp .eq. k) go to 100 | |||
|
|
136 | c | |||
|
|
137 | c interchange. | |||
|
|
138 | c | |||
|
|
139 | temp = b(k) | |||
|
|
140 | b(k) = b(kp) | |||
|
|
141 | b(kp) = temp | |||
|
|
142 | 100 continue | |||
|
|
143 | 110 continue | |||
|
|
144 | k = k + 1 | |||
|
|
145 | go to 150 | |||
|
|
146 | 120 continue | |||
|
|
147 | c | |||
|
|
148 | c 2 x 2 pivot block. | |||
|
|
149 | c | |||
|
|
150 | if (k .eq. 1) go to 140 | |||
|
|
151 | c | |||
|
|
152 | c apply the transformation. | |||
|
|
153 | c | |||
|
|
154 | b(k) = b(k) + cdotu(k-1,a(1,k),1,b(1),1) | |||
|
|
155 | b(k+1) = b(k+1) + cdotu(k-1,a(1,k+1),1,b(1),1) | |||
|
|
156 | kp = iabs(kpvt(k)) | |||
|
|
157 | if (kp .eq. k) go to 130 | |||
|
|
158 | c | |||
|
|
159 | c interchange. | |||
|
|
160 | c | |||
|
|
161 | temp = b(k) | |||
|
|
162 | b(k) = b(kp) | |||
|
|
163 | b(kp) = temp | |||
|
|
164 | 130 continue | |||
|
|
165 | 140 continue | |||
|
|
166 | k = k + 2 | |||
|
|
167 | 150 continue | |||
|
|
168 | go to 90 | |||
|
|
169 | 160 continue | |||
|
|
170 | return | |||
|
|
171 | end | |||
| @@ -0,0 +1,42 | |||||
|
|
1 | *DECK CUCHK | |||
|
|
2 | SUBROUTINE CUCHK (Y, NZ, ASCLE, TOL) | |||
|
|
3 | C***BEGIN PROLOGUE CUCHK | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to SERI, CUOIK, CUNK1, CUNK2, CUNI1, CUNI2 and | |||
|
|
6 | C CKSCL | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***TYPE ALL (CUCHK-A, ZUCHK-A) | |||
|
|
9 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
10 | C***DESCRIPTION | |||
|
|
11 | C | |||
|
|
12 | C Y ENTERS AS A SCALED QUANTITY WHOSE MAGNITUDE IS GREATER THAN | |||
|
|
13 | C EXP(-ALIM)=ASCLE=1.0E+3*R1MACH(1)/TOL. THE TEST IS MADE TO SEE | |||
|
|
14 | C IF THE MAGNITUDE OF THE REAL OR IMAGINARY PART WOULD UNDER FLOW | |||
|
|
15 | C WHEN Y IS SCALED (BY TOL) TO ITS PROPER VALUE. Y IS ACCEPTED | |||
|
|
16 | C IF THE UNDERFLOW IS AT LEAST ONE PRECISION BELOW THE MAGNITUDE | |||
|
|
17 | C OF THE LARGEST COMPONENT; OTHERWISE THE PHASE ANGLE DOES NOT HAVE | |||
|
|
18 | C ABSOLUTE ACCURACY AND AN UNDERFLOW IS ASSUMED. | |||
|
|
19 | C | |||
|
|
20 | C***SEE ALSO CKSCL, CUNI1, CUNI2, CUNK1, CUNK2, CUOIK, SERI | |||
|
|
21 | C***ROUTINES CALLED (NONE) | |||
|
|
22 | C***REVISION HISTORY (YYMMDD) | |||
|
|
23 | C ?????? DATE WRITTEN | |||
|
|
24 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
25 | C***END PROLOGUE CUCHK | |||
|
|
26 | C | |||
|
|
27 | COMPLEX Y | |||
|
|
28 | REAL ASCLE, SS, ST, TOL, YR, YI | |||
|
|
29 | INTEGER NZ | |||
|
|
30 | C***FIRST EXECUTABLE STATEMENT CUCHK | |||
|
|
31 | NZ = 0 | |||
|
|
32 | YR = REAL(Y) | |||
|
|
33 | YI = AIMAG(Y) | |||
|
|
34 | YR = ABS(YR) | |||
|
|
35 | YI = ABS(YI) | |||
|
|
36 | ST = MIN(YR,YI) | |||
|
|
37 | IF (ST.GT.ASCLE) RETURN | |||
|
|
38 | SS = MAX(YR,YI) | |||
|
|
39 | ST=ST/TOL | |||
|
|
40 | IF (SS.LT.ST) NZ = 1 | |||
|
|
41 | RETURN | |||
|
|
42 | END | |||
| This diff has been collapsed as it changes many lines, (658 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,658 | |||||
|
|
1 | *DECK CUNHJ | |||
|
|
2 | SUBROUTINE CUNHJ (Z, FNU, IPMTR, TOL, PHI, ARG, ZETA1, ZETA2, | |||
|
|
3 | + ASUM, BSUM) | |||
|
|
4 | C***BEGIN PROLOGUE CUNHJ | |||
|
|
5 | C***SUBSIDIARY | |||
|
|
6 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***TYPE ALL (CUNHJ-A, ZUNHJ-A) | |||
|
|
9 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
10 | C***DESCRIPTION | |||
|
|
11 | C | |||
|
|
12 | C REFERENCES | |||
|
|
13 | C HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A. | |||
|
|
14 | C STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9. | |||
|
|
15 | C | |||
|
|
16 | C ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC | |||
|
|
17 | C PRESS, N.Y., 1974, PAGE 420 | |||
|
|
18 | C | |||
|
|
19 | C ABSTRACT | |||
|
|
20 | C CUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) = | |||
|
|
21 | C J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU | |||
|
|
22 | C BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION | |||
|
|
23 | C | |||
|
|
24 | C C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) ) | |||
|
|
25 | C | |||
|
|
26 | C FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS | |||
|
|
27 | C AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE. | |||
|
|
28 | C | |||
|
|
29 | C (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2, | |||
|
|
30 | C | |||
|
|
31 | C ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING | |||
|
|
32 | C PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY. | |||
|
|
33 | C | |||
|
|
34 | C MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND | |||
|
|
35 | C MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR= | |||
|
|
36 | C 1 COMPUTES ALL EXCEPT ASUM AND BSUM. | |||
|
|
37 | C | |||
|
|
38 | C***SEE ALSO CBESI, CBESK | |||
|
|
39 | C***ROUTINES CALLED R1MACH | |||
|
|
40 | C***REVISION HISTORY (YYMMDD) | |||
|
|
41 | C 830501 DATE WRITTEN | |||
|
|
42 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
43 | C***END PROLOGUE CUNHJ | |||
|
|
44 | COMPLEX ARG, ASUM, BSUM, CFNU, CONE, CR, CZERO, DR, P, PHI, | |||
|
|
45 | * PRZTH, PTFN, RFN13, RTZTA, RZTH, SUMA, SUMB, TFN, T2, UP, W, W2, | |||
|
|
46 | * Z, ZA, ZB, ZC, ZETA, ZETA1, ZETA2, ZTH | |||
|
|
47 | REAL ALFA, ANG, AP, AR, ATOL, AW2, AZTH, BETA, BR, BTOL, C, EX1, | |||
|
|
48 | * EX2, FNU, FN13, FN23, GAMA, HPI, PI, PP, RFNU, RFNU2, THPI, TOL, | |||
|
|
49 | * WI, WR, ZCI, ZCR, ZETAI, ZETAR, ZTHI, ZTHR, ASUMR, ASUMI, BSUMR, | |||
|
|
50 | * BSUMI, TEST, TSTR, TSTI, AC, R1MACH | |||
|
|
51 | INTEGER IAS, IBS, IPMTR, IS, J, JR, JU, K, KMAX, KP1, KS, L, LR, | |||
|
|
52 | * LRP1, L1, L2, M | |||
|
|
53 | DIMENSION AR(14), BR(14), C(105), ALFA(180), BETA(210), GAMA(30), | |||
|
|
54 | * AP(30), P(30), UP(14), CR(14), DR(14) | |||
|
|
55 | DATA AR(1), AR(2), AR(3), AR(4), AR(5), AR(6), AR(7), AR(8), | |||
|
|
56 | 1 AR(9), AR(10), AR(11), AR(12), AR(13), AR(14)/ | |||
|
|
57 | 2 1.00000000000000000E+00, 1.04166666666666667E-01, | |||
|
|
58 | 3 8.35503472222222222E-02, 1.28226574556327160E-01, | |||
|
|
59 | 4 2.91849026464140464E-01, 8.81627267443757652E-01, | |||
|
|
60 | 5 3.32140828186276754E+00, 1.49957629868625547E+01, | |||
|
|
61 | 6 7.89230130115865181E+01, 4.74451538868264323E+02, | |||
|
|
62 | 7 3.20749009089066193E+03, 2.40865496408740049E+04, | |||
|
|
63 | 8 1.98923119169509794E+05, 1.79190200777534383E+06/ | |||
|
|
64 | DATA BR(1), BR(2), BR(3), BR(4), BR(5), BR(6), BR(7), BR(8), | |||
|
|
65 | 1 BR(9), BR(10), BR(11), BR(12), BR(13), BR(14)/ | |||
|
|
66 | 2 1.00000000000000000E+00, -1.45833333333333333E-01, | |||
|
|
67 | 3 -9.87413194444444444E-02, -1.43312053915895062E-01, | |||
|
|
68 | 4 -3.17227202678413548E-01, -9.42429147957120249E-01, | |||
|
|
69 | 5 -3.51120304082635426E+00, -1.57272636203680451E+01, | |||
|
|
70 | 6 -8.22814390971859444E+01, -4.92355370523670524E+02, | |||
|
|
71 | 7 -3.31621856854797251E+03, -2.48276742452085896E+04, | |||
|
|
72 | 8 -2.04526587315129788E+05, -1.83844491706820990E+06/ | |||
|
|
73 | DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10), | |||
|
|
74 | 1 C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18), | |||
|
|
75 | 2 C(19), C(20), C(21), C(22), C(23), C(24)/ | |||
|
|
76 | 3 1.00000000000000000E+00, -2.08333333333333333E-01, | |||
|
|
77 | 4 1.25000000000000000E-01, 3.34201388888888889E-01, | |||
|
|
78 | 5 -4.01041666666666667E-01, 7.03125000000000000E-02, | |||
|
|
79 | 6 -1.02581259645061728E+00, 1.84646267361111111E+00, | |||
|
|
80 | 7 -8.91210937500000000E-01, 7.32421875000000000E-02, | |||
|
|
81 | 8 4.66958442342624743E+00, -1.12070026162229938E+01, | |||
|
|
82 | 9 8.78912353515625000E+00, -2.36408691406250000E+00, | |||
|
|
83 | A 1.12152099609375000E-01, -2.82120725582002449E+01, | |||
|
|
84 | B 8.46362176746007346E+01, -9.18182415432400174E+01, | |||
|
|
85 | C 4.25349987453884549E+01, -7.36879435947963170E+00, | |||
|
|
86 | D 2.27108001708984375E-01, 2.12570130039217123E+02, | |||
|
|
87 | E -7.65252468141181642E+02, 1.05999045252799988E+03/ | |||
|
|
88 | DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32), | |||
|
|
89 | 1 C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40), | |||
|
|
90 | 2 C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/ | |||
|
|
91 | 3 -6.99579627376132541E+02, 2.18190511744211590E+02, | |||
|
|
92 | 4 -2.64914304869515555E+01, 5.72501420974731445E-01, | |||
|
|
93 | 5 -1.91945766231840700E+03, 8.06172218173730938E+03, | |||
|
|
94 | 6 -1.35865500064341374E+04, 1.16553933368645332E+04, | |||
|
|
95 | 7 -5.30564697861340311E+03, 1.20090291321635246E+03, | |||
|
|
96 | 8 -1.08090919788394656E+02, 1.72772750258445740E+00, | |||
|
|
97 | 9 2.02042913309661486E+04, -9.69805983886375135E+04, | |||
|
|
98 | A 1.92547001232531532E+05, -2.03400177280415534E+05, | |||
|
|
99 | B 1.22200464983017460E+05, -4.11926549688975513E+04, | |||
|
|
100 | C 7.10951430248936372E+03, -4.93915304773088012E+02, | |||
|
|
101 | D 6.07404200127348304E+00, -2.42919187900551333E+05, | |||
|
|
102 | E 1.31176361466297720E+06, -2.99801591853810675E+06/ | |||
|
|
103 | DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56), | |||
|
|
104 | 1 C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64), | |||
|
|
105 | 2 C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/ | |||
|
|
106 | 3 3.76327129765640400E+06, -2.81356322658653411E+06, | |||
|
|
107 | 4 1.26836527332162478E+06, -3.31645172484563578E+05, | |||
|
|
108 | 5 4.52187689813627263E+04, -2.49983048181120962E+03, | |||
|
|
109 | 6 2.43805296995560639E+01, 3.28446985307203782E+06, | |||
|
|
110 | 7 -1.97068191184322269E+07, 5.09526024926646422E+07, | |||
|
|
111 | 8 -7.41051482115326577E+07, 6.63445122747290267E+07, | |||
|
|
112 | 9 -3.75671766607633513E+07, 1.32887671664218183E+07, | |||
|
|
113 | A -2.78561812808645469E+06, 3.08186404612662398E+05, | |||
|
|
114 | B -1.38860897537170405E+04, 1.10017140269246738E+02, | |||
|
|
115 | C -4.93292536645099620E+07, 3.25573074185765749E+08, | |||
|
|
116 | D -9.39462359681578403E+08, 1.55359689957058006E+09, | |||
|
|
117 | E -1.62108055210833708E+09, 1.10684281682301447E+09/ | |||
|
|
118 | DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80), | |||
|
|
119 | 1 C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88), | |||
|
|
120 | 2 C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/ | |||
|
|
121 | 3 -4.95889784275030309E+08, 1.42062907797533095E+08, | |||
|
|
122 | 4 -2.44740627257387285E+07, 2.24376817792244943E+06, | |||
|
|
123 | 5 -8.40054336030240853E+04, 5.51335896122020586E+02, | |||
|
|
124 | 6 8.14789096118312115E+08, -5.86648149205184723E+09, | |||
|
|
125 | 7 1.86882075092958249E+10, -3.46320433881587779E+10, | |||
|
|
126 | 8 4.12801855797539740E+10, -3.30265997498007231E+10, | |||
|
|
127 | 9 1.79542137311556001E+10, -6.56329379261928433E+09, | |||
|
|
128 | A 1.55927986487925751E+09, -2.25105661889415278E+08, | |||
|
|
129 | B 1.73951075539781645E+07, -5.49842327572288687E+05, | |||
|
|
130 | C 3.03809051092238427E+03, -1.46792612476956167E+10, | |||
|
|
131 | D 1.14498237732025810E+11, -3.99096175224466498E+11, | |||
|
|
132 | E 8.19218669548577329E+11, -1.09837515608122331E+12/ | |||
|
|
133 | DATA C(97), C(98), C(99), C(100), C(101), C(102), C(103), C(104), | |||
|
|
134 | 1 C(105)/ | |||
|
|
135 | 2 1.00815810686538209E+12, -6.45364869245376503E+11, | |||
|
|
136 | 3 2.87900649906150589E+11, -8.78670721780232657E+10, | |||
|
|
137 | 4 1.76347306068349694E+10, -2.16716498322379509E+09, | |||
|
|
138 | 5 1.43157876718888981E+08, -3.87183344257261262E+06, | |||
|
|
139 | 6 1.82577554742931747E+04/ | |||
|
|
140 | DATA ALFA(1), ALFA(2), ALFA(3), ALFA(4), ALFA(5), ALFA(6), | |||
|
|
141 | 1 ALFA(7), ALFA(8), ALFA(9), ALFA(10), ALFA(11), ALFA(12), | |||
|
|
142 | 2 ALFA(13), ALFA(14), ALFA(15), ALFA(16), ALFA(17), ALFA(18), | |||
|
|
143 | 3 ALFA(19), ALFA(20), ALFA(21), ALFA(22)/ | |||
|
|
144 | 4 -4.44444444444444444E-03, -9.22077922077922078E-04, | |||
|
|
145 | 5 -8.84892884892884893E-05, 1.65927687832449737E-04, | |||
|
|
146 | 6 2.46691372741792910E-04, 2.65995589346254780E-04, | |||
|
|
147 | 7 2.61824297061500945E-04, 2.48730437344655609E-04, | |||
|
|
148 | 8 2.32721040083232098E-04, 2.16362485712365082E-04, | |||
|
|
149 | 9 2.00738858762752355E-04, 1.86267636637545172E-04, | |||
|
|
150 | A 1.73060775917876493E-04, 1.61091705929015752E-04, | |||
|
|
151 | B 1.50274774160908134E-04, 1.40503497391269794E-04, | |||
|
|
152 | C 1.31668816545922806E-04, 1.23667445598253261E-04, | |||
|
|
153 | D 1.16405271474737902E-04, 1.09798298372713369E-04, | |||
|
|
154 | E 1.03772410422992823E-04, 9.82626078369363448E-05/ | |||
|
|
155 | DATA ALFA(23), ALFA(24), ALFA(25), ALFA(26), ALFA(27), ALFA(28), | |||
|
|
156 | 1 ALFA(29), ALFA(30), ALFA(31), ALFA(32), ALFA(33), ALFA(34), | |||
|
|
157 | 2 ALFA(35), ALFA(36), ALFA(37), ALFA(38), ALFA(39), ALFA(40), | |||
|
|
158 | 3 ALFA(41), ALFA(42), ALFA(43), ALFA(44)/ | |||
|
|
159 | 4 9.32120517249503256E-05, 8.85710852478711718E-05, | |||
|
|
160 | 5 8.42963105715700223E-05, 8.03497548407791151E-05, | |||
|
|
161 | 6 7.66981345359207388E-05, 7.33122157481777809E-05, | |||
|
|
162 | 7 7.01662625163141333E-05, 6.72375633790160292E-05, | |||
|
|
163 | 8 6.93735541354588974E-04, 2.32241745182921654E-04, | |||
|
|
164 | 9 -1.41986273556691197E-05, -1.16444931672048640E-04, | |||
|
|
165 | A -1.50803558053048762E-04, -1.55121924918096223E-04, | |||
|
|
166 | B -1.46809756646465549E-04, -1.33815503867491367E-04, | |||
|
|
167 | C -1.19744975684254051E-04, -1.06184319207974020E-04, | |||
|
|
168 | D -9.37699549891194492E-05, -8.26923045588193274E-05, | |||
|
|
169 | E -7.29374348155221211E-05, -6.44042357721016283E-05/ | |||
|
|
170 | DATA ALFA(45), ALFA(46), ALFA(47), ALFA(48), ALFA(49), ALFA(50), | |||
|
|
171 | 1 ALFA(51), ALFA(52), ALFA(53), ALFA(54), ALFA(55), ALFA(56), | |||
|
|
172 | 2 ALFA(57), ALFA(58), ALFA(59), ALFA(60), ALFA(61), ALFA(62), | |||
|
|
173 | 3 ALFA(63), ALFA(64), ALFA(65), ALFA(66)/ | |||
|
|
174 | 4 -5.69611566009369048E-05, -5.04731044303561628E-05, | |||
|
|
175 | 5 -4.48134868008882786E-05, -3.98688727717598864E-05, | |||
|
|
176 | 6 -3.55400532972042498E-05, -3.17414256609022480E-05, | |||
|
|
177 | 7 -2.83996793904174811E-05, -2.54522720634870566E-05, | |||
|
|
178 | 8 -2.28459297164724555E-05, -2.05352753106480604E-05, | |||
|
|
179 | 9 -1.84816217627666085E-05, -1.66519330021393806E-05, | |||
|
|
180 | A -1.50179412980119482E-05, -1.35554031379040526E-05, | |||
|
|
181 | B -1.22434746473858131E-05, -1.10641884811308169E-05, | |||
|
|
182 | C -3.54211971457743841E-04, -1.56161263945159416E-04, | |||
|
|
183 | D 3.04465503594936410E-05, 1.30198655773242693E-04, | |||
|
|
184 | E 1.67471106699712269E-04, 1.70222587683592569E-04/ | |||
|
|
185 | DATA ALFA(67), ALFA(68), ALFA(69), ALFA(70), ALFA(71), ALFA(72), | |||
|
|
186 | 1 ALFA(73), ALFA(74), ALFA(75), ALFA(76), ALFA(77), ALFA(78), | |||
|
|
187 | 2 ALFA(79), ALFA(80), ALFA(81), ALFA(82), ALFA(83), ALFA(84), | |||
|
|
188 | 3 ALFA(85), ALFA(86), ALFA(87), ALFA(88)/ | |||
|
|
189 | 4 1.56501427608594704E-04, 1.36339170977445120E-04, | |||
|
|
190 | 5 1.14886692029825128E-04, 9.45869093034688111E-05, | |||
|
|
191 | 6 7.64498419250898258E-05, 6.07570334965197354E-05, | |||
|
|
192 | 7 4.74394299290508799E-05, 3.62757512005344297E-05, | |||
|
|
193 | 8 2.69939714979224901E-05, 1.93210938247939253E-05, | |||
|
|
194 | 9 1.30056674793963203E-05, 7.82620866744496661E-06, | |||
|
|
195 | A 3.59257485819351583E-06, 1.44040049814251817E-07, | |||
|
|
196 | B -2.65396769697939116E-06, -4.91346867098485910E-06, | |||
|
|
197 | C -6.72739296091248287E-06, -8.17269379678657923E-06, | |||
|
|
198 | D -9.31304715093561232E-06, -1.02011418798016441E-05, | |||
|
|
199 | E -1.08805962510592880E-05, -1.13875481509603555E-05/ | |||
|
|
200 | DATA ALFA(89), ALFA(90), ALFA(91), ALFA(92), ALFA(93), ALFA(94), | |||
|
|
201 | 1 ALFA(95), ALFA(96), ALFA(97), ALFA(98), ALFA(99), ALFA(100), | |||
|
|
202 | 2 ALFA(101), ALFA(102), ALFA(103), ALFA(104), ALFA(105), | |||
|
|
203 | 3 ALFA(106), ALFA(107), ALFA(108), ALFA(109), ALFA(110)/ | |||
|
|
204 | 4 -1.17519675674556414E-05, -1.19987364870944141E-05, | |||
|
|
205 | 5 3.78194199201772914E-04, 2.02471952761816167E-04, | |||
|
|
206 | 6 -6.37938506318862408E-05, -2.38598230603005903E-04, | |||
|
|
207 | 7 -3.10916256027361568E-04, -3.13680115247576316E-04, | |||
|
|
208 | 8 -2.78950273791323387E-04, -2.28564082619141374E-04, | |||
|
|
209 | 9 -1.75245280340846749E-04, -1.25544063060690348E-04, | |||
|
|
210 | A -8.22982872820208365E-05, -4.62860730588116458E-05, | |||
|
|
211 | B -1.72334302366962267E-05, 5.60690482304602267E-06, | |||
|
|
212 | C 2.31395443148286800E-05, 3.62642745856793957E-05, | |||
|
|
213 | D 4.58006124490188752E-05, 5.24595294959114050E-05, | |||
|
|
214 | E 5.68396208545815266E-05, 5.94349820393104052E-05/ | |||
|
|
215 | DATA ALFA(111), ALFA(112), ALFA(113), ALFA(114), ALFA(115), | |||
|
|
216 | 1 ALFA(116), ALFA(117), ALFA(118), ALFA(119), ALFA(120), | |||
|
|
217 | 2 ALFA(121), ALFA(122), ALFA(123), ALFA(124), ALFA(125), | |||
|
|
218 | 3 ALFA(126), ALFA(127), ALFA(128), ALFA(129), ALFA(130)/ | |||
|
|
219 | 4 6.06478527578421742E-05, 6.08023907788436497E-05, | |||
|
|
220 | 5 6.01577894539460388E-05, 5.89199657344698500E-05, | |||
|
|
221 | 6 5.72515823777593053E-05, 5.52804375585852577E-05, | |||
|
|
222 | 7 5.31063773802880170E-05, 5.08069302012325706E-05, | |||
|
|
223 | 8 4.84418647620094842E-05, 4.60568581607475370E-05, | |||
|
|
224 | 9 -6.91141397288294174E-04, -4.29976633058871912E-04, | |||
|
|
225 | A 1.83067735980039018E-04, 6.60088147542014144E-04, | |||
|
|
226 | B 8.75964969951185931E-04, 8.77335235958235514E-04, | |||
|
|
227 | C 7.49369585378990637E-04, 5.63832329756980918E-04, | |||
|
|
228 | D 3.68059319971443156E-04, 1.88464535514455599E-04/ | |||
|
|
229 | DATA ALFA(131), ALFA(132), ALFA(133), ALFA(134), ALFA(135), | |||
|
|
230 | 1 ALFA(136), ALFA(137), ALFA(138), ALFA(139), ALFA(140), | |||
|
|
231 | 2 ALFA(141), ALFA(142), ALFA(143), ALFA(144), ALFA(145), | |||
|
|
232 | 3 ALFA(146), ALFA(147), ALFA(148), ALFA(149), ALFA(150)/ | |||
|
|
233 | 4 3.70663057664904149E-05, -8.28520220232137023E-05, | |||
|
|
234 | 5 -1.72751952869172998E-04, -2.36314873605872983E-04, | |||
|
|
235 | 6 -2.77966150694906658E-04, -3.02079514155456919E-04, | |||
|
|
236 | 7 -3.12594712643820127E-04, -3.12872558758067163E-04, | |||
|
|
237 | 8 -3.05678038466324377E-04, -2.93226470614557331E-04, | |||
|
|
238 | 9 -2.77255655582934777E-04, -2.59103928467031709E-04, | |||
|
|
239 | A -2.39784014396480342E-04, -2.20048260045422848E-04, | |||
|
|
240 | B -2.00443911094971498E-04, -1.81358692210970687E-04, | |||
|
|
241 | C -1.63057674478657464E-04, -1.45712672175205844E-04, | |||
|
|
242 | D -1.29425421983924587E-04, -1.14245691942445952E-04/ | |||
|
|
243 | DATA ALFA(151), ALFA(152), ALFA(153), ALFA(154), ALFA(155), | |||
|
|
244 | 1 ALFA(156), ALFA(157), ALFA(158), ALFA(159), ALFA(160), | |||
|
|
245 | 2 ALFA(161), ALFA(162), ALFA(163), ALFA(164), ALFA(165), | |||
|
|
246 | 3 ALFA(166), ALFA(167), ALFA(168), ALFA(169), ALFA(170)/ | |||
|
|
247 | 4 1.92821964248775885E-03, 1.35592576302022234E-03, | |||
|
|
248 | 5 -7.17858090421302995E-04, -2.58084802575270346E-03, | |||
|
|
249 | 6 -3.49271130826168475E-03, -3.46986299340960628E-03, | |||
|
|
250 | 7 -2.82285233351310182E-03, -1.88103076404891354E-03, | |||
|
|
251 | 8 -8.89531718383947600E-04, 3.87912102631035228E-06, | |||
|
|
252 | 9 7.28688540119691412E-04, 1.26566373053457758E-03, | |||
|
|
253 | A 1.62518158372674427E-03, 1.83203153216373172E-03, | |||
|
|
254 | B 1.91588388990527909E-03, 1.90588846755546138E-03, | |||
|
|
255 | C 1.82798982421825727E-03, 1.70389506421121530E-03, | |||
|
|
256 | D 1.55097127171097686E-03, 1.38261421852276159E-03/ | |||
|
|
257 | DATA ALFA(171), ALFA(172), ALFA(173), ALFA(174), ALFA(175), | |||
|
|
258 | 1 ALFA(176), ALFA(177), ALFA(178), ALFA(179), ALFA(180)/ | |||
|
|
259 | 2 1.20881424230064774E-03, 1.03676532638344962E-03, | |||
|
|
260 | 3 8.71437918068619115E-04, 7.16080155297701002E-04, | |||
|
|
261 | 4 5.72637002558129372E-04, 4.42089819465802277E-04, | |||
|
|
262 | 5 3.24724948503090564E-04, 2.20342042730246599E-04, | |||
|
|
263 | 6 1.28412898401353882E-04, 4.82005924552095464E-05/ | |||
|
|
264 | DATA BETA(1), BETA(2), BETA(3), BETA(4), BETA(5), BETA(6), | |||
|
|
265 | 1 BETA(7), BETA(8), BETA(9), BETA(10), BETA(11), BETA(12), | |||
|
|
266 | 2 BETA(13), BETA(14), BETA(15), BETA(16), BETA(17), BETA(18), | |||
|
|
267 | 3 BETA(19), BETA(20), BETA(21), BETA(22)/ | |||
|
|
268 | 4 1.79988721413553309E-02, 5.59964911064388073E-03, | |||
|
|
269 | 5 2.88501402231132779E-03, 1.80096606761053941E-03, | |||
|
|
270 | 6 1.24753110589199202E-03, 9.22878876572938311E-04, | |||
|
|
271 | 7 7.14430421727287357E-04, 5.71787281789704872E-04, | |||
|
|
272 | 8 4.69431007606481533E-04, 3.93232835462916638E-04, | |||
|
|
273 | 9 3.34818889318297664E-04, 2.88952148495751517E-04, | |||
|
|
274 | A 2.52211615549573284E-04, 2.22280580798883327E-04, | |||
|
|
275 | B 1.97541838033062524E-04, 1.76836855019718004E-04, | |||
|
|
276 | C 1.59316899661821081E-04, 1.44347930197333986E-04, | |||
|
|
277 | D 1.31448068119965379E-04, 1.20245444949302884E-04, | |||
|
|
278 | E 1.10449144504599392E-04, 1.01828770740567258E-04/ | |||
|
|
279 | DATA BETA(23), BETA(24), BETA(25), BETA(26), BETA(27), BETA(28), | |||
|
|
280 | 1 BETA(29), BETA(30), BETA(31), BETA(32), BETA(33), BETA(34), | |||
|
|
281 | 2 BETA(35), BETA(36), BETA(37), BETA(38), BETA(39), BETA(40), | |||
|
|
282 | 3 BETA(41), BETA(42), BETA(43), BETA(44)/ | |||
|
|
283 | 4 9.41998224204237509E-05, 8.74130545753834437E-05, | |||
|
|
284 | 5 8.13466262162801467E-05, 7.59002269646219339E-05, | |||
|
|
285 | 6 7.09906300634153481E-05, 6.65482874842468183E-05, | |||
|
|
286 | 7 6.25146958969275078E-05, 5.88403394426251749E-05, | |||
|
|
287 | 8 -1.49282953213429172E-03, -8.78204709546389328E-04, | |||
|
|
288 | 9 -5.02916549572034614E-04, -2.94822138512746025E-04, | |||
|
|
289 | A -1.75463996970782828E-04, -1.04008550460816434E-04, | |||
|
|
290 | B -5.96141953046457895E-05, -3.12038929076098340E-05, | |||
|
|
291 | C -1.26089735980230047E-05, -2.42892608575730389E-07, | |||
|
|
292 | D 8.05996165414273571E-06, 1.36507009262147391E-05, | |||
|
|
293 | E 1.73964125472926261E-05, 1.98672978842133780E-05/ | |||
|
|
294 | DATA BETA(45), BETA(46), BETA(47), BETA(48), BETA(49), BETA(50), | |||
|
|
295 | 1 BETA(51), BETA(52), BETA(53), BETA(54), BETA(55), BETA(56), | |||
|
|
296 | 2 BETA(57), BETA(58), BETA(59), BETA(60), BETA(61), BETA(62), | |||
|
|
297 | 3 BETA(63), BETA(64), BETA(65), BETA(66)/ | |||
|
|
298 | 4 2.14463263790822639E-05, 2.23954659232456514E-05, | |||
|
|
299 | 5 2.28967783814712629E-05, 2.30785389811177817E-05, | |||
|
|
300 | 6 2.30321976080909144E-05, 2.28236073720348722E-05, | |||
|
|
301 | 7 2.25005881105292418E-05, 2.20981015361991429E-05, | |||
|
|
302 | 8 2.16418427448103905E-05, 2.11507649256220843E-05, | |||
|
|
303 | 9 2.06388749782170737E-05, 2.01165241997081666E-05, | |||
|
|
304 | A 1.95913450141179244E-05, 1.90689367910436740E-05, | |||
|
|
305 | B 1.85533719641636667E-05, 1.80475722259674218E-05, | |||
|
|
306 | C 5.52213076721292790E-04, 4.47932581552384646E-04, | |||
|
|
307 | D 2.79520653992020589E-04, 1.52468156198446602E-04, | |||
|
|
308 | E 6.93271105657043598E-05, 1.76258683069991397E-05/ | |||
|
|
309 | DATA BETA(67), BETA(68), BETA(69), BETA(70), BETA(71), BETA(72), | |||
|
|
310 | 1 BETA(73), BETA(74), BETA(75), BETA(76), BETA(77), BETA(78), | |||
|
|
311 | 2 BETA(79), BETA(80), BETA(81), BETA(82), BETA(83), BETA(84), | |||
|
|
312 | 3 BETA(85), BETA(86), BETA(87), BETA(88)/ | |||
|
|
313 | 4 -1.35744996343269136E-05, -3.17972413350427135E-05, | |||
|
|
314 | 5 -4.18861861696693365E-05, -4.69004889379141029E-05, | |||
|
|
315 | 6 -4.87665447413787352E-05, -4.87010031186735069E-05, | |||
|
|
316 | 7 -4.74755620890086638E-05, -4.55813058138628452E-05, | |||
|
|
317 | 8 -4.33309644511266036E-05, -4.09230193157750364E-05, | |||
|
|
318 | 9 -3.84822638603221274E-05, -3.60857167535410501E-05, | |||
|
|
319 | A -3.37793306123367417E-05, -3.15888560772109621E-05, | |||
|
|
320 | B -2.95269561750807315E-05, -2.75978914828335759E-05, | |||
|
|
321 | C -2.58006174666883713E-05, -2.41308356761280200E-05, | |||
|
|
322 | D -2.25823509518346033E-05, -2.11479656768912971E-05, | |||
|
|
323 | E -1.98200638885294927E-05, -1.85909870801065077E-05/ | |||
|
|
324 | DATA BETA(89), BETA(90), BETA(91), BETA(92), BETA(93), BETA(94), | |||
|
|
325 | 1 BETA(95), BETA(96), BETA(97), BETA(98), BETA(99), BETA(100), | |||
|
|
326 | 2 BETA(101), BETA(102), BETA(103), BETA(104), BETA(105), | |||
|
|
327 | 3 BETA(106), BETA(107), BETA(108), BETA(109), BETA(110)/ | |||
|
|
328 | 4 -1.74532699844210224E-05, -1.63997823854497997E-05, | |||
|
|
329 | 5 -4.74617796559959808E-04, -4.77864567147321487E-04, | |||
|
|
330 | 6 -3.20390228067037603E-04, -1.61105016119962282E-04, | |||
|
|
331 | 7 -4.25778101285435204E-05, 3.44571294294967503E-05, | |||
|
|
332 | 8 7.97092684075674924E-05, 1.03138236708272200E-04, | |||
|
|
333 | 9 1.12466775262204158E-04, 1.13103642108481389E-04, | |||
|
|
334 | A 1.08651634848774268E-04, 1.01437951597661973E-04, | |||
|
|
335 | B 9.29298396593363896E-05, 8.40293133016089978E-05, | |||
|
|
336 | C 7.52727991349134062E-05, 6.69632521975730872E-05, | |||
|
|
337 | D 5.92564547323194704E-05, 5.22169308826975567E-05, | |||
|
|
338 | E 4.58539485165360646E-05, 4.01445513891486808E-05/ | |||
|
|
339 | DATA BETA(111), BETA(112), BETA(113), BETA(114), BETA(115), | |||
|
|
340 | 1 BETA(116), BETA(117), BETA(118), BETA(119), BETA(120), | |||
|
|
341 | 2 BETA(121), BETA(122), BETA(123), BETA(124), BETA(125), | |||
|
|
342 | 3 BETA(126), BETA(127), BETA(128), BETA(129), BETA(130)/ | |||
|
|
343 | 4 3.50481730031328081E-05, 3.05157995034346659E-05, | |||
|
|
344 | 5 2.64956119950516039E-05, 2.29363633690998152E-05, | |||
|
|
345 | 6 1.97893056664021636E-05, 1.70091984636412623E-05, | |||
|
|
346 | 7 1.45547428261524004E-05, 1.23886640995878413E-05, | |||
|
|
347 | 8 1.04775876076583236E-05, 8.79179954978479373E-06, | |||
|
|
348 | 9 7.36465810572578444E-04, 8.72790805146193976E-04, | |||
|
|
349 | A 6.22614862573135066E-04, 2.85998154194304147E-04, | |||
|
|
350 | B 3.84737672879366102E-06, -1.87906003636971558E-04, | |||
|
|
351 | C -2.97603646594554535E-04, -3.45998126832656348E-04, | |||
|
|
352 | D -3.53382470916037712E-04, -3.35715635775048757E-04/ | |||
|
|
353 | DATA BETA(131), BETA(132), BETA(133), BETA(134), BETA(135), | |||
|
|
354 | 1 BETA(136), BETA(137), BETA(138), BETA(139), BETA(140), | |||
|
|
355 | 2 BETA(141), BETA(142), BETA(143), BETA(144), BETA(145), | |||
|
|
356 | 3 BETA(146), BETA(147), BETA(148), BETA(149), BETA(150)/ | |||
|
|
357 | 4 -3.04321124789039809E-04, -2.66722723047612821E-04, | |||
|
|
358 | 5 -2.27654214122819527E-04, -1.89922611854562356E-04, | |||
|
|
359 | 6 -1.55058918599093870E-04, -1.23778240761873630E-04, | |||
|
|
360 | 7 -9.62926147717644187E-05, -7.25178327714425337E-05, | |||
|
|
361 | 8 -5.22070028895633801E-05, -3.50347750511900522E-05, | |||
|
|
362 | 9 -2.06489761035551757E-05, -8.70106096849767054E-06, | |||
|
|
363 | A 1.13698686675100290E-06, 9.16426474122778849E-06, | |||
|
|
364 | B 1.56477785428872620E-05, 2.08223629482466847E-05, | |||
|
|
365 | C 2.48923381004595156E-05, 2.80340509574146325E-05, | |||
|
|
366 | D 3.03987774629861915E-05, 3.21156731406700616E-05/ | |||
|
|
367 | DATA BETA(151), BETA(152), BETA(153), BETA(154), BETA(155), | |||
|
|
368 | 1 BETA(156), BETA(157), BETA(158), BETA(159), BETA(160), | |||
|
|
369 | 2 BETA(161), BETA(162), BETA(163), BETA(164), BETA(165), | |||
|
|
370 | 3 BETA(166), BETA(167), BETA(168), BETA(169), BETA(170)/ | |||
|
|
371 | 4 -1.80182191963885708E-03, -2.43402962938042533E-03, | |||
|
|
372 | 5 -1.83422663549856802E-03, -7.62204596354009765E-04, | |||
|
|
373 | 6 2.39079475256927218E-04, 9.49266117176881141E-04, | |||
|
|
374 | 7 1.34467449701540359E-03, 1.48457495259449178E-03, | |||
|
|
375 | 8 1.44732339830617591E-03, 1.30268261285657186E-03, | |||
|
|
376 | 9 1.10351597375642682E-03, 8.86047440419791759E-04, | |||
|
|
377 | A 6.73073208165665473E-04, 4.77603872856582378E-04, | |||
|
|
378 | B 3.05991926358789362E-04, 1.60315694594721630E-04, | |||
|
|
379 | C 4.00749555270613286E-05, -5.66607461635251611E-05, | |||
|
|
380 | D -1.32506186772982638E-04, -1.90296187989614057E-04/ | |||
|
|
381 | DATA BETA(171), BETA(172), BETA(173), BETA(174), BETA(175), | |||
|
|
382 | 1 BETA(176), BETA(177), BETA(178), BETA(179), BETA(180), | |||
|
|
383 | 2 BETA(181), BETA(182), BETA(183), BETA(184), BETA(185), | |||
|
|
384 | 3 BETA(186), BETA(187), BETA(188), BETA(189), BETA(190)/ | |||
|
|
385 | 4 -2.32811450376937408E-04, -2.62628811464668841E-04, | |||
|
|
386 | 5 -2.82050469867598672E-04, -2.93081563192861167E-04, | |||
|
|
387 | 6 -2.97435962176316616E-04, -2.96557334239348078E-04, | |||
|
|
388 | 7 -2.91647363312090861E-04, -2.83696203837734166E-04, | |||
|
|
389 | 8 -2.73512317095673346E-04, -2.61750155806768580E-04, | |||
|
|
390 | 9 6.38585891212050914E-03, 9.62374215806377941E-03, | |||
|
|
391 | A 7.61878061207001043E-03, 2.83219055545628054E-03, | |||
|
|
392 | B -2.09841352012720090E-03, -5.73826764216626498E-03, | |||
|
|
393 | C -7.70804244495414620E-03, -8.21011692264844401E-03, | |||
|
|
394 | D -7.65824520346905413E-03, -6.47209729391045177E-03/ | |||
|
|
395 | DATA BETA(191), BETA(192), BETA(193), BETA(194), BETA(195), | |||
|
|
396 | 1 BETA(196), BETA(197), BETA(198), BETA(199), BETA(200), | |||
|
|
397 | 2 BETA(201), BETA(202), BETA(203), BETA(204), BETA(205), | |||
|
|
398 | 3 BETA(206), BETA(207), BETA(208), BETA(209), BETA(210)/ | |||
|
|
399 | 4 -4.99132412004966473E-03, -3.45612289713133280E-03, | |||
|
|
400 | 5 -2.01785580014170775E-03, -7.59430686781961401E-04, | |||
|
|
401 | 6 2.84173631523859138E-04, 1.10891667586337403E-03, | |||
|
|
402 | 7 1.72901493872728771E-03, 2.16812590802684701E-03, | |||
|
|
403 | 8 2.45357710494539735E-03, 2.61281821058334862E-03, | |||
|
|
404 | 9 2.67141039656276912E-03, 2.65203073395980430E-03, | |||
|
|
405 | A 2.57411652877287315E-03, 2.45389126236094427E-03, | |||
|
|
406 | B 2.30460058071795494E-03, 2.13684837686712662E-03, | |||
|
|
407 | C 1.95896528478870911E-03, 1.77737008679454412E-03, | |||
|
|
408 | D 1.59690280765839059E-03, 1.42111975664438546E-03/ | |||
|
|
409 | DATA GAMA(1), GAMA(2), GAMA(3), GAMA(4), GAMA(5), GAMA(6), | |||
|
|
410 | 1 GAMA(7), GAMA(8), GAMA(9), GAMA(10), GAMA(11), GAMA(12), | |||
|
|
411 | 2 GAMA(13), GAMA(14), GAMA(15), GAMA(16), GAMA(17), GAMA(18), | |||
|
|
412 | 3 GAMA(19), GAMA(20), GAMA(21), GAMA(22)/ | |||
|
|
413 | 4 6.29960524947436582E-01, 2.51984209978974633E-01, | |||
|
|
414 | 5 1.54790300415655846E-01, 1.10713062416159013E-01, | |||
|
|
415 | 6 8.57309395527394825E-02, 6.97161316958684292E-02, | |||
|
|
416 | 7 5.86085671893713576E-02, 5.04698873536310685E-02, | |||
|
|
417 | 8 4.42600580689154809E-02, 3.93720661543509966E-02, | |||
|
|
418 | 9 3.54283195924455368E-02, 3.21818857502098231E-02, | |||
|
|
419 | A 2.94646240791157679E-02, 2.71581677112934479E-02, | |||
|
|
420 | B 2.51768272973861779E-02, 2.34570755306078891E-02, | |||
|
|
421 | C 2.19508390134907203E-02, 2.06210828235646240E-02, | |||
|
|
422 | D 1.94388240897880846E-02, 1.83810633800683158E-02, | |||
|
|
423 | E 1.74293213231963172E-02, 1.65685837786612353E-02/ | |||
|
|
424 | DATA GAMA(23), GAMA(24), GAMA(25), GAMA(26), GAMA(27), GAMA(28), | |||
|
|
425 | 1 GAMA(29), GAMA(30)/ | |||
|
|
426 | 2 1.57865285987918445E-02, 1.50729501494095594E-02, | |||
|
|
427 | 3 1.44193250839954639E-02, 1.38184805735341786E-02, | |||
|
|
428 | 4 1.32643378994276568E-02, 1.27517121970498651E-02, | |||
|
|
429 | 5 1.22761545318762767E-02, 1.18338262398482403E-02/ | |||
|
|
430 | DATA EX1, EX2, HPI, PI, THPI / | |||
|
|
431 | 1 3.33333333333333333E-01, 6.66666666666666667E-01, | |||
|
|
432 | 2 1.57079632679489662E+00, 3.14159265358979324E+00, | |||
|
|
433 | 3 4.71238898038468986E+00/ | |||
|
|
434 | DATA CZERO, CONE / (0.0E0,0.0E0), (1.0E0,0.0E0) / | |||
|
|
435 | C***FIRST EXECUTABLE STATEMENT CUNHJ | |||
|
|
436 | RFNU = 1.0E0/FNU | |||
|
|
437 | C ZB = Z*CMPLX(RFNU,0.0E0) | |||
|
|
438 | C----------------------------------------------------------------------- | |||
|
|
439 | C OVERFLOW TEST (Z/FNU TOO SMALL) | |||
|
|
440 | C----------------------------------------------------------------------- | |||
|
|
441 | TSTR = REAL(Z) | |||
|
|
442 | TSTI = AIMAG(Z) | |||
|
|
443 | TEST = R1MACH(1)*1.0E+3 | |||
|
|
444 | AC = FNU*TEST | |||
|
|
445 | IF (ABS(TSTR).GT.AC .OR. ABS(TSTI).GT.AC) GO TO 15 | |||
|
|
446 | AC = 2.0E0*ABS(ALOG(TEST))+FNU | |||
|
|
447 | ZETA1 = CMPLX(AC,0.0E0) | |||
|
|
448 | ZETA2 = CMPLX(FNU,0.0E0) | |||
|
|
449 | PHI=CONE | |||
|
|
450 | ARG=CONE | |||
|
|
451 | RETURN | |||
|
|
452 | 15 CONTINUE | |||
|
|
453 | ZB = Z*CMPLX(RFNU,0.0E0) | |||
|
|
454 | RFNU2 = RFNU*RFNU | |||
|
|
455 | C----------------------------------------------------------------------- | |||
|
|
456 | C COMPUTE IN THE FOURTH QUADRANT | |||
|
|
457 | C----------------------------------------------------------------------- | |||
|
|
458 | FN13 = FNU**EX1 | |||
|
|
459 | FN23 = FN13*FN13 | |||
|
|
460 | RFN13 = CMPLX(1.0E0/FN13,0.0E0) | |||
|
|
461 | W2 = CONE - ZB*ZB | |||
|
|
462 | AW2 = ABS(W2) | |||
|
|
463 | IF (AW2.GT.0.25E0) GO TO 130 | |||
|
|
464 | C----------------------------------------------------------------------- | |||
|
|
465 | C POWER SERIES FOR ABS(W2).LE.0.25E0 | |||
|
|
466 | C----------------------------------------------------------------------- | |||
|
|
467 | K = 1 | |||
|
|
468 | P(1) = CONE | |||
|
|
469 | SUMA = CMPLX(GAMA(1),0.0E0) | |||
|
|
470 | AP(1) = 1.0E0 | |||
|
|
471 | IF (AW2.LT.TOL) GO TO 20 | |||
|
|
472 | DO 10 K=2,30 | |||
|
|
473 | P(K) = P(K-1)*W2 | |||
|
|
474 | SUMA = SUMA + P(K)*CMPLX(GAMA(K),0.0E0) | |||
|
|
475 | AP(K) = AP(K-1)*AW2 | |||
|
|
476 | IF (AP(K).LT.TOL) GO TO 20 | |||
|
|
477 | 10 CONTINUE | |||
|
|
478 | K = 30 | |||
|
|
479 | 20 CONTINUE | |||
|
|
480 | KMAX = K | |||
|
|
481 | ZETA = W2*SUMA | |||
|
|
482 | ARG = ZETA*CMPLX(FN23,0.0E0) | |||
|
|
483 | ZA = CSQRT(SUMA) | |||
|
|
484 | ZETA2 = CSQRT(W2)*CMPLX(FNU,0.0E0) | |||
|
|
485 | ZETA1 = ZETA2*(CONE+ZETA*ZA*CMPLX(EX2,0.0E0)) | |||
|
|
486 | ZA = ZA + ZA | |||
|
|
487 | PHI = CSQRT(ZA)*RFN13 | |||
|
|
488 | IF (IPMTR.EQ.1) GO TO 120 | |||
|
|
489 | C----------------------------------------------------------------------- | |||
|
|
490 | C SUM SERIES FOR ASUM AND BSUM | |||
|
|
491 | C----------------------------------------------------------------------- | |||
|
|
492 | SUMB = CZERO | |||
|
|
493 | DO 30 K=1,KMAX | |||
|
|
494 | SUMB = SUMB + P(K)*CMPLX(BETA(K),0.0E0) | |||
|
|
495 | 30 CONTINUE | |||
|
|
496 | ASUM = CZERO | |||
|
|
497 | BSUM = SUMB | |||
|
|
498 | L1 = 0 | |||
|
|
499 | L2 = 30 | |||
|
|
500 | BTOL = TOL*ABS(BSUM) | |||
|
|
501 | ATOL = TOL | |||
|
|
502 | PP = 1.0E0 | |||
|
|
503 | IAS = 0 | |||
|
|
504 | IBS = 0 | |||
|
|
505 | IF (RFNU2.LT.TOL) GO TO 110 | |||
|
|
506 | DO 100 IS=2,7 | |||
|
|
507 | ATOL = ATOL/RFNU2 | |||
|
|
508 | PP = PP*RFNU2 | |||
|
|
509 | IF (IAS.EQ.1) GO TO 60 | |||
|
|
510 | SUMA = CZERO | |||
|
|
511 | DO 40 K=1,KMAX | |||
|
|
512 | M = L1 + K | |||
|
|
513 | SUMA = SUMA + P(K)*CMPLX(ALFA(M),0.0E0) | |||
|
|
514 | IF (AP(K).LT.ATOL) GO TO 50 | |||
|
|
515 | 40 CONTINUE | |||
|
|
516 | 50 CONTINUE | |||
|
|
517 | ASUM = ASUM + SUMA*CMPLX(PP,0.0E0) | |||
|
|
518 | IF (PP.LT.TOL) IAS = 1 | |||
|
|
519 | 60 CONTINUE | |||
|
|
520 | IF (IBS.EQ.1) GO TO 90 | |||
|
|
521 | SUMB = CZERO | |||
|
|
522 | DO 70 K=1,KMAX | |||
|
|
523 | M = L2 + K | |||
|
|
524 | SUMB = SUMB + P(K)*CMPLX(BETA(M),0.0E0) | |||
|
|
525 | IF (AP(K).LT.ATOL) GO TO 80 | |||
|
|
526 | 70 CONTINUE | |||
|
|
527 | 80 CONTINUE | |||
|
|
528 | BSUM = BSUM + SUMB*CMPLX(PP,0.0E0) | |||
|
|
529 | IF (PP.LT.BTOL) IBS = 1 | |||
|
|
530 | 90 CONTINUE | |||
|
|
531 | IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 110 | |||
|
|
532 | L1 = L1 + 30 | |||
|
|
533 | L2 = L2 + 30 | |||
|
|
534 | 100 CONTINUE | |||
|
|
535 | 110 CONTINUE | |||
|
|
536 | ASUM = ASUM + CONE | |||
|
|
537 | PP = RFNU*REAL(RFN13) | |||
|
|
538 | BSUM = BSUM*CMPLX(PP,0.0E0) | |||
|
|
539 | 120 CONTINUE | |||
|
|
540 | RETURN | |||
|
|
541 | C----------------------------------------------------------------------- | |||
|
|
542 | C ABS(W2).GT.0.25E0 | |||
|
|
543 | C----------------------------------------------------------------------- | |||
|
|
544 | 130 CONTINUE | |||
|
|
545 | W = CSQRT(W2) | |||
|
|
546 | WR = REAL(W) | |||
|
|
547 | WI = AIMAG(W) | |||
|
|
548 | IF (WR.LT.0.0E0) WR = 0.0E0 | |||
|
|
549 | IF (WI.LT.0.0E0) WI = 0.0E0 | |||
|
|
550 | W = CMPLX(WR,WI) | |||
|
|
551 | ZA = (CONE+W)/ZB | |||
|
|
552 | ZC = CLOG(ZA) | |||
|
|
553 | ZCR = REAL(ZC) | |||
|
|
554 | ZCI = AIMAG(ZC) | |||
|
|
555 | IF (ZCI.LT.0.0E0) ZCI = 0.0E0 | |||
|
|
556 | IF (ZCI.GT.HPI) ZCI = HPI | |||
|
|
557 | IF (ZCR.LT.0.0E0) ZCR = 0.0E0 | |||
|
|
558 | ZC = CMPLX(ZCR,ZCI) | |||
|
|
559 | ZTH = (ZC-W)*CMPLX(1.5E0,0.0E0) | |||
|
|
560 | CFNU = CMPLX(FNU,0.0E0) | |||
|
|
561 | ZETA1 = ZC*CFNU | |||
|
|
562 | ZETA2 = W*CFNU | |||
|
|
563 | AZTH = ABS(ZTH) | |||
|
|
564 | ZTHR = REAL(ZTH) | |||
|
|
565 | ZTHI = AIMAG(ZTH) | |||
|
|
566 | ANG = THPI | |||
|
|
567 | IF (ZTHR.GE.0.0E0 .AND. ZTHI.LT.0.0E0) GO TO 140 | |||
|
|
568 | ANG = HPI | |||
|
|
569 | IF (ZTHR.EQ.0.0E0) GO TO 140 | |||
|
|
570 | ANG = ATAN(ZTHI/ZTHR) | |||
|
|
571 | IF (ZTHR.LT.0.0E0) ANG = ANG + PI | |||
|
|
572 | 140 CONTINUE | |||
|
|
573 | PP = AZTH**EX2 | |||
|
|
574 | ANG = ANG*EX2 | |||
|
|
575 | ZETAR = PP*COS(ANG) | |||
|
|
576 | ZETAI = PP*SIN(ANG) | |||
|
|
577 | IF (ZETAI.LT.0.0E0) ZETAI = 0.0E0 | |||
|
|
578 | ZETA = CMPLX(ZETAR,ZETAI) | |||
|
|
579 | ARG = ZETA*CMPLX(FN23,0.0E0) | |||
|
|
580 | RTZTA = ZTH/ZETA | |||
|
|
581 | ZA = RTZTA/W | |||
|
|
582 | PHI = CSQRT(ZA+ZA)*RFN13 | |||
|
|
583 | IF (IPMTR.EQ.1) GO TO 120 | |||
|
|
584 | TFN = CMPLX(RFNU,0.0E0)/W | |||
|
|
585 | RZTH = CMPLX(RFNU,0.0E0)/ZTH | |||
|
|
586 | ZC = RZTH*CMPLX(AR(2),0.0E0) | |||
|
|
587 | T2 = CONE/W2 | |||
|
|
588 | UP(2) = (T2*CMPLX(C(2),0.0E0)+CMPLX(C(3),0.0E0))*TFN | |||
|
|
589 | BSUM = UP(2) + ZC | |||
|
|
590 | ASUM = CZERO | |||
|
|
591 | IF (RFNU.LT.TOL) GO TO 220 | |||
|
|
592 | PRZTH = RZTH | |||
|
|
593 | PTFN = TFN | |||
|
|
594 | UP(1) = CONE | |||
|
|
595 | PP = 1.0E0 | |||
|
|
596 | BSUMR = REAL(BSUM) | |||
|
|
597 | BSUMI = AIMAG(BSUM) | |||
|
|
598 | BTOL = TOL*(ABS(BSUMR)+ABS(BSUMI)) | |||
|
|
599 | KS = 0 | |||
|
|
600 | KP1 = 2 | |||
|
|
601 | L = 3 | |||
|
|
602 | IAS = 0 | |||
|
|
603 | IBS = 0 | |||
|
|
604 | DO 210 LR=2,12,2 | |||
|
|
605 | LRP1 = LR + 1 | |||
|
|
606 | C----------------------------------------------------------------------- | |||
|
|
607 | C COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN | |||
|
|
608 | C NEXT SUMA AND SUMB | |||
|
|
609 | C----------------------------------------------------------------------- | |||
|
|
610 | DO 160 K=LR,LRP1 | |||
|
|
611 | KS = KS + 1 | |||
|
|
612 | KP1 = KP1 + 1 | |||
|
|
613 | L = L + 1 | |||
|
|
614 | ZA = CMPLX(C(L),0.0E0) | |||
|
|
615 | DO 150 J=2,KP1 | |||
|
|
616 | L = L + 1 | |||
|
|
617 | ZA = ZA*T2 + CMPLX(C(L),0.0E0) | |||
|
|
618 | 150 CONTINUE | |||
|
|
619 | PTFN = PTFN*TFN | |||
|
|
620 | UP(KP1) = PTFN*ZA | |||
|
|
621 | CR(KS) = PRZTH*CMPLX(BR(KS+1),0.0E0) | |||
|
|
622 | PRZTH = PRZTH*RZTH | |||
|
|
623 | DR(KS) = PRZTH*CMPLX(AR(KS+2),0.0E0) | |||
|
|
624 | 160 CONTINUE | |||
|
|
625 | PP = PP*RFNU2 | |||
|
|
626 | IF (IAS.EQ.1) GO TO 180 | |||
|
|
627 | SUMA = UP(LRP1) | |||
|
|
628 | JU = LRP1 | |||
|
|
629 | DO 170 JR=1,LR | |||
|
|
630 | JU = JU - 1 | |||
|
|
631 | SUMA = SUMA + CR(JR)*UP(JU) | |||
|
|
632 | 170 CONTINUE | |||
|
|
633 | ASUM = ASUM + SUMA | |||
|
|
634 | ASUMR = REAL(ASUM) | |||
|
|
635 | ASUMI = AIMAG(ASUM) | |||
|
|
636 | TEST = ABS(ASUMR) + ABS(ASUMI) | |||
|
|
637 | IF (PP.LT.TOL .AND. TEST.LT.TOL) IAS = 1 | |||
|
|
638 | 180 CONTINUE | |||
|
|
639 | IF (IBS.EQ.1) GO TO 200 | |||
|
|
640 | SUMB = UP(LR+2) + UP(LRP1)*ZC | |||
|
|
641 | JU = LRP1 | |||
|
|
642 | DO 190 JR=1,LR | |||
|
|
643 | JU = JU - 1 | |||
|
|
644 | SUMB = SUMB + DR(JR)*UP(JU) | |||
|
|
645 | 190 CONTINUE | |||
|
|
646 | BSUM = BSUM + SUMB | |||
|
|
647 | BSUMR = REAL(BSUM) | |||
|
|
648 | BSUMI = AIMAG(BSUM) | |||
|
|
649 | TEST = ABS(BSUMR) + ABS(BSUMI) | |||
|
|
650 | IF (PP.LT.BTOL .AND. TEST.LT.TOL) IBS = 1 | |||
|
|
651 | 200 CONTINUE | |||
|
|
652 | IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 220 | |||
|
|
653 | 210 CONTINUE | |||
|
|
654 | 220 CONTINUE | |||
|
|
655 | ASUM = ASUM + CONE | |||
|
|
656 | BSUM = -BSUM*RFN13/RTZTA | |||
|
|
657 | GO TO 120 | |||
|
|
658 | END | |||
| @@ -0,0 +1,178 | |||||
|
|
1 | *DECK CUNI1 | |||
|
|
2 | SUBROUTINE CUNI1 (Z, FNU, KODE, N, Y, NZ, NLAST, FNUL, TOL, ELIM, | |||
|
|
3 | + ALIM) | |||
|
|
4 | C***BEGIN PROLOGUE CUNI1 | |||
|
|
5 | C***SUBSIDIARY | |||
|
|
6 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***TYPE ALL (CUNI1-A, ZUNI1-A) | |||
|
|
9 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
10 | C***DESCRIPTION | |||
|
|
11 | C | |||
|
|
12 | C CUNI1 COMPUTES I(FNU,Z) BY MEANS OF THE UNIFORM ASYMPTOTIC | |||
|
|
13 | C EXPANSION FOR I(FNU,Z) IN -PI/3.LE.ARG Z.LE.PI/3. | |||
|
|
14 | C | |||
|
|
15 | C FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC | |||
|
|
16 | C EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. | |||
|
|
17 | C NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER | |||
|
|
18 | C FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. | |||
|
|
19 | C Y(I)=CZERO FOR I=NLAST+1,N | |||
|
|
20 | C | |||
|
|
21 | C***SEE ALSO CBESI, CBESK | |||
|
|
22 | C***ROUTINES CALLED CUCHK, CUNIK, CUOIK, R1MACH | |||
|
|
23 | C***REVISION HISTORY (YYMMDD) | |||
|
|
24 | C 830501 DATE WRITTEN | |||
|
|
25 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
26 | C***END PROLOGUE CUNI1 | |||
|
|
27 | COMPLEX CFN, CONE, CRSC, CSCL, CSR, CSS, CWRK, CZERO, C1, C2, | |||
|
|
28 | * PHI, RZ, SUM, S1, S2, Y, Z, ZETA1, ZETA2, CY | |||
|
|
29 | REAL ALIM, APHI, ASCLE, BRY, C2I, C2M, C2R, ELIM, FN, FNU, FNUL, | |||
|
|
30 | * RS1, TOL, YY, R1MACH | |||
|
|
31 | INTEGER I, IFLAG, INIT, K, KODE, M, N, ND, NLAST, NN, NUF, NW, NZ | |||
|
|
32 | DIMENSION BRY(3), Y(N), CWRK(16), CSS(3), CSR(3), CY(2) | |||
|
|
33 | DATA CZERO, CONE / (0.0E0,0.0E0), (1.0E0,0.0E0) / | |||
|
|
34 | C***FIRST EXECUTABLE STATEMENT CUNI1 | |||
|
|
35 | NZ = 0 | |||
|
|
36 | ND = N | |||
|
|
37 | NLAST = 0 | |||
|
|
38 | C----------------------------------------------------------------------- | |||
|
|
39 | C COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG- | |||
|
|
40 | C NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, | |||
|
|
41 | C EXP(ALIM)=EXP(ELIM)*TOL | |||
|
|
42 | C----------------------------------------------------------------------- | |||
|
|
43 | CSCL = CMPLX(1.0E0/TOL,0.0E0) | |||
|
|
44 | CRSC = CMPLX(TOL,0.0E0) | |||
|
|
45 | CSS(1) = CSCL | |||
|
|
46 | CSS(2) = CONE | |||
|
|
47 | CSS(3) = CRSC | |||
|
|
48 | CSR(1) = CRSC | |||
|
|
49 | CSR(2) = CONE | |||
|
|
50 | CSR(3) = CSCL | |||
|
|
51 | BRY(1) = 1.0E+3*R1MACH(1)/TOL | |||
|
|
52 | C----------------------------------------------------------------------- | |||
|
|
53 | C CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER | |||
|
|
54 | C----------------------------------------------------------------------- | |||
|
|
55 | FN = MAX(FNU,1.0E0) | |||
|
|
56 | INIT = 0 | |||
|
|
57 | CALL CUNIK(Z, FN, 1, 1, TOL, INIT, PHI, ZETA1, ZETA2, SUM, CWRK) | |||
|
|
58 | IF (KODE.EQ.1) GO TO 10 | |||
|
|
59 | CFN = CMPLX(FN,0.0E0) | |||
|
|
60 | S1 = -ZETA1 + CFN*(CFN/(Z+ZETA2)) | |||
|
|
61 | GO TO 20 | |||
|
|
62 | 10 CONTINUE | |||
|
|
63 | S1 = -ZETA1 + ZETA2 | |||
|
|
64 | 20 CONTINUE | |||
|
|
65 | RS1 = REAL(S1) | |||
|
|
66 | IF (ABS(RS1).GT.ELIM) GO TO 130 | |||
|
|
67 | 30 CONTINUE | |||
|
|
68 | NN = MIN(2,ND) | |||
|
|
69 | DO 80 I=1,NN | |||
|
|
70 | FN = FNU + (ND-I) | |||
|
|
71 | INIT = 0 | |||
|
|
72 | CALL CUNIK(Z, FN, 1, 0, TOL, INIT, PHI, ZETA1, ZETA2, SUM, CWRK) | |||
|
|
73 | IF (KODE.EQ.1) GO TO 40 | |||
|
|
74 | CFN = CMPLX(FN,0.0E0) | |||
|
|
75 | YY = AIMAG(Z) | |||
|
|
76 | S1 = -ZETA1 + CFN*(CFN/(Z+ZETA2)) + CMPLX(0.0E0,YY) | |||
|
|
77 | GO TO 50 | |||
|
|
78 | 40 CONTINUE | |||
|
|
79 | S1 = -ZETA1 + ZETA2 | |||
|
|
80 | 50 CONTINUE | |||
|
|
81 | C----------------------------------------------------------------------- | |||
|
|
82 | C TEST FOR UNDERFLOW AND OVERFLOW | |||
|
|
83 | C----------------------------------------------------------------------- | |||
|
|
84 | RS1 = REAL(S1) | |||
|
|
85 | IF (ABS(RS1).GT.ELIM) GO TO 110 | |||
|
|
86 | IF (I.EQ.1) IFLAG = 2 | |||
|
|
87 | IF (ABS(RS1).LT.ALIM) GO TO 60 | |||
|
|
88 | C----------------------------------------------------------------------- | |||
|
|
89 | C REFINE TEST AND SCALE | |||
|
|
90 | C----------------------------------------------------------------------- | |||
|
|
91 | APHI = ABS(PHI) | |||
|
|
92 | RS1 = RS1 + ALOG(APHI) | |||
|
|
93 | IF (ABS(RS1).GT.ELIM) GO TO 110 | |||
|
|
94 | IF (I.EQ.1) IFLAG = 1 | |||
|
|
95 | IF (RS1.LT.0.0E0) GO TO 60 | |||
|
|
96 | IF (I.EQ.1) IFLAG = 3 | |||
|
|
97 | 60 CONTINUE | |||
|
|
98 | C----------------------------------------------------------------------- | |||
|
|
99 | C SCALE S1 IF ABS(S1).LT.ASCLE | |||
|
|
100 | C----------------------------------------------------------------------- | |||
|
|
101 | S2 = PHI*SUM | |||
|
|
102 | C2R = REAL(S1) | |||
|
|
103 | C2I = AIMAG(S1) | |||
|
|
104 | C2M = EXP(C2R)*REAL(CSS(IFLAG)) | |||
|
|
105 | S1 = CMPLX(C2M,0.0E0)*CMPLX(COS(C2I),SIN(C2I)) | |||
|
|
106 | S2 = S2*S1 | |||
|
|
107 | IF (IFLAG.NE.1) GO TO 70 | |||
|
|
108 | CALL CUCHK(S2, NW, BRY(1), TOL) | |||
|
|
109 | IF (NW.NE.0) GO TO 110 | |||
|
|
110 | 70 CONTINUE | |||
|
|
111 | M = ND - I + 1 | |||
|
|
112 | CY(I) = S2 | |||
|
|
113 | Y(M) = S2*CSR(IFLAG) | |||
|
|
114 | 80 CONTINUE | |||
|
|
115 | IF (ND.LE.2) GO TO 100 | |||
|
|
116 | RZ = CMPLX(2.0E0,0.0E0)/Z | |||
|
|
117 | BRY(2) = 1.0E0/BRY(1) | |||
|
|
118 | BRY(3) = R1MACH(2) | |||
|
|
119 | S1 = CY(1) | |||
|
|
120 | S2 = CY(2) | |||
|
|
121 | C1 = CSR(IFLAG) | |||
|
|
122 | ASCLE = BRY(IFLAG) | |||
|
|
123 | K = ND - 2 | |||
|
|
124 | FN = K | |||
|
|
125 | DO 90 I=3,ND | |||
|
|
126 | C2 = S2 | |||
|
|
127 | S2 = S1 + CMPLX(FNU+FN,0.0E0)*RZ*S2 | |||
|
|
128 | S1 = C2 | |||
|
|
129 | C2 = S2*C1 | |||
|
|
130 | Y(K) = C2 | |||
|
|
131 | K = K - 1 | |||
|
|
132 | FN = FN - 1.0E0 | |||
|
|
133 | IF (IFLAG.GE.3) GO TO 90 | |||
|
|
134 | C2R = REAL(C2) | |||
|
|
135 | C2I = AIMAG(C2) | |||
|
|
136 | C2R = ABS(C2R) | |||
|
|
137 | C2I = ABS(C2I) | |||
|
|
138 | C2M = MAX(C2R,C2I) | |||
|
|
139 | IF (C2M.LE.ASCLE) GO TO 90 | |||
|
|
140 | IFLAG = IFLAG + 1 | |||
|
|
141 | ASCLE = BRY(IFLAG) | |||
|
|
142 | S1 = S1*C1 | |||
|
|
143 | S2 = C2 | |||
|
|
144 | S1 = S1*CSS(IFLAG) | |||
|
|
145 | S2 = S2*CSS(IFLAG) | |||
|
|
146 | C1 = CSR(IFLAG) | |||
|
|
147 | 90 CONTINUE | |||
|
|
148 | 100 CONTINUE | |||
|
|
149 | RETURN | |||
|
|
150 | C----------------------------------------------------------------------- | |||
|
|
151 | C SET UNDERFLOW AND UPDATE PARAMETERS | |||
|
|
152 | C----------------------------------------------------------------------- | |||
|
|
153 | 110 CONTINUE | |||
|
|
154 | IF (RS1.GT.0.0E0) GO TO 120 | |||
|
|
155 | Y(ND) = CZERO | |||
|
|
156 | NZ = NZ + 1 | |||
|
|
157 | ND = ND - 1 | |||
|
|
158 | IF (ND.EQ.0) GO TO 100 | |||
|
|
159 | CALL CUOIK(Z, FNU, KODE, 1, ND, Y, NUF, TOL, ELIM, ALIM) | |||
|
|
160 | IF (NUF.LT.0) GO TO 120 | |||
|
|
161 | ND = ND - NUF | |||
|
|
162 | NZ = NZ + NUF | |||
|
|
163 | IF (ND.EQ.0) GO TO 100 | |||
|
|
164 | FN = FNU + (ND-1) | |||
|
|
165 | IF (FN.GE.FNUL) GO TO 30 | |||
|
|
166 | NLAST = ND | |||
|
|
167 | RETURN | |||
|
|
168 | 120 CONTINUE | |||
|
|
169 | NZ = -1 | |||
|
|
170 | RETURN | |||
|
|
171 | 130 CONTINUE | |||
|
|
172 | IF (RS1.GT.0.0E0) GO TO 120 | |||
|
|
173 | NZ = N | |||
|
|
174 | DO 140 I=1,N | |||
|
|
175 | Y(I) = CZERO | |||
|
|
176 | 140 CONTINUE | |||
|
|
177 | RETURN | |||
|
|
178 | END | |||
| @@ -0,0 +1,225 | |||||
|
|
1 | *DECK CUNI2 | |||
|
|
2 | SUBROUTINE CUNI2 (Z, FNU, KODE, N, Y, NZ, NLAST, FNUL, TOL, ELIM, | |||
|
|
3 | + ALIM) | |||
|
|
4 | C***BEGIN PROLOGUE CUNI2 | |||
|
|
5 | C***SUBSIDIARY | |||
|
|
6 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***TYPE ALL (CUNI2-A, ZUNI2-A) | |||
|
|
9 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
10 | C***DESCRIPTION | |||
|
|
11 | C | |||
|
|
12 | C CUNI2 COMPUTES I(FNU,Z) IN THE RIGHT HALF PLANE BY MEANS OF | |||
|
|
13 | C UNIFORM ASYMPTOTIC EXPANSION FOR J(FNU,ZN) WHERE ZN IS Z*I | |||
|
|
14 | C OR -Z*I AND ZN IS IN THE RIGHT HALF PLANE ALSO. | |||
|
|
15 | C | |||
|
|
16 | C FNUL IS THE SMALLEST ORDER PERMITTED FOR THE ASYMPTOTIC | |||
|
|
17 | C EXPANSION. NLAST=0 MEANS ALL OF THE Y VALUES WERE SET. | |||
|
|
18 | C NLAST.NE.0 IS THE NUMBER LEFT TO BE COMPUTED BY ANOTHER | |||
|
|
19 | C FORMULA FOR ORDERS FNU TO FNU+NLAST-1 BECAUSE FNU+NLAST-1.LT.FNUL. | |||
|
|
20 | C Y(I)=CZERO FOR I=NLAST+1,N | |||
|
|
21 | C | |||
|
|
22 | C***SEE ALSO CBESI, CBESK | |||
|
|
23 | C***ROUTINES CALLED CAIRY, CUCHK, CUNHJ, CUOIK, R1MACH | |||
|
|
24 | C***REVISION HISTORY (YYMMDD) | |||
|
|
25 | C 830501 DATE WRITTEN | |||
|
|
26 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
27 | C***END PROLOGUE CUNI2 | |||
|
|
28 | COMPLEX AI, ARG, ASUM, BSUM, CFN, CI, CID, CIP, CONE, CRSC, CSCL, | |||
|
|
29 | * CSR, CSS, CY, CZERO, C1, C2, DAI, PHI, RZ, S1, S2, Y, Z, ZB, | |||
|
|
30 | * ZETA1, ZETA2, ZN, ZAR | |||
|
|
31 | REAL AARG, AIC, ALIM, ANG, APHI, ASCLE, AY, BRY, CAR, C2I, C2M, | |||
|
|
32 | * C2R, ELIM, FN, FNU, FNUL, HPI, RS1, SAR, TOL, YY, R1MACH | |||
|
|
33 | INTEGER I, IFLAG, IN, INU, J, K, KODE, N, NAI, ND, NDAI, NLAST, | |||
|
|
34 | * NN, NUF, NW, NZ, IDUM | |||
|
|
35 | DIMENSION BRY(3), Y(N), CIP(4), CSS(3), CSR(3), CY(2) | |||
|
|
36 | DATA CZERO,CONE,CI/(0.0E0,0.0E0),(1.0E0,0.0E0),(0.0E0,1.0E0)/ | |||
|
|
37 | DATA CIP(1),CIP(2),CIP(3),CIP(4)/ | |||
|
|
38 | 1 (1.0E0,0.0E0), (0.0E0,1.0E0), (-1.0E0,0.0E0), (0.0E0,-1.0E0)/ | |||
|
|
39 | DATA HPI, AIC / | |||
|
|
40 | 1 1.57079632679489662E+00, 1.265512123484645396E+00/ | |||
|
|
41 | C***FIRST EXECUTABLE STATEMENT CUNI2 | |||
|
|
42 | NZ = 0 | |||
|
|
43 | ND = N | |||
|
|
44 | NLAST = 0 | |||
|
|
45 | C----------------------------------------------------------------------- | |||
|
|
46 | C COMPUTED VALUES WITH EXPONENTS BETWEEN ALIM AND ELIM IN MAG- | |||
|
|
47 | C NITUDE ARE SCALED TO KEEP INTERMEDIATE ARITHMETIC ON SCALE, | |||
|
|
48 | C EXP(ALIM)=EXP(ELIM)*TOL | |||
|
|
49 | C----------------------------------------------------------------------- | |||
|
|
50 | CSCL = CMPLX(1.0E0/TOL,0.0E0) | |||
|
|
51 | CRSC = CMPLX(TOL,0.0E0) | |||
|
|
52 | CSS(1) = CSCL | |||
|
|
53 | CSS(2) = CONE | |||
|
|
54 | CSS(3) = CRSC | |||
|
|
55 | CSR(1) = CRSC | |||
|
|
56 | CSR(2) = CONE | |||
|
|
57 | CSR(3) = CSCL | |||
|
|
58 | BRY(1) = 1.0E+3*R1MACH(1)/TOL | |||
|
|
59 | YY = AIMAG(Z) | |||
|
|
60 | C----------------------------------------------------------------------- | |||
|
|
61 | C ZN IS IN THE RIGHT HALF PLANE AFTER ROTATION BY CI OR -CI | |||
|
|
62 | C----------------------------------------------------------------------- | |||
|
|
63 | ZN = -Z*CI | |||
|
|
64 | ZB = Z | |||
|
|
65 | CID = -CI | |||
|
|
66 | INU = FNU | |||
|
|
67 | ANG = HPI*(FNU-INU) | |||
|
|
68 | CAR = COS(ANG) | |||
|
|
69 | SAR = SIN(ANG) | |||
|
|
70 | C2 = CMPLX(CAR,SAR) | |||
|
|
71 | ZAR = C2 | |||
|
|
72 | IN = INU + N - 1 | |||
|
|
73 | IN = MOD(IN,4) | |||
|
|
74 | C2 = C2*CIP(IN+1) | |||
|
|
75 | IF (YY.GT.0.0E0) GO TO 10 | |||
|
|
76 | ZN = CONJG(-ZN) | |||
|
|
77 | ZB = CONJG(ZB) | |||
|
|
78 | CID = -CID | |||
|
|
79 | C2 = CONJG(C2) | |||
|
|
80 | 10 CONTINUE | |||
|
|
81 | C----------------------------------------------------------------------- | |||
|
|
82 | C CHECK FOR UNDERFLOW AND OVERFLOW ON FIRST MEMBER | |||
|
|
83 | C----------------------------------------------------------------------- | |||
|
|
84 | FN = MAX(FNU,1.0E0) | |||
|
|
85 | CALL CUNHJ(ZN, FN, 1, TOL, PHI, ARG, ZETA1, ZETA2, ASUM, BSUM) | |||
|
|
86 | IF (KODE.EQ.1) GO TO 20 | |||
|
|
87 | CFN = CMPLX(FNU,0.0E0) | |||
|
|
88 | S1 = -ZETA1 + CFN*(CFN/(ZB+ZETA2)) | |||
|
|
89 | GO TO 30 | |||
|
|
90 | 20 CONTINUE | |||
|
|
91 | S1 = -ZETA1 + ZETA2 | |||
|
|
92 | 30 CONTINUE | |||
|
|
93 | RS1 = REAL(S1) | |||
|
|
94 | IF (ABS(RS1).GT.ELIM) GO TO 150 | |||
|
|
95 | 40 CONTINUE | |||
|
|
96 | NN = MIN(2,ND) | |||
|
|
97 | DO 90 I=1,NN | |||
|
|
98 | FN = FNU + (ND-I) | |||
|
|
99 | CALL CUNHJ(ZN, FN, 0, TOL, PHI, ARG, ZETA1, ZETA2, ASUM, BSUM) | |||
|
|
100 | IF (KODE.EQ.1) GO TO 50 | |||
|
|
101 | CFN = CMPLX(FN,0.0E0) | |||
|
|
102 | AY = ABS(YY) | |||
|
|
103 | S1 = -ZETA1 + CFN*(CFN/(ZB+ZETA2)) + CMPLX(0.0E0,AY) | |||
|
|
104 | GO TO 60 | |||
|
|
105 | 50 CONTINUE | |||
|
|
106 | S1 = -ZETA1 + ZETA2 | |||
|
|
107 | 60 CONTINUE | |||
|
|
108 | C----------------------------------------------------------------------- | |||
|
|
109 | C TEST FOR UNDERFLOW AND OVERFLOW | |||
|
|
110 | C----------------------------------------------------------------------- | |||
|
|
111 | RS1 = REAL(S1) | |||
|
|
112 | IF (ABS(RS1).GT.ELIM) GO TO 120 | |||
|
|
113 | IF (I.EQ.1) IFLAG = 2 | |||
|
|
114 | IF (ABS(RS1).LT.ALIM) GO TO 70 | |||
|
|
115 | C----------------------------------------------------------------------- | |||
|
|
116 | C REFINE TEST AND SCALE | |||
|
|
117 | C----------------------------------------------------------------------- | |||
|
|
118 | C----------------------------------------------------------------------- | |||
|
|
119 | APHI = ABS(PHI) | |||
|
|
120 | AARG = ABS(ARG) | |||
|
|
121 | RS1 = RS1 + ALOG(APHI) - 0.25E0*ALOG(AARG) - AIC | |||
|
|
122 | IF (ABS(RS1).GT.ELIM) GO TO 120 | |||
|
|
123 | IF (I.EQ.1) IFLAG = 1 | |||
|
|
124 | IF (RS1.LT.0.0E0) GO TO 70 | |||
|
|
125 | IF (I.EQ.1) IFLAG = 3 | |||
|
|
126 | 70 CONTINUE | |||
|
|
127 | C----------------------------------------------------------------------- | |||
|
|
128 | C SCALE S1 TO KEEP INTERMEDIATE ARITHMETIC ON SCALE NEAR | |||
|
|
129 | C EXPONENT EXTREMES | |||
|
|
130 | C----------------------------------------------------------------------- | |||
|
|
131 | CALL CAIRY(ARG, 0, 2, AI, NAI, IDUM) | |||
|
|
132 | CALL CAIRY(ARG, 1, 2, DAI, NDAI, IDUM) | |||
|
|
133 | S2 = PHI*(AI*ASUM+DAI*BSUM) | |||
|
|
134 | C2R = REAL(S1) | |||
|
|
135 | C2I = AIMAG(S1) | |||
|
|
136 | C2M = EXP(C2R)*REAL(CSS(IFLAG)) | |||
|
|
137 | S1 = CMPLX(C2M,0.0E0)*CMPLX(COS(C2I),SIN(C2I)) | |||
|
|
138 | S2 = S2*S1 | |||
|
|
139 | IF (IFLAG.NE.1) GO TO 80 | |||
|
|
140 | CALL CUCHK(S2, NW, BRY(1), TOL) | |||
|
|
141 | IF (NW.NE.0) GO TO 120 | |||
|
|
142 | 80 CONTINUE | |||
|
|
143 | IF (YY.LE.0.0E0) S2 = CONJG(S2) | |||
|
|
144 | J = ND - I + 1 | |||
|
|
145 | S2 = S2*C2 | |||
|
|
146 | CY(I) = S2 | |||
|
|
147 | Y(J) = S2*CSR(IFLAG) | |||
|
|
148 | C2 = C2*CID | |||
|
|
149 | 90 CONTINUE | |||
|
|
150 | IF (ND.LE.2) GO TO 110 | |||
|
|
151 | RZ = CMPLX(2.0E0,0.0E0)/Z | |||
|
|
152 | BRY(2) = 1.0E0/BRY(1) | |||
|
|
153 | BRY(3) = R1MACH(2) | |||
|
|
154 | S1 = CY(1) | |||
|
|
155 | S2 = CY(2) | |||
|
|
156 | C1 = CSR(IFLAG) | |||
|
|
157 | ASCLE = BRY(IFLAG) | |||
|
|
158 | K = ND - 2 | |||
|
|
159 | FN = K | |||
|
|
160 | DO 100 I=3,ND | |||
|
|
161 | C2 = S2 | |||
|
|
162 | S2 = S1 + CMPLX(FNU+FN,0.0E0)*RZ*S2 | |||
|
|
163 | S1 = C2 | |||
|
|
164 | C2 = S2*C1 | |||
|
|
165 | Y(K) = C2 | |||
|
|
166 | K = K - 1 | |||
|
|
167 | FN = FN - 1.0E0 | |||
|
|
168 | IF (IFLAG.GE.3) GO TO 100 | |||
|
|
169 | C2R = REAL(C2) | |||
|
|
170 | C2I = AIMAG(C2) | |||
|
|
171 | C2R = ABS(C2R) | |||
|
|
172 | C2I = ABS(C2I) | |||
|
|
173 | C2M = MAX(C2R,C2I) | |||
|
|
174 | IF (C2M.LE.ASCLE) GO TO 100 | |||
|
|
175 | IFLAG = IFLAG + 1 | |||
|
|
176 | ASCLE = BRY(IFLAG) | |||
|
|
177 | S1 = S1*C1 | |||
|
|
178 | S2 = C2 | |||
|
|
179 | S1 = S1*CSS(IFLAG) | |||
|
|
180 | S2 = S2*CSS(IFLAG) | |||
|
|
181 | C1 = CSR(IFLAG) | |||
|
|
182 | 100 CONTINUE | |||
|
|
183 | 110 CONTINUE | |||
|
|
184 | RETURN | |||
|
|
185 | 120 CONTINUE | |||
|
|
186 | IF (RS1.GT.0.0E0) GO TO 140 | |||
|
|
187 | C----------------------------------------------------------------------- | |||
|
|
188 | C SET UNDERFLOW AND UPDATE PARAMETERS | |||
|
|
189 | C----------------------------------------------------------------------- | |||
|
|
190 | Y(ND) = CZERO | |||
|
|
191 | NZ = NZ + 1 | |||
|
|
192 | ND = ND - 1 | |||
|
|
193 | IF (ND.EQ.0) GO TO 110 | |||
|
|
194 | CALL CUOIK(Z, FNU, KODE, 1, ND, Y, NUF, TOL, ELIM, ALIM) | |||
|
|
195 | IF (NUF.LT.0) GO TO 140 | |||
|
|
196 | ND = ND - NUF | |||
|
|
197 | NZ = NZ + NUF | |||
|
|
198 | IF (ND.EQ.0) GO TO 110 | |||
|
|
199 | FN = FNU + (ND-1) | |||
|
|
200 | IF (FN.LT.FNUL) GO TO 130 | |||
|
|
201 | C FN = AIMAG(CID) | |||
|
|
202 | C J = NUF + 1 | |||
|
|
203 | C K = MOD(J,4) + 1 | |||
|
|
204 | C S1 = CIP(K) | |||
|
|
205 | C IF (FN.LT.0.0E0) S1 = CONJG(S1) | |||
|
|
206 | C C2 = C2*S1 | |||
|
|
207 | IN = INU + ND - 1 | |||
|
|
208 | IN = MOD(IN,4) + 1 | |||
|
|
209 | C2 = ZAR*CIP(IN) | |||
|
|
210 | IF (YY.LE.0.0E0)C2=CONJG(C2) | |||
|
|
211 | GO TO 40 | |||
|
|
212 | 130 CONTINUE | |||
|
|
213 | NLAST = ND | |||
|
|
214 | RETURN | |||
|
|
215 | 140 CONTINUE | |||
|
|
216 | NZ = -1 | |||
|
|
217 | RETURN | |||
|
|
218 | 150 CONTINUE | |||
|
|
219 | IF (RS1.GT.0.0E0) GO TO 140 | |||
|
|
220 | NZ = N | |||
|
|
221 | DO 160 I=1,N | |||
|
|
222 | Y(I) = CZERO | |||
|
|
223 | 160 CONTINUE | |||
|
|
224 | RETURN | |||
|
|
225 | END | |||
| @@ -0,0 +1,198 | |||||
|
|
1 | *DECK CUNIK | |||
|
|
2 | SUBROUTINE CUNIK (ZR, FNU, IKFLG, IPMTR, TOL, INIT, PHI, ZETA1, | |||
|
|
3 | + ZETA2, SUM, CWRK) | |||
|
|
4 | C***BEGIN PROLOGUE CUNIK | |||
|
|
5 | C***SUBSIDIARY | |||
|
|
6 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
7 | C***LIBRARY SLATEC | |||
|
|
8 | C***TYPE ALL (CUNIK-A, ZUNIK-A) | |||
|
|
9 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
10 | C***DESCRIPTION | |||
|
|
11 | C | |||
|
|
12 | C CUNIK COMPUTES PARAMETERS FOR THE UNIFORM ASYMPTOTIC | |||
|
|
13 | C EXPANSIONS OF THE I AND K FUNCTIONS ON IKFLG= 1 OR 2 | |||
|
|
14 | C RESPECTIVELY BY | |||
|
|
15 | C | |||
|
|
16 | C W(FNU,ZR) = PHI*EXP(ZETA)*SUM | |||
|
|
17 | C | |||
|
|
18 | C WHERE ZETA=-ZETA1 + ZETA2 OR | |||
|
|
19 | C ZETA1 - ZETA2 | |||
|
|
20 | C | |||
|
|
21 | C THE FIRST CALL MUST HAVE INIT=0. SUBSEQUENT CALLS WITH THE | |||
|
|
22 | C SAME ZR AND FNU WILL RETURN THE I OR K FUNCTION ON IKFLG= | |||
|
|
23 | C 1 OR 2 WITH NO CHANGE IN INIT. CWRK IS A COMPLEX WORK | |||
|
|
24 | C ARRAY. IPMTR=0 COMPUTES ALL PARAMETERS. IPMTR=1 COMPUTES PHI, | |||
|
|
25 | C ZETA1,ZETA2. | |||
|
|
26 | C | |||
|
|
27 | C***SEE ALSO CBESI, CBESK | |||
|
|
28 | C***ROUTINES CALLED R1MACH | |||
|
|
29 | C***REVISION HISTORY (YYMMDD) | |||
|
|
30 | C 830501 DATE WRITTEN | |||
|
|
31 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
32 | C***END PROLOGUE CUNIK | |||
|
|
33 | COMPLEX CFN, CON, CONE, CRFN, CWRK, CZERO, PHI, S, SR, SUM, T, | |||
|
|
34 | * T2, ZETA1, ZETA2, ZN, ZR | |||
|
|
35 | REAL AC, C, FNU, RFN, TEST, TOL, TSTR, TSTI, R1MACH | |||
|
|
36 | INTEGER I, IKFLG, INIT, IPMTR, J, K, L | |||
|
|
37 | DIMENSION C(120), CWRK(16), CON(2) | |||
|
|
38 | DATA CZERO, CONE / (0.0E0,0.0E0), (1.0E0,0.0E0) / | |||
|
|
39 | DATA CON(1), CON(2) / | |||
|
|
40 | 1(3.98942280401432678E-01,0.0E0),(1.25331413731550025E+00,0.0E0)/ | |||
|
|
41 | DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10), | |||
|
|
42 | 1 C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18), | |||
|
|
43 | 2 C(19), C(20), C(21), C(22), C(23), C(24)/ | |||
|
|
44 | 3 1.00000000000000000E+00, -2.08333333333333333E-01, | |||
|
|
45 | 4 1.25000000000000000E-01, 3.34201388888888889E-01, | |||
|
|
46 | 5 -4.01041666666666667E-01, 7.03125000000000000E-02, | |||
|
|
47 | 6 -1.02581259645061728E+00, 1.84646267361111111E+00, | |||
|
|
48 | 7 -8.91210937500000000E-01, 7.32421875000000000E-02, | |||
|
|
49 | 8 4.66958442342624743E+00, -1.12070026162229938E+01, | |||
|
|
50 | 9 8.78912353515625000E+00, -2.36408691406250000E+00, | |||
|
|
51 | A 1.12152099609375000E-01, -2.82120725582002449E+01, | |||
|
|
52 | B 8.46362176746007346E+01, -9.18182415432400174E+01, | |||
|
|
53 | C 4.25349987453884549E+01, -7.36879435947963170E+00, | |||
|
|
54 | D 2.27108001708984375E-01, 2.12570130039217123E+02, | |||
|
|
55 | E -7.65252468141181642E+02, 1.05999045252799988E+03/ | |||
|
|
56 | DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32), | |||
|
|
57 | 1 C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40), | |||
|
|
58 | 2 C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/ | |||
|
|
59 | 3 -6.99579627376132541E+02, 2.18190511744211590E+02, | |||
|
|
60 | 4 -2.64914304869515555E+01, 5.72501420974731445E-01, | |||
|
|
61 | 5 -1.91945766231840700E+03, 8.06172218173730938E+03, | |||
|
|
62 | 6 -1.35865500064341374E+04, 1.16553933368645332E+04, | |||
|
|
63 | 7 -5.30564697861340311E+03, 1.20090291321635246E+03, | |||
|
|
64 | 8 -1.08090919788394656E+02, 1.72772750258445740E+00, | |||
|
|
65 | 9 2.02042913309661486E+04, -9.69805983886375135E+04, | |||
|
|
66 | A 1.92547001232531532E+05, -2.03400177280415534E+05, | |||
|
|
67 | B 1.22200464983017460E+05, -4.11926549688975513E+04, | |||
|
|
68 | C 7.10951430248936372E+03, -4.93915304773088012E+02, | |||
|
|
69 | D 6.07404200127348304E+00, -2.42919187900551333E+05, | |||
|
|
70 | E 1.31176361466297720E+06, -2.99801591853810675E+06/ | |||
|
|
71 | DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56), | |||
|
|
72 | 1 C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64), | |||
|
|
73 | 2 C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/ | |||
|
|
74 | 3 3.76327129765640400E+06, -2.81356322658653411E+06, | |||
|
|
75 | 4 1.26836527332162478E+06, -3.31645172484563578E+05, | |||
|
|
76 | 5 4.52187689813627263E+04, -2.49983048181120962E+03, | |||
|
|
77 | 6 2.43805296995560639E+01, 3.28446985307203782E+06, | |||
|
|
78 | 7 -1.97068191184322269E+07, 5.09526024926646422E+07, | |||
|
|
79 | 8 -7.41051482115326577E+07, 6.63445122747290267E+07, | |||
|
|
80 | 9 -3.75671766607633513E+07, 1.32887671664218183E+07, | |||
|
|
81 | A -2.78561812808645469E+06, 3.08186404612662398E+05, | |||
|
|
82 | B -1.38860897537170405E+04, 1.10017140269246738E+02, | |||
|
|
83 | C -4.93292536645099620E+07, 3.25573074185765749E+08, | |||
|
|
84 | D -9.39462359681578403E+08, 1.55359689957058006E+09, | |||
|
|
85 | E -1.62108055210833708E+09, 1.10684281682301447E+09/ | |||
|
|
86 | DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80), | |||
|
|
87 | 1 C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88), | |||
|
|
88 | 2 C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/ | |||
|
|
89 | 3 -4.95889784275030309E+08, 1.42062907797533095E+08, | |||
|
|
90 | 4 -2.44740627257387285E+07, 2.24376817792244943E+06, | |||
|
|
91 | 5 -8.40054336030240853E+04, 5.51335896122020586E+02, | |||
|
|
92 | 6 8.14789096118312115E+08, -5.86648149205184723E+09, | |||
|
|
93 | 7 1.86882075092958249E+10, -3.46320433881587779E+10, | |||
|
|
94 | 8 4.12801855797539740E+10, -3.30265997498007231E+10, | |||
|
|
95 | 9 1.79542137311556001E+10, -6.56329379261928433E+09, | |||
|
|
96 | A 1.55927986487925751E+09, -2.25105661889415278E+08, | |||
|
|
97 | B 1.73951075539781645E+07, -5.49842327572288687E+05, | |||
|
|
98 | C 3.03809051092238427E+03, -1.46792612476956167E+10, | |||
|
|
99 | D 1.14498237732025810E+11, -3.99096175224466498E+11, | |||
|
|
100 | E 8.19218669548577329E+11, -1.09837515608122331E+12/ | |||
|
|
101 | DATA C(97), C(98), C(99), C(100), C(101), C(102), C(103), C(104), | |||
|
|
102 | 1 C(105), C(106), C(107), C(108), C(109), C(110), C(111), | |||
|
|
103 | 2 C(112), C(113), C(114), C(115), C(116), C(117), C(118)/ | |||
|
|
104 | 3 1.00815810686538209E+12, -6.45364869245376503E+11, | |||
|
|
105 | 4 2.87900649906150589E+11, -8.78670721780232657E+10, | |||
|
|
106 | 5 1.76347306068349694E+10, -2.16716498322379509E+09, | |||
|
|
107 | 6 1.43157876718888981E+08, -3.87183344257261262E+06, | |||
|
|
108 | 7 1.82577554742931747E+04, 2.86464035717679043E+11, | |||
|
|
109 | 8 -2.40629790002850396E+12, 9.10934118523989896E+12, | |||
|
|
110 | 9 -2.05168994109344374E+13, 3.05651255199353206E+13, | |||
|
|
111 | A -3.16670885847851584E+13, 2.33483640445818409E+13, | |||
|
|
112 | B -1.23204913055982872E+13, 4.61272578084913197E+12, | |||
|
|
113 | C -1.19655288019618160E+12, 2.05914503232410016E+11, | |||
|
|
114 | D -2.18229277575292237E+10, 1.24700929351271032E+09/ | |||
|
|
115 | DATA C(119), C(120)/ | |||
|
|
116 | 1 -2.91883881222208134E+07, 1.18838426256783253E+05/ | |||
|
|
117 | C***FIRST EXECUTABLE STATEMENT CUNIK | |||
|
|
118 | IF (INIT.NE.0) GO TO 40 | |||
|
|
119 | C----------------------------------------------------------------------- | |||
|
|
120 | C INITIALIZE ALL VARIABLES | |||
|
|
121 | C----------------------------------------------------------------------- | |||
|
|
122 | RFN = 1.0E0/FNU | |||
|
|
123 | CRFN = CMPLX(RFN,0.0E0) | |||
|
|
124 | C T = ZR*CRFN | |||
|
|
125 | C----------------------------------------------------------------------- | |||
|
|
126 | C OVERFLOW TEST (ZR/FNU TOO SMALL) | |||
|
|
127 | C----------------------------------------------------------------------- | |||
|
|
128 | TSTR = REAL(ZR) | |||
|
|
129 | TSTI = AIMAG(ZR) | |||
|
|
130 | TEST = R1MACH(1)*1.0E+3 | |||
|
|
131 | AC = FNU*TEST | |||
|
|
132 | IF (ABS(TSTR).GT.AC .OR. ABS(TSTI).GT.AC) GO TO 15 | |||
|
|
133 | AC = 2.0E0*ABS(ALOG(TEST))+FNU | |||
|
|
134 | ZETA1 = CMPLX(AC,0.0E0) | |||
|
|
135 | ZETA2 = CMPLX(FNU,0.0E0) | |||
|
|
136 | PHI=CONE | |||
|
|
137 | RETURN | |||
|
|
138 | 15 CONTINUE | |||
|
|
139 | T=ZR*CRFN | |||
|
|
140 | S = CONE + T*T | |||
|
|
141 | SR = CSQRT(S) | |||
|
|
142 | CFN = CMPLX(FNU,0.0E0) | |||
|
|
143 | ZN = (CONE+SR)/T | |||
|
|
144 | ZETA1 = CFN*CLOG(ZN) | |||
|
|
145 | ZETA2 = CFN*SR | |||
|
|
146 | T = CONE/SR | |||
|
|
147 | SR = T*CRFN | |||
|
|
148 | CWRK(16) = CSQRT(SR) | |||
|
|
149 | PHI = CWRK(16)*CON(IKFLG) | |||
|
|
150 | IF (IPMTR.NE.0) RETURN | |||
|
|
151 | T2 = CONE/S | |||
|
|
152 | CWRK(1) = CONE | |||
|
|
153 | CRFN = CONE | |||
|
|
154 | AC = 1.0E0 | |||
|
|
155 | L = 1 | |||
|
|
156 | DO 20 K=2,15 | |||
|
|
157 | S = CZERO | |||
|
|
158 | DO 10 J=1,K | |||
|
|
159 | L = L + 1 | |||
|
|
160 | S = S*T2 + CMPLX(C(L),0.0E0) | |||
|
|
161 | 10 CONTINUE | |||
|
|
162 | CRFN = CRFN*SR | |||
|
|
163 | CWRK(K) = CRFN*S | |||
|
|
164 | AC = AC*RFN | |||
|
|
165 | TSTR = REAL(CWRK(K)) | |||
|
|
166 | TSTI = AIMAG(CWRK(K)) | |||
|
|
167 | TEST = ABS(TSTR) + ABS(TSTI) | |||
|
|
168 | IF (AC.LT.TOL .AND. TEST.LT.TOL) GO TO 30 | |||
|
|
169 | 20 CONTINUE | |||
|
|
170 | K = 15 | |||
|
|
171 | 30 CONTINUE | |||
|
|
172 | INIT = K | |||
|
|
173 | 40 CONTINUE | |||
|
|
174 | IF (IKFLG.EQ.2) GO TO 60 | |||
|
|
175 | C----------------------------------------------------------------------- | |||
|
|
176 | C COMPUTE SUM FOR THE I FUNCTION | |||
|
|
177 | C----------------------------------------------------------------------- | |||
|
|
178 | S = CZERO | |||
|
|
179 | DO 50 I=1,INIT | |||
|
|
180 | S = S + CWRK(I) | |||
|
|
181 | 50 CONTINUE | |||
|
|
182 | SUM = S | |||
|
|
183 | PHI = CWRK(16)*CON(1) | |||
|
|
184 | RETURN | |||
|
|
185 | 60 CONTINUE | |||
|
|
186 | C----------------------------------------------------------------------- | |||
|
|
187 | C COMPUTE SUM FOR THE K FUNCTION | |||
|
|
188 | C----------------------------------------------------------------------- | |||
|
|
189 | S = CZERO | |||
|
|
190 | T = CONE | |||
|
|
191 | DO 70 I=1,INIT | |||
|
|
192 | S = S + T*CWRK(I) | |||
|
|
193 | T = -T | |||
|
|
194 | 70 CONTINUE | |||
|
|
195 | SUM = S | |||
|
|
196 | PHI = CWRK(16)*CON(2) | |||
|
|
197 | RETURN | |||
|
|
198 | END | |||
| @@ -0,0 +1,170 | |||||
|
|
1 | *DECK CUOIK | |||
|
|
2 | SUBROUTINE CUOIK (Z, FNU, KODE, IKFLG, N, Y, NUF, TOL, ELIM, ALIM) | |||
|
|
3 | C***BEGIN PROLOGUE CUOIK | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBESH, CBESI and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CUOIK-A, ZUOIK-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CUOIK COMPUTES THE LEADING TERMS OF THE UNIFORM ASYMPTOTIC | |||
|
|
12 | C EXPANSIONS FOR THE I AND K FUNCTIONS AND COMPARES THEM | |||
|
|
13 | C (IN LOGARITHMIC FORM) TO ALIM AND ELIM FOR OVER AND UNDERFLOW | |||
|
|
14 | C WHERE ALIM.LT.ELIM. IF THE MAGNITUDE, BASED ON THE LEADING | |||
|
|
15 | C EXPONENTIAL, IS LESS THAN ALIM OR GREATER THAN -ALIM, THEN | |||
|
|
16 | C THE RESULT IS ON SCALE. IF NOT, THEN A REFINED TEST USING OTHER | |||
|
|
17 | C MULTIPLIERS (IN LOGARITHMIC FORM) IS MADE BASED ON ELIM. HERE | |||
|
|
18 | C EXP(-ELIM)=SMALLEST MACHINE NUMBER*1.0E+3 AND EXP(-ALIM)= | |||
|
|
19 | C EXP(-ELIM)/TOL | |||
|
|
20 | C | |||
|
|
21 | C IKFLG=1 MEANS THE I SEQUENCE IS TESTED | |||
|
|
22 | C =2 MEANS THE K SEQUENCE IS TESTED | |||
|
|
23 | C NUF = 0 MEANS THE LAST MEMBER OF THE SEQUENCE IS ON SCALE | |||
|
|
24 | C =-1 MEANS AN OVERFLOW WOULD OCCUR | |||
|
|
25 | C IKFLG=1 AND NUF.GT.0 MEANS THE LAST NUF Y VALUES WERE SET TO ZERO | |||
|
|
26 | C THE FIRST N-NUF VALUES MUST BE SET BY ANOTHER ROUTINE | |||
|
|
27 | C IKFLG=2 AND NUF.EQ.N MEANS ALL Y VALUES WERE SET TO ZERO | |||
|
|
28 | C IKFLG=2 AND 0.LT.NUF.LT.N NOT CONSIDERED. Y MUST BE SET BY | |||
|
|
29 | C ANOTHER ROUTINE | |||
|
|
30 | C | |||
|
|
31 | C***SEE ALSO CBESH, CBESI, CBESK | |||
|
|
32 | C***ROUTINES CALLED CUCHK, CUNHJ, CUNIK, R1MACH | |||
|
|
33 | C***REVISION HISTORY (YYMMDD) | |||
|
|
34 | C 830501 DATE WRITTEN | |||
|
|
35 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
36 | C***END PROLOGUE CUOIK | |||
|
|
37 | COMPLEX ARG, ASUM, BSUM, CWRK, CZ, CZERO, PHI, SUM, Y, Z, ZB, | |||
|
|
38 | * ZETA1, ZETA2, ZN, ZR | |||
|
|
39 | REAL AARG, AIC, ALIM, APHI, ASCLE, AX, AY, ELIM, FNN, FNU, GNN, | |||
|
|
40 | * GNU, RCZ, TOL, X, YY, R1MACH | |||
|
|
41 | INTEGER I, IFORM, IKFLG, INIT, KODE, N, NN, NUF, NW | |||
|
|
42 | DIMENSION Y(N), CWRK(16) | |||
|
|
43 | DATA CZERO / (0.0E0,0.0E0) / | |||
|
|
44 | DATA AIC / 1.265512123484645396E+00 / | |||
|
|
45 | C***FIRST EXECUTABLE STATEMENT CUOIK | |||
|
|
46 | NUF = 0 | |||
|
|
47 | NN = N | |||
|
|
48 | X = REAL(Z) | |||
|
|
49 | ZR = Z | |||
|
|
50 | IF (X.LT.0.0E0) ZR = -Z | |||
|
|
51 | ZB = ZR | |||
|
|
52 | YY = AIMAG(ZR) | |||
|
|
53 | AX = ABS(X)*1.7321E0 | |||
|
|
54 | AY = ABS(YY) | |||
|
|
55 | IFORM = 1 | |||
|
|
56 | IF (AY.GT.AX) IFORM = 2 | |||
|
|
57 | GNU = MAX(FNU,1.0E0) | |||
|
|
58 | IF (IKFLG.EQ.1) GO TO 10 | |||
|
|
59 | FNN = NN | |||
|
|
60 | GNN = FNU + FNN - 1.0E0 | |||
|
|
61 | GNU = MAX(GNN,FNN) | |||
|
|
62 | 10 CONTINUE | |||
|
|
63 | C----------------------------------------------------------------------- | |||
|
|
64 | C ONLY THE MAGNITUDE OF ARG AND PHI ARE NEEDED ALONG WITH THE | |||
|
|
65 | C REAL PARTS OF ZETA1, ZETA2 AND ZB. NO ATTEMPT IS MADE TO GET | |||
|
|
66 | C THE SIGN OF THE IMAGINARY PART CORRECT. | |||
|
|
67 | C----------------------------------------------------------------------- | |||
|
|
68 | IF (IFORM.EQ.2) GO TO 20 | |||
|
|
69 | INIT = 0 | |||
|
|
70 | CALL CUNIK(ZR, GNU, IKFLG, 1, TOL, INIT, PHI, ZETA1, ZETA2, SUM, | |||
|
|
71 | * CWRK) | |||
|
|
72 | CZ = -ZETA1 + ZETA2 | |||
|
|
73 | GO TO 40 | |||
|
|
74 | 20 CONTINUE | |||
|
|
75 | ZN = -ZR*CMPLX(0.0E0,1.0E0) | |||
|
|
76 | IF (YY.GT.0.0E0) GO TO 30 | |||
|
|
77 | ZN = CONJG(-ZN) | |||
|
|
78 | 30 CONTINUE | |||
|
|
79 | CALL CUNHJ(ZN, GNU, 1, TOL, PHI, ARG, ZETA1, ZETA2, ASUM, BSUM) | |||
|
|
80 | CZ = -ZETA1 + ZETA2 | |||
|
|
81 | AARG = ABS(ARG) | |||
|
|
82 | 40 CONTINUE | |||
|
|
83 | IF (KODE.EQ.2) CZ = CZ - ZB | |||
|
|
84 | IF (IKFLG.EQ.2) CZ = -CZ | |||
|
|
85 | APHI = ABS(PHI) | |||
|
|
86 | RCZ = REAL(CZ) | |||
|
|
87 | C----------------------------------------------------------------------- | |||
|
|
88 | C OVERFLOW TEST | |||
|
|
89 | C----------------------------------------------------------------------- | |||
|
|
90 | IF (RCZ.GT.ELIM) GO TO 170 | |||
|
|
91 | IF (RCZ.LT.ALIM) GO TO 50 | |||
|
|
92 | RCZ = RCZ + ALOG(APHI) | |||
|
|
93 | IF (IFORM.EQ.2) RCZ = RCZ - 0.25E0*ALOG(AARG) - AIC | |||
|
|
94 | IF (RCZ.GT.ELIM) GO TO 170 | |||
|
|
95 | GO TO 100 | |||
|
|
96 | 50 CONTINUE | |||
|
|
97 | C----------------------------------------------------------------------- | |||
|
|
98 | C UNDERFLOW TEST | |||
|
|
99 | C----------------------------------------------------------------------- | |||
|
|
100 | IF (RCZ.LT.(-ELIM)) GO TO 60 | |||
|
|
101 | IF (RCZ.GT.(-ALIM)) GO TO 100 | |||
|
|
102 | RCZ = RCZ + ALOG(APHI) | |||
|
|
103 | IF (IFORM.EQ.2) RCZ = RCZ - 0.25E0*ALOG(AARG) - AIC | |||
|
|
104 | IF (RCZ.GT.(-ELIM)) GO TO 80 | |||
|
|
105 | 60 CONTINUE | |||
|
|
106 | DO 70 I=1,NN | |||
|
|
107 | Y(I) = CZERO | |||
|
|
108 | 70 CONTINUE | |||
|
|
109 | NUF = NN | |||
|
|
110 | RETURN | |||
|
|
111 | 80 CONTINUE | |||
|
|
112 | ASCLE = 1.0E+3*R1MACH(1)/TOL | |||
|
|
113 | CZ = CZ + CLOG(PHI) | |||
|
|
114 | IF (IFORM.EQ.1) GO TO 90 | |||
|
|
115 | CZ = CZ - CMPLX(0.25E0,0.0E0)*CLOG(ARG) - CMPLX(AIC,0.0E0) | |||
|
|
116 | 90 CONTINUE | |||
|
|
117 | AX = EXP(RCZ)/TOL | |||
|
|
118 | AY = AIMAG(CZ) | |||
|
|
119 | CZ = CMPLX(AX,0.0E0)*CMPLX(COS(AY),SIN(AY)) | |||
|
|
120 | CALL CUCHK(CZ, NW, ASCLE, TOL) | |||
|
|
121 | IF (NW.EQ.1) GO TO 60 | |||
|
|
122 | 100 CONTINUE | |||
|
|
123 | IF (IKFLG.EQ.2) RETURN | |||
|
|
124 | IF (N.EQ.1) RETURN | |||
|
|
125 | C----------------------------------------------------------------------- | |||
|
|
126 | C SET UNDERFLOWS ON I SEQUENCE | |||
|
|
127 | C----------------------------------------------------------------------- | |||
|
|
128 | 110 CONTINUE | |||
|
|
129 | GNU = FNU + (NN-1) | |||
|
|
130 | IF (IFORM.EQ.2) GO TO 120 | |||
|
|
131 | INIT = 0 | |||
|
|
132 | CALL CUNIK(ZR, GNU, IKFLG, 1, TOL, INIT, PHI, ZETA1, ZETA2, SUM, | |||
|
|
133 | * CWRK) | |||
|
|
134 | CZ = -ZETA1 + ZETA2 | |||
|
|
135 | GO TO 130 | |||
|
|
136 | 120 CONTINUE | |||
|
|
137 | CALL CUNHJ(ZN, GNU, 1, TOL, PHI, ARG, ZETA1, ZETA2, ASUM, BSUM) | |||
|
|
138 | CZ = -ZETA1 + ZETA2 | |||
|
|
139 | AARG = ABS(ARG) | |||
|
|
140 | 130 CONTINUE | |||
|
|
141 | IF (KODE.EQ.2) CZ = CZ - ZB | |||
|
|
142 | APHI = ABS(PHI) | |||
|
|
143 | RCZ = REAL(CZ) | |||
|
|
144 | IF (RCZ.LT.(-ELIM)) GO TO 140 | |||
|
|
145 | IF (RCZ.GT.(-ALIM)) RETURN | |||
|
|
146 | RCZ = RCZ + ALOG(APHI) | |||
|
|
147 | IF (IFORM.EQ.2) RCZ = RCZ - 0.25E0*ALOG(AARG) - AIC | |||
|
|
148 | IF (RCZ.GT.(-ELIM)) GO TO 150 | |||
|
|
149 | 140 CONTINUE | |||
|
|
150 | Y(NN) = CZERO | |||
|
|
151 | NN = NN - 1 | |||
|
|
152 | NUF = NUF + 1 | |||
|
|
153 | IF (NN.EQ.0) RETURN | |||
|
|
154 | GO TO 110 | |||
|
|
155 | 150 CONTINUE | |||
|
|
156 | ASCLE = 1.0E+3*R1MACH(1)/TOL | |||
|
|
157 | CZ = CZ + CLOG(PHI) | |||
|
|
158 | IF (IFORM.EQ.1) GO TO 160 | |||
|
|
159 | CZ = CZ - CMPLX(0.25E0,0.0E0)*CLOG(ARG) - CMPLX(AIC,0.0E0) | |||
|
|
160 | 160 CONTINUE | |||
|
|
161 | AX = EXP(RCZ)/TOL | |||
|
|
162 | AY = AIMAG(CZ) | |||
|
|
163 | CZ = CMPLX(AX,0.0E0)*CMPLX(COS(AY),SIN(AY)) | |||
|
|
164 | CALL CUCHK(CZ, NW, ASCLE, TOL) | |||
|
|
165 | IF (NW.EQ.1) GO TO 140 | |||
|
|
166 | RETURN | |||
|
|
167 | 170 CONTINUE | |||
|
|
168 | NUF = -1 | |||
|
|
169 | RETURN | |||
|
|
170 | END | |||
| @@ -0,0 +1,86 | |||||
|
|
1 | *DECK CWRSK | |||
|
|
2 | SUBROUTINE CWRSK (ZR, FNU, KODE, N, Y, NZ, CW, TOL, ELIM, ALIM) | |||
|
|
3 | C***BEGIN PROLOGUE CWRSK | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Subsidiary to CBESI and CBESK | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***TYPE ALL (CWRSK-A, ZWRSK-A) | |||
|
|
8 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
9 | C***DESCRIPTION | |||
|
|
10 | C | |||
|
|
11 | C CWRSK COMPUTES THE I BESSEL FUNCTION FOR RE(Z).GE.0.0 BY | |||
|
|
12 | C NORMALIZING THE I FUNCTION RATIOS FROM CRATI BY THE WRONSKIAN | |||
|
|
13 | C | |||
|
|
14 | C***SEE ALSO CBESI, CBESK | |||
|
|
15 | C***ROUTINES CALLED CBKNU, CRATI, R1MACH | |||
|
|
16 | C***REVISION HISTORY (YYMMDD) | |||
|
|
17 | C 830501 DATE WRITTEN | |||
|
|
18 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
19 | C***END PROLOGUE CWRSK | |||
|
|
20 | COMPLEX CINU, CSCL, CT, CW, C1, C2, RCT, ST, Y, ZR | |||
|
|
21 | REAL ACT, ACW, ALIM, ASCLE, ELIM, FNU, S1, S2, TOL, YY, R1MACH | |||
|
|
22 | INTEGER I, KODE, N, NW, NZ | |||
|
|
23 | DIMENSION Y(N), CW(2) | |||
|
|
24 | C***FIRST EXECUTABLE STATEMENT CWRSK | |||
|
|
25 | C----------------------------------------------------------------------- | |||
|
|
26 | C I(FNU+I-1,Z) BY BACKWARD RECURRENCE FOR RATIOS | |||
|
|
27 | C Y(I)=I(FNU+I,Z)/I(FNU+I-1,Z) FROM CRATI NORMALIZED BY THE | |||
|
|
28 | C WRONSKIAN WITH K(FNU,Z) AND K(FNU+1,Z) FROM CBKNU. | |||
|
|
29 | C----------------------------------------------------------------------- | |||
|
|
30 | NZ = 0 | |||
|
|
31 | CALL CBKNU(ZR, FNU, KODE, 2, CW, NW, TOL, ELIM, ALIM) | |||
|
|
32 | IF (NW.NE.0) GO TO 50 | |||
|
|
33 | CALL CRATI(ZR, FNU, N, Y, TOL) | |||
|
|
34 | C----------------------------------------------------------------------- | |||
|
|
35 | C RECUR FORWARD ON I(FNU+1,Z) = R(FNU,Z)*I(FNU,Z), | |||
|
|
36 | C R(FNU+J-1,Z)=Y(J), J=1,...,N | |||
|
|
37 | C----------------------------------------------------------------------- | |||
|
|
38 | CINU = CMPLX(1.0E0,0.0E0) | |||
|
|
39 | IF (KODE.EQ.1) GO TO 10 | |||
|
|
40 | YY = AIMAG(ZR) | |||
|
|
41 | S1 = COS(YY) | |||
|
|
42 | S2 = SIN(YY) | |||
|
|
43 | CINU = CMPLX(S1,S2) | |||
|
|
44 | 10 CONTINUE | |||
|
|
45 | C----------------------------------------------------------------------- | |||
|
|
46 | C ON LOW EXPONENT MACHINES THE K FUNCTIONS CAN BE CLOSE TO BOTH | |||
|
|
47 | C THE UNDER AND OVERFLOW LIMITS AND THE NORMALIZATION MUST BE | |||
|
|
48 | C SCALED TO PREVENT OVER OR UNDERFLOW. CUOIK HAS DETERMINED THAT | |||
|
|
49 | C THE RESULT IS ON SCALE. | |||
|
|
50 | C----------------------------------------------------------------------- | |||
|
|
51 | ACW = ABS(CW(2)) | |||
|
|
52 | ASCLE = 1.0E+3*R1MACH(1)/TOL | |||
|
|
53 | CSCL = CMPLX(1.0E0,0.0E0) | |||
|
|
54 | IF (ACW.GT.ASCLE) GO TO 20 | |||
|
|
55 | CSCL = CMPLX(1.0E0/TOL,0.0E0) | |||
|
|
56 | GO TO 30 | |||
|
|
57 | 20 CONTINUE | |||
|
|
58 | ASCLE = 1.0E0/ASCLE | |||
|
|
59 | IF (ACW.LT.ASCLE) GO TO 30 | |||
|
|
60 | CSCL = CMPLX(TOL,0.0E0) | |||
|
|
61 | 30 CONTINUE | |||
|
|
62 | C1 = CW(1)*CSCL | |||
|
|
63 | C2 = CW(2)*CSCL | |||
|
|
64 | ST = Y(1) | |||
|
|
65 | C----------------------------------------------------------------------- | |||
|
|
66 | C CINU=CINU*(CONJG(CT)/ABS(CT))*(1.0E0/ABS(CT) PREVENTS | |||
|
|
67 | C UNDER- OR OVERFLOW PREMATURELY BY SQUARING ABS(CT) | |||
|
|
68 | C----------------------------------------------------------------------- | |||
|
|
69 | CT = ZR*(C2+ST*C1) | |||
|
|
70 | ACT = ABS(CT) | |||
|
|
71 | RCT = CMPLX(1.0E0/ACT,0.0E0) | |||
|
|
72 | CT = CONJG(CT)*RCT | |||
|
|
73 | CINU = CINU*RCT*CT | |||
|
|
74 | Y(1) = CINU*CSCL | |||
|
|
75 | IF (N.EQ.1) RETURN | |||
|
|
76 | DO 40 I=2,N | |||
|
|
77 | CINU = ST*CINU | |||
|
|
78 | ST = Y(I) | |||
|
|
79 | Y(I) = CINU*CSCL | |||
|
|
80 | 40 CONTINUE | |||
|
|
81 | RETURN | |||
|
|
82 | 50 CONTINUE | |||
|
|
83 | NZ = -1 | |||
|
|
84 | IF(NW.EQ.(-2)) NZ=-2 | |||
|
|
85 | RETURN | |||
|
|
86 | END | |||
| This diff has been collapsed as it changes many lines, (621 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,621 | |||||
|
|
1 | subroutine guess(acf,tau,npts,zero,amin,te,tr) | |||
|
|
2 | c | |||
|
|
3 | c find zero crossing (zero), depth of minimum (amin), height of maximum | |||
|
|
4 | c | |||
|
|
5 | real acf(npts),tau(npts) | |||
|
|
6 | ||||
|
|
7 | zero=0.0 | |||
|
|
8 | amin=1.0 | |||
|
|
9 | tmin=0.0 | |||
|
|
10 | jmin=0 | |||
|
|
11 | ||||
|
|
12 | do i=npts,2,-1 | |||
|
|
13 | if(acf(i)*acf(i-1).lt.0.0) then | |||
|
|
14 | zero=(tau(i-1)*acf(i)-tau(i)*acf(i-1))/(acf(i)-acf(i-1)) | |||
|
|
15 | end if | |||
|
|
16 | if(acf(i).lt.amin) then | |||
|
|
17 | amin=acf(i) | |||
|
|
18 | jmin=i | |||
|
|
19 | end if | |||
|
|
20 | end do | |||
|
|
21 | ||||
|
|
22 | if(jmin.gt.0) then | |||
|
|
23 | call parab1(tau(jmin-1),acf(jmin-1),a,b,c) | |||
|
|
24 | tmin=-b/(2.0*a) | |||
|
|
25 | amin=c+tmin*(b+tmin*a) | |||
|
|
26 | end if | |||
|
|
27 | ||||
|
|
28 | tr=cdtr1(-amin) | |||
|
|
29 | te=czte1(zero*1000.0,tr) | |||
|
|
30 | return | |||
|
|
31 | end | |||
|
|
32 | ||||
|
|
33 | subroutine parab1(x,y,a,b,c) | |||
|
|
34 | C----- | |||
|
|
35 | dimension x(3),y(3) | |||
|
|
36 | delta=x(1)-x(2) | |||
|
|
37 | a=(y(1)-2.*y(2)+y(3))/(2.*delta*delta) | |||
|
|
38 | b=(y(1)-y(2))/delta - a*(x(1)+x(2)) | |||
|
|
39 | c=y(1)-a*x(1)*x(1)-b*x(1) | |||
|
|
40 | return | |||
|
|
41 | end | |||
|
|
42 | ||||
|
|
43 | real function cdtr1(depth) | |||
|
|
44 | C-----convert depth to te/ti ratio | |||
|
|
45 | dimension tr(4) | |||
|
|
46 | C according to the curve published in farley et al 1967 | |||
|
|
47 | c modified for 2004 conditions on axis | |||
|
|
48 | c data tr/7.31081,3.53286,5.92271,.174/ | |||
|
|
49 | data tr/9.5,4.0,8.5,.3/ | |||
|
|
50 | data nt/4/ | |||
|
|
51 | cdtr1=tr(1) | |||
|
|
52 | do i=2,nt | |||
|
|
53 | cdtr1=cdtr1*depth + tr(i) | |||
|
|
54 | end do | |||
|
|
55 | return | |||
|
|
56 | end | |||
|
|
57 | ||||
|
|
58 | real function czte1(zlag,tr) | |||
|
|
59 | C-----convert zero crossing point to te | |||
|
|
60 | C according to the curve published in farley et al 1967 | |||
|
|
61 | c modified for 2004 conditions on axis | |||
|
|
62 | dimension dt(4) | |||
|
|
63 | c data dt/0.00945025,-0.0774338,.203626,.812397/,nd/4/ | |||
|
|
64 | data dt/0.00945025,-0.0774338,.2,0.9/,nd/4/ | |||
|
|
65 | data t0/1000./ | |||
|
|
66 | tr1=min(abs(tr),5.) | |||
|
|
67 | if(zlag .eq. 0)then | |||
|
|
68 | czte1=1000000. | |||
|
|
69 | else | |||
|
|
70 | dt0=dt(1) | |||
|
|
71 | do i=2,nd | |||
|
|
72 | dt0=dt0*tr1 + dt(i) | |||
|
|
73 | end do | |||
|
|
74 | czte1=t0*(dt0/zlag)**2 | |||
|
|
75 | end if | |||
|
|
76 | return | |||
|
|
77 | end | |||
|
|
78 | ||||
|
|
79 | subroutine fit(wl,taup,rhop,covar,cinv,sigma2p,paramp,ebp, | |||
|
|
80 | & bfldp,alphap,densp,alt,time,nl,ifitp,ist) | |||
|
|
81 | c | |||
|
|
82 | c subroutine to fit measured ACF | |||
|
|
83 | c wavelength wl (m),lags taup (s), normalized acf rhop, | |||
|
|
84 | c experimental variances sigma2p, covariances covar, | |||
|
|
85 | c fit parameters params, error bars ebp, magnetic field bfldp (gauss), | |||
|
|
86 | c alphap B-field angle (radians), density densp (gcs), | |||
|
|
87 | c altitude alt (km), time (LT hours), nl lags | |||
|
|
88 | c ifitp determines which parameters are fit (see below) | |||
|
|
89 | c | |||
|
|
90 | real tol,pi,wl | |||
|
|
91 | parameter(nlmax=100,npmax=10,lwa=2000,tol=1.0e-5) | |||
|
|
92 | external fcn | |||
|
|
93 | ||||
|
|
94 | real covar(nl,nl),cinv(nl,nl) | |||
|
|
95 | real ev(nlmax*nlmax),ap(nlmax*(nlmax+1)/2) | |||
|
|
96 | real fv1(nlmax),fv2(nlmax),det(2),w(nlmax) | |||
|
|
97 | ||||
|
|
98 | real taup(nl),rhop(nl),sigma2p(nl),paramp(npmax) | |||
|
|
99 | real p2(npmax),ebp(npmax),alphap,bfldp,densp | |||
|
|
100 | real tau(nlmax),rho(nlmax),sigma2(nlmax),params(npmax) | |||
|
|
101 | real fvec(nlmax),wa(lwa),wa2(lwa),eb(npmax) | |||
|
|
102 | ||||
|
|
103 | integer iwa(npmax),ifitp(npmax),ifit(npmax) | |||
|
|
104 | ||||
|
|
105 | include 'fitter.h' | |||
|
|
106 | common /mode/imode | |||
|
|
107 | ||||
|
|
108 | common/fitter/tau,rho,sigma2,params,ifit | |||
|
|
109 | common/trans/ev | |||
|
|
110 | C----- | |||
|
|
111 | ||||
|
|
112 | c set ifit(1-5) to unity to fit: | |||
|
|
113 | c 1 normalization | |||
|
|
114 | c 2 Te | |||
|
|
115 | c 3 Ti | |||
|
|
116 | c 4 H+ | |||
|
|
117 | c 5 He+ | |||
|
|
118 | ||||
|
|
119 | imode=2 | |||
|
|
120 | c | |||
|
|
121 | pi=4.0*atan(1.0) | |||
|
|
122 | ak=2.0*pi/wl | |||
|
|
123 | ||||
|
|
124 | wi(1)=16 | |||
|
|
125 | wi(2)=1 | |||
|
|
126 | wi(3)=4 | |||
|
|
127 | nion=3 | |||
|
|
128 | ||||
|
|
129 | c | |||
|
|
130 | c invert covariances and find eigenvalues and eigenvectors | |||
|
|
131 | c | |||
|
|
132 | l = 0 | |||
|
|
133 | do 20 j = 1, nl | |||
|
|
134 | do 10 i = 1, j | |||
|
|
135 | l = l + 1 | |||
|
|
136 | ap(l) = covar(i,j) | |||
|
|
137 | 10 continue | |||
|
|
138 | 20 continue | |||
|
|
139 | ||||
|
|
140 | call sppfa(ap,nl,info) | |||
|
|
141 | call sppdi(ap,nl,det,01) | |||
|
|
142 | ||||
|
|
143 | l = 0 | |||
|
|
144 | do 40 j = 1, nl | |||
|
|
145 | do 30 i = 1, j | |||
|
|
146 | l = l + 1 | |||
|
|
147 | cinv(i,j)=ap(l) | |||
|
|
148 | cinv(j,i)=ap(l) | |||
|
|
149 | 30 continue | |||
|
|
150 | 40 continue | |||
|
|
151 | ||||
|
|
152 | c | |||
|
|
153 | c transformation matrix is inverse (transpose) of eigenvectors | |||
|
|
154 | c | |||
|
|
155 | ||||
|
|
156 | matz=1 | |||
|
|
157 | call rs(nl,nl,cinv,w,matz,ev,fv1,fv2,ierr) | |||
|
|
158 | ||||
|
|
159 | do i=1,nl | |||
|
|
160 | sigma2(i)=1.0/w(i) | |||
|
|
161 | end do | |||
|
|
162 | ||||
|
|
163 | c | |||
|
|
164 | c extract desired parameters | |||
|
|
165 | c | |||
|
|
166 | iparm=0 | |||
|
|
167 | do i=1,5 | |||
|
|
168 | eb(i)=0.0 | |||
|
|
169 | if(ifitp(i).eq.1) then | |||
|
|
170 | iparm=iparm+1 | |||
|
|
171 | p2(iparm)=paramp(i) | |||
|
|
172 | end if | |||
|
|
173 | ifit(i)=ifitp(i) | |||
|
|
174 | params(i)=paramp(i) | |||
|
|
175 | end do | |||
|
|
176 | np=iparm | |||
|
|
177 | ||||
|
|
178 | alpha=alphap | |||
|
|
179 | dens=densp | |||
|
|
180 | do i=1,nl | |||
|
|
181 | tau(i)=taup(i) | |||
|
|
182 | rho(i)=rhop(i) | |||
|
|
183 | sigma2p(i)=sigma2(i) | |||
|
|
184 | end do | |||
|
|
185 | ||||
|
|
186 | bfld=bfldp | |||
|
|
187 | ||||
|
|
188 | c | |||
|
|
189 | c no. equations is no. lags - do nlls fit | |||
|
|
190 | c | |||
|
|
191 | ||||
|
|
192 | call lmdif1(fcn,nl,np,p2,fvec,tol,info,iwa,wa,lwa) | |||
|
|
193 | ist=info | |||
|
|
194 | ||||
|
|
195 | c | |||
|
|
196 | c generate error bars here | |||
|
|
197 | c | |||
|
|
198 | call fdjac2(fcn,nl,np,p2,fvec,wa,nl,iflag,0.0e0,wa2) | |||
|
|
199 | ||||
|
|
200 | do i=1,np | |||
|
|
201 | err=0.0 | |||
|
|
202 | do j=1,nl | |||
|
|
203 | err=err+(wa(j+(i-1)*nl))**2 | |||
|
|
204 | end do | |||
|
|
205 | if(err.gt.0.0) eb(i)=sqrt(err**-1) | |||
|
|
206 | end do | |||
|
|
207 | ||||
|
|
208 | c reorder results | |||
|
|
209 | iparm=0 | |||
|
|
210 | do i=1,5 | |||
|
|
211 | if(ifit(i).eq.1) then | |||
|
|
212 | iparm=iparm+1 | |||
|
|
213 | paramp(i)=p2(iparm) | |||
|
|
214 | ebp(i)=eb(iparm) | |||
|
|
215 | else | |||
|
|
216 | ebp(i)=0.0 | |||
|
|
217 | paramp(i)=params(i) | |||
|
|
218 | end if | |||
|
|
219 | end do | |||
|
|
220 | ||||
|
|
221 | 9 continue | |||
|
|
222 | c write(*,*) dens | |||
|
|
223 | c write(*,*) te | |||
|
|
224 | ||||
|
|
225 | return | |||
|
|
226 | end | |||
|
|
227 | ||||
|
|
228 | ||||
|
|
229 | subroutine fcn(m,n,x,fvec,iflag) | |||
|
|
230 | c | |||
|
|
231 | c provides m functions (fvec) in n variables (x) to minimize | |||
|
|
232 | c in least-squares sense | |||
|
|
233 | c | |||
|
|
234 | ||||
|
|
235 | parameter(nlmax=100,npmax=10) | |||
|
|
236 | integer m,n,iflag | |||
|
|
237 | real fvec(m) | |||
|
|
238 | ||||
|
|
239 | integer ifit(npmax) | |||
|
|
240 | real x(n),fv(nlmax),anorm,params(npmax),ev(nlmax*nlmax) | |||
|
|
241 | real tau(nlmax),rho(nlmax),sigma2(nlmax) | |||
|
|
242 | real chisq,acf | |||
|
|
243 | ||||
|
|
244 | include 'fitter.h' | |||
|
|
245 | ||||
|
|
246 | common/fitter/tau,rho,sigma2,params,ifit | |||
|
|
247 | common /errs/ chisq | |||
|
|
248 | common /trans/ev | |||
|
|
249 | ||||
|
|
250 | c 1 0 0 0 0 fit zero lag (otherwise set to default) | |||
|
|
251 | c 0 1 0 0 0 fit Te (otherwise default) | |||
|
|
252 | c 0 0 1 0 0 fit Ti (otherwise set to Te) | |||
|
|
253 | c 0 0 0 1 0 fit H+ (otherwize default) | |||
|
|
254 | c 0 0 0 0 1 fit He+ (otherwise default) | |||
|
|
255 | ||||
|
|
256 | 8 continue | |||
|
|
257 | ||||
|
|
258 | c | |||
|
|
259 | c ignore collisions | |||
|
|
260 | c | |||
|
|
261 | c write(*,*) "starting fcn" | |||
|
|
262 | ven=0.0 | |||
|
|
263 | do i=1,3 | |||
|
|
264 | vin(i)=0.0 | |||
|
|
265 | end do | |||
|
|
266 | ||||
|
|
267 | iparm=0 | |||
|
|
268 | ||||
|
|
269 | c | |||
|
|
270 | c zero lag normalization constant | |||
|
|
271 | c | |||
|
|
272 | if(ifit(1).eq.1) then | |||
|
|
273 | iparm=iparm+1 | |||
|
|
274 | c=x(iparm) | |||
|
|
275 | else | |||
|
|
276 | c=params(1) | |||
|
|
277 | end if | |||
|
|
278 | c | |||
|
|
279 | c Te | |||
|
|
280 | c | |||
|
|
281 | if(ifit(2).eq.1) then | |||
|
|
282 | iparm=iparm+1 | |||
|
|
283 | te=x(iparm) | |||
|
|
284 | else | |||
|
|
285 | te=params(2) | |||
|
|
286 | end if | |||
|
|
287 | c | |||
|
|
288 | c Ti - default is Te rather than initial value | |||
|
|
289 | c | |||
|
|
290 | if(ifit(3).eq.1) then | |||
|
|
291 | iparm=iparm+1 | |||
|
|
292 | do i=1,3 | |||
|
|
293 | ti(i)=x(iparm) | |||
|
|
294 | end do | |||
|
|
295 | else | |||
|
|
296 | do i=1,3 | |||
|
|
297 | ti(i)=te | |||
|
|
298 | end do | |||
|
|
299 | params(3)=te | |||
|
|
300 | end if | |||
|
|
301 | ||||
|
|
302 | c three-ion plasma | |||
|
|
303 | ||||
|
|
304 | nion=3 | |||
|
|
305 | c | |||
|
|
306 | c composition H+ first | |||
|
|
307 | c | |||
|
|
308 | fi(1)=1.0 | |||
|
|
309 | if(ifit(4).eq.1) then | |||
|
|
310 | iparm=iparm+1 | |||
|
|
311 | fi(2)=(x(iparm)) | |||
|
|
312 | fi(1)=fi(1)-(x(iparm)) | |||
|
|
313 | else | |||
|
|
314 | fi(2)=params(4) | |||
|
|
315 | fi(1)=fi(1)-params(4) | |||
|
|
316 | end if | |||
|
|
317 | c | |||
|
|
318 | c He+ | |||
|
|
319 | c | |||
|
|
320 | if(ifit(5).eq.1) then | |||
|
|
321 | iparm=iparm+1 | |||
|
|
322 | fi(3)=(x(iparm)) | |||
|
|
323 | fi(1)=fi(1)-(x(iparm)) | |||
|
|
324 | else | |||
|
|
325 | fi(3)=params(5) | |||
|
|
326 | fi(1)=fi(1)-params(5) | |||
|
|
327 | end if | |||
|
|
328 | ||||
|
|
329 | c write(*,*) x,bfld,alpha,dens,ak,m | |||
|
|
330 | ||||
|
|
331 | call gaussq(0.0,anorm) | |||
|
|
332 | anorm=anorm/c | |||
|
|
333 | ||||
|
|
334 | if(anorm.eq.0.0.or.m.eq.0)return | |||
|
|
335 | chisq=0.0 | |||
|
|
336 | do i=1,m | |||
|
|
337 | call gaussq(tau(i),acf) | |||
|
|
338 | fv(i)=(acf/anorm-rho(i)) | |||
|
|
339 | end do | |||
|
|
340 | ||||
|
|
341 | c | |||
|
|
342 | c transform to space where s2 is diagonal | |||
|
|
343 | c (are i and j transposed below?) | |||
|
|
344 | c | |||
|
|
345 | do i=1,m | |||
|
|
346 | fvec(i)=0.0 | |||
|
|
347 | do j=1,m | |||
|
|
348 | fvec(i)=fvec(i)+fv(j)*ev(j+(i-1)*m)/sqrt(sigma2(i)) | |||
|
|
349 | end do | |||
|
|
350 | chisq=chisq+fvec(i)**2 | |||
|
|
351 | end do | |||
|
|
352 | ||||
|
|
353 | chisq=chisq/float(m) | |||
|
|
354 | ||||
|
|
355 | c write(*,*) fvec | |||
|
|
356 | c write(*,*) chisq | |||
|
|
357 | c stop | |||
|
|
358 | ||||
|
|
359 | return | |||
|
|
360 | end | |||
|
|
361 | ||||
|
|
362 | c | |||
|
|
363 | c not really fond of above code | |||
|
|
364 | c | |||
|
|
365 | ||||
|
|
366 | ||||
|
|
367 | complex function cj_ion(theta,psi) | |||
|
|
368 | c | |||
|
|
369 | real theta,phi,psi,alpha | |||
|
|
370 | complex z | |||
|
|
371 | complex*16 zz | |||
|
|
372 | z=zz(dcmplx(-theta,psi)) | |||
|
|
373 | cj_ion=z*cmplx(0.0,-1.0) | |||
|
|
374 | return | |||
|
|
375 | end | |||
|
|
376 | ||||
|
|
377 | complex function cj_electron(theta,phi,psi,alpha) | |||
|
|
378 | c | |||
|
|
379 | c Theta, phi, and psi are the normalized frequency, gyrofrequency, | |||
|
|
380 | c and collision frequency. Alpha is angle between wavevector and | |||
|
|
381 | c magnetic field in radians. | |||
|
|
382 | c | |||
|
|
383 | parameter(nterms=10) | |||
|
|
384 | real theta,phi,psi,alpha | |||
|
|
385 | real arg | |||
|
|
386 | complex cj,cy(0:nterms) | |||
|
|
387 | complex z | |||
|
|
388 | complex*16 zz | |||
|
|
389 | integer m,nz,ierr | |||
|
|
390 | integer imode | |||
|
|
391 | common/mode/imode | |||
|
|
392 | c | |||
|
|
393 | if(imode.eq.3) then | |||
|
|
394 | ||||
|
|
395 | arg=0.5*(sin(alpha)/phi)**2 | |||
|
|
396 | ||||
|
|
397 | c calculate modified Bessel functions using amos library | |||
|
|
398 | ||||
|
|
399 | call cbesi(cmplx(arg,0.0),0.0,2,nterms+1,cy,nz,ierr) | |||
|
|
400 | ||||
|
|
401 | cj=cmplx(0.0,0.0) | |||
|
|
402 | ||||
|
|
403 | do m=-nterms,nterms | |||
|
|
404 | z=zz(dcmplx(-(theta-float(m)*phi)/cos(alpha), | |||
|
|
405 | & psi/cos(alpha))) | |||
|
|
406 | cj=cj+z*cy(iabs(m)) | |||
|
|
407 | end do | |||
|
|
408 | ||||
|
|
409 | cj_electron=cj*cmplx(0.0,-1.0/cos(alpha)) | |||
|
|
410 | ||||
|
|
411 | else | |||
|
|
412 | ||||
|
|
413 | z=zz(dcmplx(-theta/cos(alpha),psi/cos(alpha))) | |||
|
|
414 | cj_electron=z*cmplx(0.0,-1.0/cos(alpha)) | |||
|
|
415 | cj_electron=cj_electron*(1.0-(sin(alpha)/phi)**2/2.0) | |||
|
|
416 | ||||
|
|
417 | end if | |||
|
|
418 | ||||
|
|
419 | return | |||
|
|
420 | end | |||
|
|
421 | ||||
|
|
422 | complex function y_ion(theta,psi) | |||
|
|
423 | c | |||
|
|
424 | real theta,phi,psi,alpha | |||
|
|
425 | complex cj, cj_ion | |||
|
|
426 | cj=cj_ion(theta,psi) | |||
|
|
427 | y_ion=cj*cmplx(theta,-psi)+cmplx(0.0,1.0) | |||
|
|
428 | y_ion=y_ion/(1-psi*cj) | |||
|
|
429 | return | |||
|
|
430 | end | |||
|
|
431 | ||||
|
|
432 | complex function y_electron(theta,phi,psi,alpha) | |||
|
|
433 | c | |||
|
|
434 | real theta,phi,psi,alpha | |||
|
|
435 | complex cj, cj_electron | |||
|
|
436 | cj=cj_electron(theta,phi,psi,alpha) | |||
|
|
437 | y_electron=cj*cmplx(theta,-psi)+cmplx(0.0,1.0) | |||
|
|
438 | y_electron=y_electron/(1.0-psi*cj) | |||
|
|
439 | return | |||
|
|
440 | end | |||
|
|
441 | ||||
|
|
442 | real function spect1(omega) | |||
|
|
443 | c | |||
|
|
444 | c Function to generate IS ion-line spectrum | |||
|
|
445 | c Provisions for nimax ions | |||
|
|
446 | c No provisions for drifts | |||
|
|
447 | c | |||
|
|
448 | c imode=1 Farley B-field treatment for electrons | |||
|
|
449 | c 2 use Mike Sulzer's model for ye | |||
|
|
450 | c 3 calculate ye using sums of Bessel functions | |||
|
|
451 | c | |||
|
|
452 | include 'fitter.h' | |||
|
|
453 | ||||
|
|
454 | real omega,thetae,thetai(nimax),psie,psii(nimax),phi,p | |||
|
|
455 | real tr(nimax),vti(nimax),vte,omegae | |||
|
|
456 | real bk,em,e,dlf,dl,pi | |||
|
|
457 | real alpha2,densmks,freq | |||
|
|
458 | complex ye,yed,yet,yi(nimax),sum1,sum2,sumdl | |||
|
|
459 | complex y_ion, y_electron, y_esum | |||
|
|
460 | integer i,j,k,imode | |||
|
|
461 | common/mode/ imode | |||
|
|
462 | data bk,em,e,dlf/1.38e-23,9.1e-31,1.6e-19,4772.9/ | |||
|
|
463 | ||||
|
|
464 | c fi is ion fraction, wi is ion atomic weight | |||
|
|
465 | c dens is electron density (cgs), alpha is angle | |||
|
|
466 | c between k and the magnetic field (radians) | |||
|
|
467 | ||||
|
|
468 | pi=4.0*atan(1.0) | |||
|
|
469 | ||||
|
|
470 | if(omega.eq.0.0) omega=1.0 | |||
|
|
471 | ||||
|
|
472 | omegae=e*bfld*1.0e-4/em | |||
|
|
473 | densmks=dens*1.0e6 | |||
|
|
474 | ||||
|
|
475 | sum1=0.0 | |||
|
|
476 | sum2=0.0 | |||
|
|
477 | ||||
|
|
478 | do i=1,nion | |||
|
|
479 | tr(i)=te/ti(i) | |||
|
|
480 | vti(i)=sqrt(bk*ti(i)/(1.67e-27*wi(i))) | |||
|
|
481 | thetai(i)=(omega/ak)/(sqrt(2.0)*vti(i)) | |||
|
|
482 | psii(i)=(vin(i)/ak)/(sqrt(2.0)*vti(i)) | |||
|
|
483 | yi(i)=y_ion(thetai(i),psii(i)) | |||
|
|
484 | sum1=sum1+fi(i)*tr(i)*yi(i) | |||
|
|
485 | sum2=sum2+fi(i)*yi(i) | |||
|
|
486 | end do | |||
|
|
487 | dl=ak**2*dlf*te/densmks | |||
|
|
488 | c write(*,fmt='("Before YE")') | |||
|
|
489 | c write(*,*) imode | |||
|
|
490 | c call exit | |||
|
|
491 | ||||
|
|
492 | if(imode.eq.1.or.imode.eq.3) then | |||
|
|
493 | ||||
|
|
494 | vte=sqrt(bk*te/em) | |||
|
|
495 | thetae=(omega/ak)/(sqrt(2.0)*vte) | |||
|
|
496 | phi=(omegae/ak)/(sqrt(2.0)*vte) | |||
|
|
497 | psie=(ven/ak)/(sqrt(2.0)*vte) | |||
|
|
498 | ye=y_electron(thetae,phi,psie,alpha) | |||
|
|
499 | write(*,fmt='("AFTER YE")') | |||
|
|
500 | c call exit | |||
|
|
501 | ||||
|
|
502 | else if(imode.eq.2) then | |||
|
|
503 | c | |||
|
|
504 | c use Mike Sulzer's library here: alpha2 is angle off perp in degrees | |||
|
|
505 | c | |||
|
|
506 | ||||
|
|
507 | freq=omega/(2.0*pi) | |||
|
|
508 | alpha2=abs(pi/2.0-alpha)*180.0/pi | |||
|
|
509 | c write(*,*) "ye: ", ye | |||
|
|
510 | call collision(densmks, te, freq, alpha2, ye) | |||
|
|
511 | c write(*,fmt='("AFTER COLLISION")') | |||
|
|
512 | c call exit | |||
|
|
513 | ye=ye*omega+cmplx(0.0,1.0) | |||
|
|
514 | ||||
|
|
515 | end if | |||
|
|
516 | yed=ye+cmplx(0.0,dl) | |||
|
|
517 | ||||
|
|
518 | p=(cabs(ye))**2*real(sum2)+cabs(sum1+cmplx(0.0,dl))**2*real(ye) | |||
|
|
519 | p=p/(cabs(yed+sum1))**2 | |||
|
|
520 | spect1=p*2.0e0/(omega*pi) | |||
|
|
521 | write(*,*) "spect1:",spect1 | |||
|
|
522 | return | |||
|
|
523 | end | |||
|
|
524 | ||||
|
|
525 | subroutine acf2(wl, tau, te1, ti1, fi1, ven1, vin1, wi1, | |||
|
|
526 | & alpha1, dens1, bfld1, acf, nion1) | |||
|
|
527 | c | |||
|
|
528 | c computes autocorrelation function for given plasma parameters | |||
|
|
529 | c by integrating real spectrum | |||
|
|
530 | c tau in sec., alpha in radians, density in cgs, bfield in cgs | |||
|
|
531 | c scattering wavelength (wl) in meters | |||
|
|
532 | c | |||
|
|
533 | include 'fitter.h' | |||
|
|
534 | ||||
|
|
535 | real wl,tau,te1,ti1(nion1),fi1(nion1),ven1,vin1(nion1),alpha1, | |||
|
|
536 | & dens1,bfld1,acf | |||
|
|
537 | real pi | |||
|
|
538 | integer nion1 | |||
|
|
539 | integer wi1(nion1) | |||
|
|
540 | integer i,j,k,imode | |||
|
|
541 | common /mode/imode | |||
|
|
542 | c | |||
|
|
543 | write(*,*) "INITIAL acf:",wl,tau,te1,ti1,fi1,ven1,vin1,wi1,alpha1 | |||
|
|
544 | write(*,*) "INITIAL acf:",dens1, bfld1, acf, nion1 | |||
|
|
545 | c write(*,fmt='("INIT")') | |||
|
|
546 | pi=4.0*atan(1.0) | |||
|
|
547 | c | |||
|
|
548 | c copy arguments to common block | |||
|
|
549 | c | |||
|
|
550 | ak=2.0*pi/wl | |||
|
|
551 | imode=2 | |||
|
|
552 | write(*,*) "imode:",imode | |||
|
|
553 | ||||
|
|
554 | nion=nion1 | |||
|
|
555 | alpha=alpha1 | |||
|
|
556 | te=te1 | |||
|
|
557 | ven=ven1 | |||
|
|
558 | c write(*,fmt='("INIT2")') | |||
|
|
559 | do i=1,nion | |||
|
|
560 | c write(*,fmt='("INIT2.5")') | |||
|
|
561 | ti(i)=ti1(i) | |||
|
|
562 | fi(i)=fi1(i) | |||
|
|
563 | vin(i)=vin1(i) | |||
|
|
564 | wi(i)=wi1(i) | |||
|
|
565 | end do | |||
|
|
566 | c write(*,fmt='("INIT3")') | |||
|
|
567 | dens=dens1 | |||
|
|
568 | bfld=bfld1 | |||
|
|
569 | ||||
|
|
570 | c write(*,*) wl,alpha1,bfld1,dens | |||
|
|
571 | c call exit | |||
|
|
572 | c write(*,fmt='("Before Gauss")') | |||
|
|
573 | call gaussq(tau,acf) | |||
|
|
574 | ||||
|
|
575 | write(*,*) "FINAL acf:",acf | |||
|
|
576 | ||||
|
|
577 | c write(*,fmt='("After Gauss")') | |||
|
|
578 | return | |||
|
|
579 | end | |||
|
|
580 | ||||
|
|
581 | subroutine gaussq(tau,acf) | |||
|
|
582 | c | |||
|
|
583 | c Computes cosine or sine transform of given real function | |||
|
|
584 | c Uses quadpack, tau in sec. | |||
|
|
585 | c | |||
|
|
586 | real a,abserr,epsabs,acf,tau,work,chebmo | |||
|
|
587 | integer ier,integr,iwork,last,leniw,lenw,limit,limlst, | |||
|
|
588 | * lst,maxp1,neval | |||
|
|
589 | integer knorm,ksave,momcom,nrmom | |||
|
|
590 | dimension iwork(300),work(1625),chebmo(61,25) | |||
|
|
591 | external spect1 | |||
|
|
592 | include 'fitter.h' | |||
|
|
593 | c | |||
|
|
594 | c write(*,*) "inside gaussq" | |||
|
|
595 | a = 0.0 | |||
|
|
596 | b = 2.5e4*ak ! upper integration limit open to debate (was 1.5, now 2.5) | |||
|
|
597 | integr = 1 | |||
|
|
598 | epsabs = 1.0e-4 | |||
|
|
599 | limlst = 50 | |||
|
|
600 | limit = 100 | |||
|
|
601 | leniw = limit*2+limlst | |||
|
|
602 | maxp1 = 61 | |||
|
|
603 | lenw = leniw*2+maxp1*25 | |||
|
|
604 | ||||
|
|
605 | c write(*,*) leniw,lenw | |||
|
|
606 | ||||
|
|
607 | nrmom=0 | |||
|
|
608 | ksave=0 | |||
|
|
609 | momcom=0 | |||
|
|
610 | write(*,*) "Before qc25f:",acf,imode | |||
|
|
611 | c much faster, more robust | |||
|
|
612 | c write(*,*) "acf_in: ",acf | |||
|
|
613 | call qc25f(spect1,a,b,tau,integr,nrmom,maxp1,ksave,acf, | |||
|
|
614 | & abserr,neval,resabs,resasc,momcom,chebmo) | |||
|
|
615 | c write(*,*) "acf_out: ",acf | |||
|
|
616 | c call qawf(spect1,a,tau,integr,epsabs,acf,abserr,neval, | |||
|
|
617 | c & ier,limlst,lst,leniw,maxp1,lenw,iwork,work) | |||
|
|
618 | write(*,*) "After qc25f:",acf | |||
|
|
619 | c call exit | |||
|
|
620 | return | |||
|
|
621 | end | |||
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| @@ -0,0 +1,70 | |||||
|
|
1 | ! -*- f90 -*- | |||
|
|
2 | ! Note: the context of this file is case sensitive. | |||
|
|
3 | ||||
|
|
4 | python module fitacf_acf2 ! in | |||
|
|
5 | interface ! in :fitacf_acf2 | |||
|
|
6 | subroutine acf2(wl,tau,te1,ti1,fi1,ven1,vin1,wi1,alpha1,dens1,bfld1,acf,nion1) ! in :fitacf_acf2:fitacf.f | |||
|
|
7 | real intent(in):: wl | |||
|
|
8 | real intent(in):: tau | |||
|
|
9 | real intent(in):: te1 | |||
|
|
10 | real intent(in),dimension(nion1) :: ti1 | |||
|
|
11 | real intent(in),dimension(nion1),depend(nion1) :: fi1 | |||
|
|
12 | real intent(in):: ven1 | |||
|
|
13 | real intent(in),dimension(nion1),depend(nion1) :: vin1 | |||
|
|
14 | integer intent(in),dimension(nion1),depend(nion1) :: wi1 | |||
|
|
15 | integer intent(in), optional,check(len(ti1)>=nion1),depend(ti1) :: nion1=len(ti1) | |||
|
|
16 | real intent(in):: alpha1 | |||
|
|
17 | real intent(in):: dens1 | |||
|
|
18 | real intent(in):: bfld1 | |||
|
|
19 | real intent(in,out):: acf | |||
|
|
20 | real :: te | |||
|
|
21 | real dimension(10) :: ti | |||
|
|
22 | real dimension(10) :: fi | |||
|
|
23 | real :: ven | |||
|
|
24 | real dimension(10) :: vin | |||
|
|
25 | real :: alpha | |||
|
|
26 | real :: dens | |||
|
|
27 | real :: bfld | |||
|
|
28 | integer :: nion | |||
|
|
29 | integer dimension(10) :: wi | |||
|
|
30 | real :: ak | |||
|
|
31 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
32 | end subroutine acf2 | |||
|
|
33 | function spect1(omega) ! in :fitacf_fit_short:fitacf.f | |||
|
|
34 | real :: omega | |||
|
|
35 | real :: te | |||
|
|
36 | real dimension(10) :: ti | |||
|
|
37 | real dimension(10) :: fi | |||
|
|
38 | real :: ven | |||
|
|
39 | real dimension(10) :: vin | |||
|
|
40 | real :: alpha | |||
|
|
41 | real :: dens | |||
|
|
42 | real :: bfld | |||
|
|
43 | integer :: nion | |||
|
|
44 | integer dimension(10) :: wi | |||
|
|
45 | real :: ak | |||
|
|
46 | integer :: imode | |||
|
|
47 | real :: spect1 | |||
|
|
48 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
49 | common /mode/ imode | |||
|
|
50 | end function spect1 | |||
|
|
51 | subroutine gaussq(tau,acf) ! in :fitacf_fit_short:fitacf.f | |||
|
|
52 | real :: tau | |||
|
|
53 | real :: acf | |||
|
|
54 | real :: te | |||
|
|
55 | real dimension(10) :: ti | |||
|
|
56 | real dimension(10) :: fi | |||
|
|
57 | real :: ven | |||
|
|
58 | real dimension(10) :: vin | |||
|
|
59 | real :: alpha | |||
|
|
60 | real :: dens | |||
|
|
61 | real :: bfld | |||
|
|
62 | integer :: nion | |||
|
|
63 | integer dimension(10) :: wi | |||
|
|
64 | real :: ak | |||
|
|
65 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
66 | end interface | |||
|
|
67 | end python module fitacf_acf2 | |||
|
|
68 | ||||
|
|
69 | ! This file was auto-generated with f2py (version:2). | |||
|
|
70 | ! See http://cens.ioc.ee/projects/f2py2e/ | |||
| This diff has been collapsed as it changes many lines, (544 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,544 | |||||
|
|
1 | ||||
|
|
2 | subroutine fit(wl,taup,rhop,covar,cinv,sigma2p,paramp,ebp, | |||
|
|
3 | & bfldp,alphap,densp,alt,time,ifitp,ist,nl) | |||
|
|
4 | c | |||
|
|
5 | c subroutine to fit measured ACF | |||
|
|
6 | c wavelength wl (m),lags taup (s), normalized acf rhop, | |||
|
|
7 | c experimental variances sigma2p, covariances covar, | |||
|
|
8 | c fit parameters params, error bars ebp, magnetic field bfldp (gauss), | |||
|
|
9 | c alphap B-field angle (radians), density densp (gcs), | |||
|
|
10 | c altitude alt (km), time (LT hours), nl lags | |||
|
|
11 | c ifitp determines which parameters are fit (see below) | |||
|
|
12 | c | |||
|
|
13 | real tol,pi,wl | |||
|
|
14 | parameter(nlmax=100,npmax=10,lwa=2000,tol=1.0e-5) | |||
|
|
15 | external fcn | |||
|
|
16 | ||||
|
|
17 | real covar(nl,nl),cinv(nl,nl) | |||
|
|
18 | real ev(nlmax*nlmax),ap(nlmax*(nlmax+1)/2) | |||
|
|
19 | real fv1(nlmax),fv2(nlmax),det(2),w(nlmax) | |||
|
|
20 | ||||
|
|
21 | real taup(nl),rhop(nl),sigma2p(nl),paramp(npmax) | |||
|
|
22 | real p2(npmax),ebp(npmax),alphap,bfldp,densp | |||
|
|
23 | real tau(nlmax),rho(nlmax),sigma2(nlmax),params(npmax) | |||
|
|
24 | real fvec(nlmax),wa(lwa),wa2(lwa),eb(npmax) | |||
|
|
25 | ||||
|
|
26 | integer iwa(npmax),ifitp(npmax),ifit(npmax) | |||
|
|
27 | ||||
|
|
28 | include 'fitter.h' | |||
|
|
29 | common /mode/imode | |||
|
|
30 | ||||
|
|
31 | common/fitter/tau,rho,sigma2,params,ifit | |||
|
|
32 | common/trans/ev | |||
|
|
33 | C----- | |||
|
|
34 | ||||
|
|
35 | c set ifit(1-5) to unity to fit: | |||
|
|
36 | c 1 normalization | |||
|
|
37 | c 2 Te | |||
|
|
38 | c 3 Ti | |||
|
|
39 | c 4 H+ | |||
|
|
40 | c 5 He+ | |||
|
|
41 | ||||
|
|
42 | imode=2 | |||
|
|
43 | c | |||
|
|
44 | pi=4.0*atan(1.0) | |||
|
|
45 | ak=2.0*pi/wl | |||
|
|
46 | ||||
|
|
47 | wi(1)=16 | |||
|
|
48 | wi(2)=1 | |||
|
|
49 | wi(3)=4 | |||
|
|
50 | nion=3 | |||
|
|
51 | ||||
|
|
52 | c | |||
|
|
53 | c invert covariances and find eigenvalues and eigenvectors | |||
|
|
54 | c | |||
|
|
55 | l = 0 | |||
|
|
56 | do 20 j = 1, nl | |||
|
|
57 | do 10 i = 1, j | |||
|
|
58 | l = l + 1 | |||
|
|
59 | ap(l) = covar(i,j) | |||
|
|
60 | 10 continue | |||
|
|
61 | 20 continue | |||
|
|
62 | ||||
|
|
63 | call sppfa(ap,nl,info) | |||
|
|
64 | call sppdi(ap,nl,det,01) | |||
|
|
65 | ||||
|
|
66 | l = 0 | |||
|
|
67 | do 40 j = 1, nl | |||
|
|
68 | do 30 i = 1, j | |||
|
|
69 | l = l + 1 | |||
|
|
70 | cinv(i,j)=ap(l) | |||
|
|
71 | cinv(j,i)=ap(l) | |||
|
|
72 | 30 continue | |||
|
|
73 | 40 continue | |||
|
|
74 | ||||
|
|
75 | c | |||
|
|
76 | c transformation matrix is inverse (transpose) of eigenvectors | |||
|
|
77 | c | |||
|
|
78 | ||||
|
|
79 | matz=1 | |||
|
|
80 | call rs(nl,nl,cinv,w,matz,ev,fv1,fv2,ierr) | |||
|
|
81 | ||||
|
|
82 | do i=1,nl | |||
|
|
83 | sigma2(i)=1.0/w(i) | |||
|
|
84 | end do | |||
|
|
85 | ||||
|
|
86 | c | |||
|
|
87 | c extract desired parameters | |||
|
|
88 | c | |||
|
|
89 | iparm=0 | |||
|
|
90 | do i=1,5 | |||
|
|
91 | eb(i)=0.0 | |||
|
|
92 | if(ifitp(i).eq.1) then | |||
|
|
93 | iparm=iparm+1 | |||
|
|
94 | p2(iparm)=paramp(i) | |||
|
|
95 | end if | |||
|
|
96 | ifit(i)=ifitp(i) | |||
|
|
97 | params(i)=paramp(i) | |||
|
|
98 | end do | |||
|
|
99 | np=iparm | |||
|
|
100 | ||||
|
|
101 | alpha=alphap | |||
|
|
102 | dens=densp | |||
|
|
103 | do i=1,nl | |||
|
|
104 | tau(i)=taup(i) | |||
|
|
105 | rho(i)=rhop(i) | |||
|
|
106 | sigma2p(i)=sigma2(i) | |||
|
|
107 | end do | |||
|
|
108 | ||||
|
|
109 | bfld=bfldp | |||
|
|
110 | ||||
|
|
111 | c | |||
|
|
112 | c no. equations is no. lags - do nlls fit | |||
|
|
113 | c | |||
|
|
114 | ||||
|
|
115 | call lmdif1(fcn,nl,np,p2,fvec,tol,info,iwa,wa,lwa) | |||
|
|
116 | ist=info | |||
|
|
117 | ||||
|
|
118 | c | |||
|
|
119 | c generate error bars here | |||
|
|
120 | c | |||
|
|
121 | call fdjac2(fcn,nl,np,p2,fvec,wa,nl,iflag,0.0e0,wa2) | |||
|
|
122 | ||||
|
|
123 | do i=1,np | |||
|
|
124 | err=0.0 | |||
|
|
125 | do j=1,nl | |||
|
|
126 | err=err+(wa(j+(i-1)*nl))**2 | |||
|
|
127 | end do | |||
|
|
128 | if(err.gt.0.0) eb(i)=sqrt(err**-1) | |||
|
|
129 | end do | |||
|
|
130 | ||||
|
|
131 | c reorder results | |||
|
|
132 | iparm=0 | |||
|
|
133 | do i=1,5 | |||
|
|
134 | if(ifit(i).eq.1) then | |||
|
|
135 | iparm=iparm+1 | |||
|
|
136 | paramp(i)=p2(iparm) | |||
|
|
137 | ebp(i)=eb(iparm) | |||
|
|
138 | else | |||
|
|
139 | ebp(i)=0.0 | |||
|
|
140 | paramp(i)=params(i) | |||
|
|
141 | end if | |||
|
|
142 | end do | |||
|
|
143 | ||||
|
|
144 | 9 continue | |||
|
|
145 | c write(*,*) dens | |||
|
|
146 | c write(*,*) te | |||
|
|
147 | ||||
|
|
148 | return | |||
|
|
149 | end | |||
|
|
150 | ||||
|
|
151 | ||||
|
|
152 | subroutine fcn(m,n,x,fvec,iflag) | |||
|
|
153 | c | |||
|
|
154 | c provides m functions (fvec) in n variables (x) to minimize | |||
|
|
155 | c in least-squares sense | |||
|
|
156 | c | |||
|
|
157 | ||||
|
|
158 | parameter(nlmax=100,npmax=10) | |||
|
|
159 | integer m,n,iflag | |||
|
|
160 | real fvec(m) | |||
|
|
161 | ||||
|
|
162 | integer ifit(npmax) | |||
|
|
163 | real x(n),fv(nlmax),anorm,params(npmax),ev(nlmax*nlmax) | |||
|
|
164 | real tau(nlmax),rho(nlmax),sigma2(nlmax) | |||
|
|
165 | real chisq,acf | |||
|
|
166 | ||||
|
|
167 | include 'fitter.h' | |||
|
|
168 | ||||
|
|
169 | common/fitter/tau,rho,sigma2,params,ifit | |||
|
|
170 | common /errs/ chisq | |||
|
|
171 | common /trans/ev | |||
|
|
172 | ||||
|
|
173 | c 1 0 0 0 0 fit zero lag (otherwise set to default) | |||
|
|
174 | c 0 1 0 0 0 fit Te (otherwise default) | |||
|
|
175 | c 0 0 1 0 0 fit Ti (otherwise set to Te) | |||
|
|
176 | c 0 0 0 1 0 fit H+ (otherwize default) | |||
|
|
177 | c 0 0 0 0 1 fit He+ (otherwise default) | |||
|
|
178 | ||||
|
|
179 | 8 continue | |||
|
|
180 | ||||
|
|
181 | c | |||
|
|
182 | c ignore collisions | |||
|
|
183 | c | |||
|
|
184 | c write(*,*) "starting fcn" | |||
|
|
185 | ven=0.0 | |||
|
|
186 | do i=1,3 | |||
|
|
187 | vin(i)=0.0 | |||
|
|
188 | end do | |||
|
|
189 | ||||
|
|
190 | iparm=0 | |||
|
|
191 | ||||
|
|
192 | c | |||
|
|
193 | c zero lag normalization constant | |||
|
|
194 | c | |||
|
|
195 | if(ifit(1).eq.1) then | |||
|
|
196 | iparm=iparm+1 | |||
|
|
197 | c=x(iparm) | |||
|
|
198 | else | |||
|
|
199 | c=params(1) | |||
|
|
200 | end if | |||
|
|
201 | c | |||
|
|
202 | c Te | |||
|
|
203 | c | |||
|
|
204 | if(ifit(2).eq.1) then | |||
|
|
205 | iparm=iparm+1 | |||
|
|
206 | te=x(iparm) | |||
|
|
207 | else | |||
|
|
208 | te=params(2) | |||
|
|
209 | end if | |||
|
|
210 | c | |||
|
|
211 | c Ti - default is Te rather than initial value | |||
|
|
212 | c | |||
|
|
213 | if(ifit(3).eq.1) then | |||
|
|
214 | iparm=iparm+1 | |||
|
|
215 | do i=1,3 | |||
|
|
216 | ti(i)=x(iparm) | |||
|
|
217 | end do | |||
|
|
218 | else | |||
|
|
219 | do i=1,3 | |||
|
|
220 | ti(i)=te | |||
|
|
221 | end do | |||
|
|
222 | params(3)=te | |||
|
|
223 | end if | |||
|
|
224 | ||||
|
|
225 | c three-ion plasma | |||
|
|
226 | ||||
|
|
227 | nion=3 | |||
|
|
228 | c | |||
|
|
229 | c composition H+ first | |||
|
|
230 | c | |||
|
|
231 | fi(1)=1.0 | |||
|
|
232 | if(ifit(4).eq.1) then | |||
|
|
233 | iparm=iparm+1 | |||
|
|
234 | fi(2)=(x(iparm)) | |||
|
|
235 | fi(1)=fi(1)-(x(iparm)) | |||
|
|
236 | else | |||
|
|
237 | fi(2)=params(4) | |||
|
|
238 | fi(1)=fi(1)-params(4) | |||
|
|
239 | end if | |||
|
|
240 | c | |||
|
|
241 | c He+ | |||
|
|
242 | c | |||
|
|
243 | if(ifit(5).eq.1) then | |||
|
|
244 | iparm=iparm+1 | |||
|
|
245 | fi(3)=(x(iparm)) | |||
|
|
246 | fi(1)=fi(1)-(x(iparm)) | |||
|
|
247 | else | |||
|
|
248 | fi(3)=params(5) | |||
|
|
249 | fi(1)=fi(1)-params(5) | |||
|
|
250 | end if | |||
|
|
251 | ||||
|
|
252 | c write(*,*) x,bfld,alpha,dens,ak,m | |||
|
|
253 | ||||
|
|
254 | call gaussq(0.0,anorm) | |||
|
|
255 | anorm=anorm/c | |||
|
|
256 | ||||
|
|
257 | if(anorm.eq.0.0.or.m.eq.0)return | |||
|
|
258 | chisq=0.0 | |||
|
|
259 | do i=1,m | |||
|
|
260 | call gaussq(tau(i),acf) | |||
|
|
261 | fv(i)=(acf/anorm-rho(i)) | |||
|
|
262 | end do | |||
|
|
263 | ||||
|
|
264 | c | |||
|
|
265 | c transform to space where s2 is diagonal | |||
|
|
266 | c (are i and j transposed below?) | |||
|
|
267 | c | |||
|
|
268 | do i=1,m | |||
|
|
269 | fvec(i)=0.0 | |||
|
|
270 | do j=1,m | |||
|
|
271 | fvec(i)=fvec(i)+fv(j)*ev(j+(i-1)*m)/sqrt(sigma2(i)) | |||
|
|
272 | end do | |||
|
|
273 | chisq=chisq+fvec(i)**2 | |||
|
|
274 | end do | |||
|
|
275 | ||||
|
|
276 | chisq=chisq/float(m) | |||
|
|
277 | ||||
|
|
278 | c write(*,*) fvec | |||
|
|
279 | c write(*,*) chisq | |||
|
|
280 | c stop | |||
|
|
281 | ||||
|
|
282 | return | |||
|
|
283 | end | |||
|
|
284 | ||||
|
|
285 | c | |||
|
|
286 | c not really fond of above code | |||
|
|
287 | c | |||
|
|
288 | ||||
|
|
289 | ||||
|
|
290 | complex function cj_ion(theta,psi) | |||
|
|
291 | c | |||
|
|
292 | real theta,phi,psi,alpha | |||
|
|
293 | complex z | |||
|
|
294 | complex*16 zz | |||
|
|
295 | z=zz(dcmplx(-theta,psi)) | |||
|
|
296 | cj_ion=z*cmplx(0.0,-1.0) | |||
|
|
297 | return | |||
|
|
298 | end | |||
|
|
299 | ||||
|
|
300 | complex function cj_electron(theta,phi,psi,alpha) | |||
|
|
301 | c | |||
|
|
302 | c Theta, phi, and psi are the normalized frequency, gyrofrequency, | |||
|
|
303 | c and collision frequency. Alpha is angle between wavevector and | |||
|
|
304 | c magnetic field in radians. | |||
|
|
305 | c | |||
|
|
306 | parameter(nterms=10) | |||
|
|
307 | real theta,phi,psi,alpha | |||
|
|
308 | real arg | |||
|
|
309 | complex cj,cy(0:nterms) | |||
|
|
310 | complex z | |||
|
|
311 | complex*16 zz | |||
|
|
312 | integer m,nz,ierr | |||
|
|
313 | integer imode | |||
|
|
314 | common/mode/imode | |||
|
|
315 | c | |||
|
|
316 | if(imode.eq.3) then | |||
|
|
317 | ||||
|
|
318 | arg=0.5*(sin(alpha)/phi)**2 | |||
|
|
319 | ||||
|
|
320 | c calculate modified Bessel functions using amos library | |||
|
|
321 | ||||
|
|
322 | call cbesi(cmplx(arg,0.0),0.0,2,nterms+1,cy,nz,ierr) | |||
|
|
323 | ||||
|
|
324 | cj=cmplx(0.0,0.0) | |||
|
|
325 | ||||
|
|
326 | do m=-nterms,nterms | |||
|
|
327 | z=zz(dcmplx(-(theta-float(m)*phi)/cos(alpha), | |||
|
|
328 | & psi/cos(alpha))) | |||
|
|
329 | cj=cj+z*cy(iabs(m)) | |||
|
|
330 | end do | |||
|
|
331 | ||||
|
|
332 | cj_electron=cj*cmplx(0.0,-1.0/cos(alpha)) | |||
|
|
333 | ||||
|
|
334 | else | |||
|
|
335 | ||||
|
|
336 | z=zz(dcmplx(-theta/cos(alpha),psi/cos(alpha))) | |||
|
|
337 | cj_electron=z*cmplx(0.0,-1.0/cos(alpha)) | |||
|
|
338 | cj_electron=cj_electron*(1.0-(sin(alpha)/phi)**2/2.0) | |||
|
|
339 | ||||
|
|
340 | end if | |||
|
|
341 | ||||
|
|
342 | return | |||
|
|
343 | end | |||
|
|
344 | ||||
|
|
345 | complex function y_ion(theta,psi) | |||
|
|
346 | c | |||
|
|
347 | real theta,phi,psi,alpha | |||
|
|
348 | complex cj, cj_ion | |||
|
|
349 | cj=cj_ion(theta,psi) | |||
|
|
350 | y_ion=cj*cmplx(theta,-psi)+cmplx(0.0,1.0) | |||
|
|
351 | y_ion=y_ion/(1-psi*cj) | |||
|
|
352 | return | |||
|
|
353 | end | |||
|
|
354 | ||||
|
|
355 | complex function y_electron(theta,phi,psi,alpha) | |||
|
|
356 | c | |||
|
|
357 | real theta,phi,psi,alpha | |||
|
|
358 | complex cj, cj_electron | |||
|
|
359 | cj=cj_electron(theta,phi,psi,alpha) | |||
|
|
360 | y_electron=cj*cmplx(theta,-psi)+cmplx(0.0,1.0) | |||
|
|
361 | y_electron=y_electron/(1.0-psi*cj) | |||
|
|
362 | return | |||
|
|
363 | end | |||
|
|
364 | ||||
|
|
365 | real function spect1(omega) | |||
|
|
366 | c | |||
|
|
367 | c Function to generate IS ion-line spectrum | |||
|
|
368 | c Provisions for nimax ions | |||
|
|
369 | c No provisions for drifts | |||
|
|
370 | c | |||
|
|
371 | c imode=1 Farley B-field treatment for electrons | |||
|
|
372 | c 2 use Mike Sulzer's model for ye | |||
|
|
373 | c 3 calculate ye using sums of Bessel functions | |||
|
|
374 | c | |||
|
|
375 | include 'fitter.h' | |||
|
|
376 | ||||
|
|
377 | real omega,thetae,thetai(nimax),psie,psii(nimax),phi,p | |||
|
|
378 | real tr(nimax),vti(nimax),vte,omegae | |||
|
|
379 | real bk,em,e,dlf,dl,pi | |||
|
|
380 | real alpha2,densmks,freq | |||
|
|
381 | complex ye,yed,yet,yi(nimax),sum1,sum2,sumdl | |||
|
|
382 | complex y_ion, y_electron, y_esum | |||
|
|
383 | integer i,j,k,imode | |||
|
|
384 | common/mode/ imode | |||
|
|
385 | data bk,em,e,dlf/1.38e-23,9.1e-31,1.6e-19,4772.9/ | |||
|
|
386 | ||||
|
|
387 | c fi is ion fraction, wi is ion atomic weight | |||
|
|
388 | c dens is electron density (cgs), alpha is angle | |||
|
|
389 | c between k and the magnetic field (radians) | |||
|
|
390 | ||||
|
|
391 | pi=4.0*atan(1.0) | |||
|
|
392 | ||||
|
|
393 | if(omega.eq.0.0) omega=1.0 | |||
|
|
394 | ||||
|
|
395 | omegae=e*bfld*1.0e-4/em | |||
|
|
396 | densmks=dens*1.0e6 | |||
|
|
397 | ||||
|
|
398 | sum1=0.0 | |||
|
|
399 | sum2=0.0 | |||
|
|
400 | ||||
|
|
401 | do i=1,nion | |||
|
|
402 | tr(i)=te/ti(i) | |||
|
|
403 | vti(i)=sqrt(bk*ti(i)/(1.67e-27*wi(i))) | |||
|
|
404 | thetai(i)=(omega/ak)/(sqrt(2.0)*vti(i)) | |||
|
|
405 | psii(i)=(vin(i)/ak)/(sqrt(2.0)*vti(i)) | |||
|
|
406 | yi(i)=y_ion(thetai(i),psii(i)) | |||
|
|
407 | sum1=sum1+fi(i)*tr(i)*yi(i) | |||
|
|
408 | sum2=sum2+fi(i)*yi(i) | |||
|
|
409 | end do | |||
|
|
410 | dl=ak**2*dlf*te/densmks | |||
|
|
411 | c write(*,fmt='("Before YE")') | |||
|
|
412 | c write(*,*) imode | |||
|
|
413 | c call exit | |||
|
|
414 | ||||
|
|
415 | if(imode.eq.1.or.imode.eq.3) then | |||
|
|
416 | ||||
|
|
417 | vte=sqrt(bk*te/em) | |||
|
|
418 | thetae=(omega/ak)/(sqrt(2.0)*vte) | |||
|
|
419 | phi=(omegae/ak)/(sqrt(2.0)*vte) | |||
|
|
420 | psie=(ven/ak)/(sqrt(2.0)*vte) | |||
|
|
421 | ye=y_electron(thetae,phi,psie,alpha) | |||
|
|
422 | write(*,fmt='("AFTER YE")') | |||
|
|
423 | c call exit | |||
|
|
424 | ||||
|
|
425 | else if(imode.eq.2) then | |||
|
|
426 | c | |||
|
|
427 | c use Mike Sulzer's library here: alpha2 is angle off perp in degrees | |||
|
|
428 | c | |||
|
|
429 | ||||
|
|
430 | freq=omega/(2.0*pi) | |||
|
|
431 | alpha2=abs(pi/2.0-alpha)*180.0/pi | |||
|
|
432 | c write(*,*) "ye: ", ye | |||
|
|
433 | call collision(densmks, te, freq, alpha2, ye) | |||
|
|
434 | c write(*,fmt='("AFTER COLLISION")') | |||
|
|
435 | c call exit | |||
|
|
436 | ye=ye*omega+cmplx(0.0,1.0) | |||
|
|
437 | ||||
|
|
438 | end if | |||
|
|
439 | yed=ye+cmplx(0.0,dl) | |||
|
|
440 | ||||
|
|
441 | p=(cabs(ye))**2*real(sum2)+cabs(sum1+cmplx(0.0,dl))**2*real(ye) | |||
|
|
442 | p=p/(cabs(yed+sum1))**2 | |||
|
|
443 | spect1=p*2.0e0/(omega*pi) | |||
|
|
444 | write(*,*) "spect1:",spect1 | |||
|
|
445 | return | |||
|
|
446 | end | |||
|
|
447 | ||||
|
|
448 | subroutine acf2(wl, tau, te1, ti1, fi1, ven1, vin1, wi1, | |||
|
|
449 | & alpha1, dens1, bfld1, acf, nion1) | |||
|
|
450 | c | |||
|
|
451 | c computes autocorrelation function for given plasma parameters | |||
|
|
452 | c by integrating real spectrum | |||
|
|
453 | c tau in sec., alpha in radians, density in cgs, bfield in cgs | |||
|
|
454 | c scattering wavelength (wl) in meters | |||
|
|
455 | c | |||
|
|
456 | include 'fitter.h' | |||
|
|
457 | ||||
|
|
458 | real wl,tau,te1,ti1(nion1),fi1(nion1),ven1,vin1(nion1),alpha1, | |||
|
|
459 | & dens1,bfld1,acf | |||
|
|
460 | real pi | |||
|
|
461 | integer nion1 | |||
|
|
462 | integer wi1(nion1) | |||
|
|
463 | integer i,j,k,imode | |||
|
|
464 | common /mode/imode | |||
|
|
465 | c | |||
|
|
466 | write(*,*) "INITIAL acf:",wl,tau,te1,ti1,fi1,ven1,vin1,wi1,alpha1 | |||
|
|
467 | write(*,*) "INITIAL acf:",dens1, bfld1, acf, nion1 | |||
|
|
468 | c write(*,fmt='("INIT")') | |||
|
|
469 | pi=4.0*atan(1.0) | |||
|
|
470 | c | |||
|
|
471 | c copy arguments to common block | |||
|
|
472 | c | |||
|
|
473 | ak=2.0*pi/wl | |||
|
|
474 | imode=2 | |||
|
|
475 | write(*,*) "imode:",imode | |||
|
|
476 | ||||
|
|
477 | nion=nion1 | |||
|
|
478 | alpha=alpha1 | |||
|
|
479 | te=te1 | |||
|
|
480 | ven=ven1 | |||
|
|
481 | c write(*,fmt='("INIT2")') | |||
|
|
482 | do i=1,nion | |||
|
|
483 | c write(*,fmt='("INIT2.5")') | |||
|
|
484 | ti(i)=ti1(i) | |||
|
|
485 | fi(i)=fi1(i) | |||
|
|
486 | vin(i)=vin1(i) | |||
|
|
487 | wi(i)=wi1(i) | |||
|
|
488 | end do | |||
|
|
489 | c write(*,fmt='("INIT3")') | |||
|
|
490 | dens=dens1 | |||
|
|
491 | bfld=bfld1 | |||
|
|
492 | ||||
|
|
493 | c write(*,*) wl,alpha1,bfld1,dens | |||
|
|
494 | c call exit | |||
|
|
495 | c write(*,fmt='("Before Gauss")') | |||
|
|
496 | call gaussq(tau,acf) | |||
|
|
497 | ||||
|
|
498 | write(*,*) "FINAL acf:",acf | |||
|
|
499 | ||||
|
|
500 | c write(*,fmt='("After Gauss")') | |||
|
|
501 | return | |||
|
|
502 | end | |||
|
|
503 | ||||
|
|
504 | subroutine gaussq(tau,acf) | |||
|
|
505 | c | |||
|
|
506 | c Computes cosine or sine transform of given real function | |||
|
|
507 | c Uses quadpack, tau in sec. | |||
|
|
508 | c | |||
|
|
509 | real a,abserr,epsabs,acf,tau,work,chebmo | |||
|
|
510 | integer ier,integr,iwork,last,leniw,lenw,limit,limlst, | |||
|
|
511 | * lst,maxp1,neval | |||
|
|
512 | integer knorm,ksave,momcom,nrmom | |||
|
|
513 | dimension iwork(300),work(1625),chebmo(61,25) | |||
|
|
514 | external spect1 | |||
|
|
515 | include 'fitter.h' | |||
|
|
516 | c | |||
|
|
517 | c write(*,*) "inside gaussq" | |||
|
|
518 | a = 0.0 | |||
|
|
519 | b = 2.5e4*ak ! upper integration limit open to debate (was 1.5, now 2.5) | |||
|
|
520 | integr = 1 | |||
|
|
521 | epsabs = 1.0e-4 | |||
|
|
522 | limlst = 50 | |||
|
|
523 | limit = 100 | |||
|
|
524 | leniw = limit*2+limlst | |||
|
|
525 | maxp1 = 61 | |||
|
|
526 | lenw = leniw*2+maxp1*25 | |||
|
|
527 | ||||
|
|
528 | c write(*,*) leniw,lenw | |||
|
|
529 | ||||
|
|
530 | nrmom=0 | |||
|
|
531 | ksave=0 | |||
|
|
532 | momcom=0 | |||
|
|
533 | write(*,*) "Before qc25f:",acf,imode | |||
|
|
534 | c much faster, more robust | |||
|
|
535 | c write(*,*) "acf_in: ",acf | |||
|
|
536 | call qc25f(spect1,a,b,tau,integr,nrmom,maxp1,ksave,acf, | |||
|
|
537 | & abserr,neval,resabs,resasc,momcom,chebmo) | |||
|
|
538 | c write(*,*) "acf_out: ",acf | |||
|
|
539 | c call qawf(spect1,a,tau,integr,epsabs,acf,abserr,neval, | |||
|
|
540 | c & ier,limlst,lst,leniw,maxp1,lenw,iwork,work) | |||
|
|
541 | write(*,*) "After qc25f:",acf | |||
|
|
542 | c call exit | |||
|
|
543 | return | |||
|
|
544 | end | |||
| @@ -0,0 +1,175 | |||||
|
|
1 | ! -*- f90 -*- | |||
|
|
2 | ! Note: the context of this file is case sensitive. | |||
|
|
3 | ||||
|
|
4 | python module reader__user__routines | |||
|
|
5 | interface ! in : reader.c | |||
|
|
6 | subroutine collision_(densmks, te, freq, alpha2, ye) | |||
|
|
7 | intent(c) collision_ ! foo is a C function | |||
|
|
8 | intent(c) ! all foo arguments are | |||
|
|
9 | ! considered as C based | |||
|
|
10 | real intent(in) :: densmks(1) ! x is input array | |||
|
|
11 | real intent(in) :: te(1) ! y is output array | |||
|
|
12 | real intent(in) :: freq(1) ! x is input array | |||
|
|
13 | real intent(in) :: alpha2(1) ! y is output array | |||
|
|
14 | complex intent(in,out) :: ye(1) ! y is output array | |||
|
|
15 | end subroutine foo | |||
|
|
16 | end interface | |||
|
|
17 | end python module reader | |||
|
|
18 | python module lmdif__user__routines | |||
|
|
19 | interface lmdif_user_interface | |||
|
|
20 | subroutine fcn(m,n,x,fvec,iflag) ! in :fitacf_fit_short:lmdif1.f:lmdif:unknown_interface | |||
|
|
21 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
22 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
23 | real dimension(n) :: x | |||
|
|
24 | real dimension(m) :: fvec | |||
|
|
25 | integer :: iflag | |||
|
|
26 | real :: te | |||
|
|
27 | real dimension(10) :: ti | |||
|
|
28 | real dimension(10) :: fi | |||
|
|
29 | real :: ven | |||
|
|
30 | real dimension(10) :: vin | |||
|
|
31 | real :: alpha | |||
|
|
32 | real :: dens | |||
|
|
33 | real :: bfld | |||
|
|
34 | integer :: nion | |||
|
|
35 | integer dimension(10) :: wi | |||
|
|
36 | real :: ak | |||
|
|
37 | real dimension(100) :: tau | |||
|
|
38 | real dimension(100) :: rho | |||
|
|
39 | real dimension(100) :: sigma2 | |||
|
|
40 | real dimension(10) :: params | |||
|
|
41 | integer dimension(10) :: ifit | |||
|
|
42 | real :: chisq | |||
|
|
43 | real dimension(10000) :: ev | |||
|
|
44 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
45 | common /fitter/ tau,rho,sigma2,params,ifit | |||
|
|
46 | common /errs/ chisq | |||
|
|
47 | common /trans/ ev | |||
|
|
48 | end subroutine fcn | |||
|
|
49 | end interface lmdif_user_interface | |||
|
|
50 | end python module lmdif__user__routines | |||
|
|
51 | python module fitacf_fit_short ! in | |||
|
|
52 | interface ! in :fitacf_fit_short | |||
|
|
53 | subroutine fit(wl,taup,rhop,covar,cinv,sigma2p,paramp,ebp,bfldp,alphap,densp,alt,time,ifitp,ist,nl) ! in :fitacf_fit_short:fitacf_fit_short.f | |||
|
|
54 | real intent(in):: wl | |||
|
|
55 | real dimension(nl),intent(in) :: taup | |||
|
|
56 | real dimension(nl),depend(nl),intent(in) :: rhop | |||
|
|
57 | real intent(in),dimension(nl,nl),depend(nl,nl) :: covar | |||
|
|
58 | real intent(in,out),dimension(nl,nl),depend(nl,nl) :: cinv | |||
|
|
59 | real intent(in,out),dimension(nl),depend(nl) :: sigma2p | |||
|
|
60 | real intent(in,out),dimension(10) :: paramp | |||
|
|
61 | real intent(out),dimension(10) :: ebp | |||
|
|
62 | real intent(in):: bfldp | |||
|
|
63 | real intent(in):: alphap | |||
|
|
64 | real intent(in):: densp | |||
|
|
65 | real intent(in):: alt | |||
|
|
66 | real intent(in):: time | |||
|
|
67 | integer intent(in),dimension(10) :: ifitp | |||
|
|
68 | integer intent(in,out):: ist | |||
|
|
69 | integer intent(in), check(len(taup)>=nl),depend(taup) :: nl=len(taup) | |||
|
|
70 | real :: te | |||
|
|
71 | real dimension(10) :: ti | |||
|
|
72 | real dimension(10) :: fi | |||
|
|
73 | real :: ven | |||
|
|
74 | real dimension(10) :: vin | |||
|
|
75 | real :: alpha | |||
|
|
76 | real :: dens | |||
|
|
77 | real :: bfld | |||
|
|
78 | integer :: nion | |||
|
|
79 | integer dimension(10) :: wi | |||
|
|
80 | real :: ak | |||
|
|
81 | integer :: imode | |||
|
|
82 | real dimension(100) :: tau | |||
|
|
83 | real dimension(100) :: rho | |||
|
|
84 | real dimension(100) :: sigma2 | |||
|
|
85 | real dimension(10) :: params | |||
|
|
86 | integer dimension(10) :: ifit | |||
|
|
87 | real dimension(10000) :: ev | |||
|
|
88 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
89 | common /mode/ imode | |||
|
|
90 | common /fitter/ tau,rho,sigma2,params,ifit | |||
|
|
91 | common /trans/ ev | |||
|
|
92 | end subroutine fit | |||
|
|
93 | function spect1(omega) ! in :fitacf_fit_short:fitacf_fit_short.f | |||
|
|
94 | real :: omega | |||
|
|
95 | real :: te | |||
|
|
96 | real dimension(10) :: ti | |||
|
|
97 | real dimension(10) :: fi | |||
|
|
98 | real :: ven | |||
|
|
99 | real dimension(10) :: vin | |||
|
|
100 | real :: alpha | |||
|
|
101 | real :: dens | |||
|
|
102 | real :: bfld | |||
|
|
103 | integer :: nion | |||
|
|
104 | integer dimension(10) :: wi | |||
|
|
105 | real :: ak | |||
|
|
106 | integer :: imode | |||
|
|
107 | real :: spect1 | |||
|
|
108 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
109 | common /mode/ imode | |||
|
|
110 | end function spect1 | |||
|
|
111 | subroutine gaussq(tau,acf) ! in :fitacf_fit_short:fitacf_fit_short.f | |||
|
|
112 | real :: tau | |||
|
|
113 | real :: acf | |||
|
|
114 | real :: te | |||
|
|
115 | real dimension(10) :: ti | |||
|
|
116 | real dimension(10) :: fi | |||
|
|
117 | real :: ven | |||
|
|
118 | real dimension(10) :: vin | |||
|
|
119 | real :: alpha | |||
|
|
120 | real :: dens | |||
|
|
121 | real :: bfld | |||
|
|
122 | integer :: nion | |||
|
|
123 | integer dimension(10) :: wi | |||
|
|
124 | real :: ak | |||
|
|
125 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
126 | end subroutine gaussq | |||
|
|
127 | subroutine lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) ! in :fitacf_fit_short:lmdif1.f | |||
|
|
128 | use lmdif__user__routines | |||
|
|
129 | external :: fcn | |||
|
|
130 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
131 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
132 | real dimension(n) :: x | |||
|
|
133 | real dimension(m) :: fvec | |||
|
|
134 | real :: tol | |||
|
|
135 | integer :: info | |||
|
|
136 | integer dimension(n),depend(n) :: iwa | |||
|
|
137 | real dimension(lwa) :: wa | |||
|
|
138 | integer, optional,check(len(wa)>=lwa),depend(wa) :: lwa=len(wa) | |||
|
|
139 | end subroutine lmdif1 | |||
|
|
140 | subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn,diag,mode,factor,nprint,info,nfev,fjac,ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) ! in :fitacf_fit_short:lmdif1.f | |||
|
|
141 | use lmdif__user__routines | |||
|
|
142 | external :: fcn | |||
|
|
143 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
144 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
145 | real dimension(n) :: x | |||
|
|
146 | real dimension(m) :: fvec | |||
|
|
147 | real :: ftol | |||
|
|
148 | real :: xtol | |||
|
|
149 | real :: gtol | |||
|
|
150 | integer :: maxfev | |||
|
|
151 | real :: epsfcn | |||
|
|
152 | real dimension(n),depend(n) :: diag | |||
|
|
153 | integer :: mode | |||
|
|
154 | real :: factor | |||
|
|
155 | integer :: nprint | |||
|
|
156 | integer :: info | |||
|
|
157 | integer :: nfev | |||
|
|
158 | real dimension(ldfjac,n),depend(n) :: fjac | |||
|
|
159 | integer, optional,check(shape(fjac,0)==ldfjac),depend(fjac) :: ldfjac=shape(fjac,0) | |||
|
|
160 | integer dimension(n),depend(n) :: ipvt | |||
|
|
161 | real dimension(n),depend(n) :: qtf | |||
|
|
162 | real dimension(n),depend(n) :: wa1 | |||
|
|
163 | real dimension(n),depend(n) :: wa2 | |||
|
|
164 | real dimension(n),depend(n) :: wa3 | |||
|
|
165 | real dimension(m),depend(m) :: wa4 | |||
|
|
166 | end subroutine lmdif | |||
|
|
167 | function spmpar(i) ! in :fitacf_fit_short:lmdif1.f | |||
|
|
168 | integer :: i | |||
|
|
169 | real :: spmpar | |||
|
|
170 | end function spmpar | |||
|
|
171 | end interface | |||
|
|
172 | end python module fitacf_fit_short | |||
|
|
173 | ||||
|
|
174 | ! This file was auto-generated with f2py (version:2). | |||
|
|
175 | ! See http://cens.ioc.ee/projects/f2py2e/ | |||
| @@ -0,0 +1,7 | |||||
|
|
1 | c information needed for spectral computations | |||
|
|
2 | ||||
|
|
3 | parameter(nimax=10) | |||
|
|
4 | integer nion,wi(nimax) | |||
|
|
5 | real te,ti(nimax),fi(nimax),ven,vin(nimax),alpha,dens,bfld,ak | |||
|
|
6 | common /spec/te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
7 | ||||
| @@ -0,0 +1,12 | |||||
|
|
1 | parameter(nl=16,nrange=75) ! was 95 | |||
|
|
2 | parameter(nstate=5,npen=5) | |||
|
|
3 | real plag(nl,nrange+nl),plag_errors(nl,nrange+nl),sconst | |||
|
|
4 | real densp(nrange+nl),tep(nrange+nl),trp(nrange+nl), | |||
|
|
5 | & tip(nrange+nl),hfp(nrange+nl),hefp(nrange+nl),altp(nrange+nl), | |||
|
|
6 | & r0,dr | |||
|
|
7 | real edensp(nrange+nl),etep(nrange+nl),etip(nrange+nl), | |||
|
|
8 | & ehfp(nrange+nl),ehefp(nrange+nl) | |||
|
|
9 | common /fpa/densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
10 | common /data/plag,plag_errors | |||
|
|
11 | common /sys/sconst | |||
|
|
12 | common /errs/edensp,etep,etip,ehfp,ehefp | |||
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| This diff has been collapsed as it changes many lines, (765 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,765 | |||||
|
|
1 | ! -*- f90 -*- | |||
|
|
2 | ! Note: the context of this file is case sensitive. | |||
|
|
3 | ||||
|
|
4 | python module fdjac2__user__routines | |||
|
|
5 | interface fdjac2_user_interface | |||
|
|
6 | subroutine fcn(m,n,x,wa,iflag) ! in :full_profile:lmdif1.f:fdjac2:unknown_interface | |||
|
|
7 | integer, optional,check(len(wa)>=m),depend(wa) :: m=len(wa) | |||
|
|
8 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
9 | real dimension(n) :: x | |||
|
|
10 | real dimension(m) :: wa | |||
|
|
11 | integer :: iflag | |||
|
|
12 | end subroutine fcn | |||
|
|
13 | end interface fdjac2_user_interface | |||
|
|
14 | end python module fdjac2__user__routines | |||
|
|
15 | python module lmdif__user__routines | |||
|
|
16 | interface lmdif_user_interface | |||
|
|
17 | subroutine fcn(m,n,x,fvec,iflag) ! in :full_profile:lmdif1.f:lmdif:unknown_interface | |||
|
|
18 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
19 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
20 | real dimension(n) :: x | |||
|
|
21 | real dimension(m) :: fvec | |||
|
|
22 | integer :: iflag | |||
|
|
23 | end subroutine fcn | |||
|
|
24 | end interface lmdif_user_interface | |||
|
|
25 | end python module lmdif__user__routines | |||
|
|
26 | python module full_profile ! in | |||
|
|
27 | interface ! in :full_profile | |||
|
|
28 | subroutine nnlswrap(power,sigma,temp,perror,ut,nhts) ! in :full_profile:full_profile.f | |||
|
|
29 | real dimension(nhts) :: power | |||
|
|
30 | real dimension(512) :: sigma | |||
|
|
31 | real dimension(512) :: temp | |||
|
|
32 | real dimension(512) :: perror | |||
|
|
33 | real :: ut | |||
|
|
34 | integer, optional,check(len(power)>=nhts),depend(power) :: nhts=len(power) | |||
|
|
35 | end subroutine nnlswrap | |||
|
|
36 | subroutine profile(acf_sum,acf_err,power,en,alag,thb2,bfm2,ote,ete,oti,eti,oph,eph,ophe,ephe,range2,ut,nhts,nacf,ibits,acf_avg,status) ! in :full_profile:full_profile.f | |||
|
|
37 | complex dimension(4,nhts,ibits) :: acf_sum | |||
|
|
38 | real dimension(nhts,ibits),depend(nhts,ibits) :: acf_err | |||
|
|
39 | real dimension(nhts),depend(nhts) :: power | |||
|
|
40 | real dimension(nhts),depend(nhts) :: en | |||
|
|
41 | real dimension(ibits),depend(ibits) :: alag | |||
|
|
42 | real dimension(nhts),depend(nhts) :: thb2 | |||
|
|
43 | real dimension(nhts),depend(nhts) :: bfm2 | |||
|
|
44 | real dimension(nacf),depend(nacf) :: ote | |||
|
|
45 | real dimension(nacf),depend(nacf) :: ete | |||
|
|
46 | real dimension(nacf),depend(nacf) :: oti | |||
|
|
47 | real dimension(nacf),depend(nacf) :: eti | |||
|
|
48 | real dimension(nacf),depend(nacf) :: oph | |||
|
|
49 | real dimension(nacf),depend(nacf) :: eph | |||
|
|
50 | real dimension(nacf),depend(nacf) :: ophe | |||
|
|
51 | real dimension(nacf),depend(nacf) :: ephe | |||
|
|
52 | real dimension(nhts),depend(nhts) :: range2 | |||
|
|
53 | real :: ut | |||
|
|
54 | integer, optional,check(shape(acf_sum,1)==nhts),depend(acf_sum) :: nhts=shape(acf_sum,1) | |||
|
|
55 | integer :: nacf | |||
|
|
56 | integer, optional,check(shape(acf_sum,2)==ibits),depend(acf_sum) :: ibits=shape(acf_sum,2) | |||
|
|
57 | complex dimension(nhts,ibits),depend(nhts,ibits) :: acf_avg | |||
|
|
58 | real :: status | |||
|
|
59 | real :: chi2 | |||
|
|
60 | real dimension(91) :: densp | |||
|
|
61 | real dimension(91) :: tep | |||
|
|
62 | real dimension(91) :: trp | |||
|
|
63 | real dimension(91) :: tip | |||
|
|
64 | real dimension(91) :: hfp | |||
|
|
65 | real dimension(91) :: hefp | |||
|
|
66 | real dimension(91) :: altp | |||
|
|
67 | real :: r0 | |||
|
|
68 | real :: dr | |||
|
|
69 | real :: wl | |||
|
|
70 | real dimension(16,91) :: plag | |||
|
|
71 | real dimension(16,91) :: plag_errors | |||
|
|
72 | real :: sconst | |||
|
|
73 | real dimension(91) :: edensp | |||
|
|
74 | real dimension(91) :: etep | |||
|
|
75 | real dimension(91) :: etip | |||
|
|
76 | real dimension(91) :: ehfp | |||
|
|
77 | real dimension(91) :: ehefp | |||
|
|
78 | real dimension(85) :: bfld_prof | |||
|
|
79 | real dimension(85) :: alpha_prof | |||
|
|
80 | integer :: imode | |||
|
|
81 | real :: uttime | |||
|
|
82 | real dimension(34) :: ta | |||
|
|
83 | real dimension(30,5) :: bcoef | |||
|
|
84 | real :: te | |||
|
|
85 | real dimension(10) :: ti | |||
|
|
86 | real dimension(10) :: fi | |||
|
|
87 | real :: ven | |||
|
|
88 | real dimension(10) :: vin | |||
|
|
89 | real :: alpha | |||
|
|
90 | real :: dens | |||
|
|
91 | real :: bfld | |||
|
|
92 | integer :: nion | |||
|
|
93 | integer dimension(10) :: wi | |||
|
|
94 | real :: ak | |||
|
|
95 | common /chisq/ chi2 | |||
|
|
96 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
97 | common /data/ plag,plag_errors | |||
|
|
98 | common /sys/ sconst | |||
|
|
99 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
100 | common /mag/ bfld_prof,alpha_prof | |||
|
|
101 | common /mode/ imode | |||
|
|
102 | common /utime/ uttime | |||
|
|
103 | common /spline/ ta,bcoef | |||
|
|
104 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
105 | end subroutine profile | |||
|
|
106 | subroutine grid ! in :full_profile:full_profile.f | |||
|
|
107 | real dimension(34) :: ta | |||
|
|
108 | real dimension(30,5) :: bcoef | |||
|
|
109 | real dimension(91) :: densp | |||
|
|
110 | real dimension(91) :: tep | |||
|
|
111 | real dimension(91) :: trp | |||
|
|
112 | real dimension(91) :: tip | |||
|
|
113 | real dimension(91) :: hfp | |||
|
|
114 | real dimension(91) :: hefp | |||
|
|
115 | real dimension(91) :: altp | |||
|
|
116 | real :: r0 | |||
|
|
117 | real :: dr | |||
|
|
118 | real :: wl | |||
|
|
119 | real dimension(16,91) :: plag | |||
|
|
120 | real dimension(16,91) :: plag_errors | |||
|
|
121 | real :: sconst | |||
|
|
122 | real dimension(91) :: edensp | |||
|
|
123 | real dimension(91) :: etep | |||
|
|
124 | real dimension(91) :: etip | |||
|
|
125 | real dimension(91) :: ehfp | |||
|
|
126 | real dimension(91) :: ehefp | |||
|
|
127 | real :: te | |||
|
|
128 | real dimension(10) :: ti | |||
|
|
129 | real dimension(10) :: fi | |||
|
|
130 | real :: ven | |||
|
|
131 | real dimension(10) :: vin | |||
|
|
132 | real :: alpha | |||
|
|
133 | real :: dens | |||
|
|
134 | real :: bfld | |||
|
|
135 | integer :: nion | |||
|
|
136 | integer dimension(10) :: wi | |||
|
|
137 | real :: ak | |||
|
|
138 | real :: chi2 | |||
|
|
139 | real :: uttime | |||
|
|
140 | common /spline/ ta,bcoef | |||
|
|
141 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
142 | common /data/ plag,plag_errors | |||
|
|
143 | common /sys/ sconst | |||
|
|
144 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
145 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
146 | common /chisq/ chi2 | |||
|
|
147 | common /utime/ uttime | |||
|
|
148 | end subroutine grid | |||
|
|
149 | subroutine propagate(xe) ! in :full_profile:full_profile.f | |||
|
|
150 | real dimension(150) :: xe | |||
|
|
151 | real dimension(91) :: densp | |||
|
|
152 | real dimension(91) :: tep | |||
|
|
153 | real dimension(91) :: trp | |||
|
|
154 | real dimension(91) :: tip | |||
|
|
155 | real dimension(91) :: hfp | |||
|
|
156 | real dimension(91) :: hefp | |||
|
|
157 | real dimension(91) :: altp | |||
|
|
158 | real :: r0 | |||
|
|
159 | real :: dr | |||
|
|
160 | real :: wl | |||
|
|
161 | real dimension(16,91) :: plag | |||
|
|
162 | real dimension(16,91) :: plag_errors | |||
|
|
163 | real :: sconst | |||
|
|
164 | real dimension(91) :: edensp | |||
|
|
165 | real dimension(91) :: etep | |||
|
|
166 | real dimension(91) :: etip | |||
|
|
167 | real dimension(91) :: ehfp | |||
|
|
168 | real dimension(91) :: ehefp | |||
|
|
169 | real dimension(34) :: ta | |||
|
|
170 | real dimension(30,5) :: bcoef | |||
|
|
171 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
172 | common /data/ plag,plag_errors | |||
|
|
173 | common /sys/ sconst | |||
|
|
174 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
175 | common /spline/ ta,bcoef | |||
|
|
176 | end subroutine propagate | |||
|
|
177 | subroutine fcn_lpreg(m,n,x,fvec,iflag) ! in :full_profile:full_profile.f | |||
|
|
178 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
179 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
180 | real dimension(n) :: x | |||
|
|
181 | real dimension(m) :: fvec | |||
|
|
182 | integer :: iflag | |||
|
|
183 | real dimension(34) :: ta | |||
|
|
184 | real dimension(30,5) :: bcoef | |||
|
|
185 | real dimension(91) :: densp | |||
|
|
186 | real dimension(91) :: tep | |||
|
|
187 | real dimension(91) :: trp | |||
|
|
188 | real dimension(91) :: tip | |||
|
|
189 | real dimension(91) :: hfp | |||
|
|
190 | real dimension(91) :: hefp | |||
|
|
191 | real dimension(91) :: altp | |||
|
|
192 | real :: r0 | |||
|
|
193 | real :: dr | |||
|
|
194 | real :: wl | |||
|
|
195 | real dimension(16,91) :: plag | |||
|
|
196 | real dimension(16,91) :: plag_errors | |||
|
|
197 | real :: sconst | |||
|
|
198 | real dimension(91) :: edensp | |||
|
|
199 | real dimension(91) :: etep | |||
|
|
200 | real dimension(91) :: etip | |||
|
|
201 | real dimension(91) :: ehfp | |||
|
|
202 | real dimension(91) :: ehefp | |||
|
|
203 | real :: te | |||
|
|
204 | real dimension(10) :: ti | |||
|
|
205 | real dimension(10) :: fi | |||
|
|
206 | real :: ven | |||
|
|
207 | real dimension(10) :: vin | |||
|
|
208 | real :: alpha | |||
|
|
209 | real :: dens | |||
|
|
210 | real :: bfld | |||
|
|
211 | integer :: nion | |||
|
|
212 | integer dimension(10) :: wi | |||
|
|
213 | real :: ak | |||
|
|
214 | real :: chi2 | |||
|
|
215 | real :: uttime | |||
|
|
216 | common /spline/ ta,bcoef | |||
|
|
217 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
218 | common /data/ plag,plag_errors | |||
|
|
219 | common /sys/ sconst | |||
|
|
220 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
221 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
222 | common /chisq/ chi2 | |||
|
|
223 | common /utime/ uttime | |||
|
|
224 | end subroutine fcn_lpreg | |||
|
|
225 | subroutine get_scale(plag2) ! in :full_profile:full_profile.f | |||
|
|
226 | real dimension(16,75) :: plag2 | |||
|
|
227 | real dimension(91) :: densp | |||
|
|
228 | real dimension(91) :: tep | |||
|
|
229 | real dimension(91) :: trp | |||
|
|
230 | real dimension(91) :: tip | |||
|
|
231 | real dimension(91) :: hfp | |||
|
|
232 | real dimension(91) :: hefp | |||
|
|
233 | real dimension(91) :: altp | |||
|
|
234 | real :: r0 | |||
|
|
235 | real :: dr | |||
|
|
236 | real :: wl | |||
|
|
237 | real dimension(16,91) :: plag | |||
|
|
238 | real dimension(16,91) :: plag_errors | |||
|
|
239 | real :: sconst | |||
|
|
240 | real dimension(91) :: edensp | |||
|
|
241 | real dimension(91) :: etep | |||
|
|
242 | real dimension(91) :: etip | |||
|
|
243 | real dimension(91) :: ehfp | |||
|
|
244 | real dimension(91) :: ehefp | |||
|
|
245 | common /fpa/ densp,tep,trp,tip,hfp,hefp,altp,r0,dr,wl | |||
|
|
246 | common /data/ plag,plag_errors | |||
|
|
247 | common /sys/ sconst | |||
|
|
248 | common /errs/ edensp,etep,etip,ehfp,ehefp | |||
|
|
249 | end subroutine get_scale | |||
|
|
250 | subroutine lagp(plag,wl,r0,dr,nl,nrange) ! in :full_profile:lagp.f | |||
|
|
251 | real dimension(nl,nrange) :: plag | |||
|
|
252 | real :: wl | |||
|
|
253 | real :: r0 | |||
|
|
254 | real :: dr | |||
|
|
255 | integer, optional,check(shape(plag,0)==nl),depend(plag) :: nl=shape(plag,0) | |||
|
|
256 | integer, optional,check(shape(plag,1)==nrange),depend(plag) :: nrange=shape(plag,1) | |||
|
|
257 | real :: te | |||
|
|
258 | real dimension(10) :: ti | |||
|
|
259 | real dimension(10) :: fi | |||
|
|
260 | real :: ven | |||
|
|
261 | real dimension(10) :: vin | |||
|
|
262 | real :: alpha | |||
|
|
263 | real :: dens | |||
|
|
264 | real :: bfld | |||
|
|
265 | integer :: nion | |||
|
|
266 | integer dimension(10) :: wi | |||
|
|
267 | real :: ak | |||
|
|
268 | real dimension(34) :: ta | |||
|
|
269 | real dimension(30,5) :: bcoef | |||
|
|
270 | real dimension(85) :: bfld_prof | |||
|
|
271 | real dimension(85) :: alpha_prof | |||
|
|
272 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
273 | common /spline/ ta,bcoef | |||
|
|
274 | common /mag/ bfld_prof,alpha_prof | |||
|
|
275 | end subroutine lagp | |||
|
|
276 | subroutine lagp_old(plag,wl,r0,dr,nl,nrange) ! in :full_profile:lagp.f | |||
|
|
277 | real dimension(nl,nrange) :: plag | |||
|
|
278 | real :: wl | |||
|
|
279 | real :: r0 | |||
|
|
280 | real :: dr | |||
|
|
281 | integer, optional,check(shape(plag,0)==nl),depend(plag) :: nl=shape(plag,0) | |||
|
|
282 | integer, optional,check(shape(plag,1)==nrange),depend(plag) :: nrange=shape(plag,1) | |||
|
|
283 | real :: te | |||
|
|
284 | real dimension(10) :: ti | |||
|
|
285 | real dimension(10) :: fi | |||
|
|
286 | real :: ven | |||
|
|
287 | real dimension(10) :: vin | |||
|
|
288 | real :: alpha | |||
|
|
289 | real :: dens | |||
|
|
290 | real :: bfld | |||
|
|
291 | integer :: nion | |||
|
|
292 | integer dimension(10) :: wi | |||
|
|
293 | real :: ak | |||
|
|
294 | real dimension(34) :: ta | |||
|
|
295 | real dimension(30,5) :: bcoef | |||
|
|
296 | real dimension(85) :: bfld_prof | |||
|
|
297 | real dimension(85) :: alpha_prof | |||
|
|
298 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
299 | common /spline/ ta,bcoef | |||
|
|
300 | common /mag/ bfld_prof,alpha_prof | |||
|
|
301 | end subroutine lagp_old | |||
|
|
302 | function atanh(x) ! in :full_profile:lagp.f | |||
|
|
303 | real :: x | |||
|
|
304 | real :: atanh | |||
|
|
305 | end function atanh | |||
|
|
306 | subroutine get_spline(alt,dens,te,ti,hf,hef) ! in :full_profile:lagp.f | |||
|
|
307 | real :: alt | |||
|
|
308 | real :: dens | |||
|
|
309 | real :: te | |||
|
|
310 | real :: ti | |||
|
|
311 | real :: hf | |||
|
|
312 | real :: hef | |||
|
|
313 | real dimension(34) :: ta | |||
|
|
314 | real dimension(30,5) :: bcoef | |||
|
|
315 | common /spline/ ta,bcoef | |||
|
|
316 | end subroutine get_spline | |||
|
|
317 | function bvalue(t,bcoef,n,k,x,jderiv) ! in :full_profile:lagp.f | |||
|
|
318 | real dimension(n+k),depend(n,k) :: t | |||
|
|
319 | real dimension(n) :: bcoef | |||
|
|
320 | integer, optional,check(len(bcoef)>=n),depend(bcoef) :: n=len(bcoef) | |||
|
|
321 | integer :: k | |||
|
|
322 | real :: x | |||
|
|
323 | integer :: jderiv | |||
|
|
324 | real :: bvalue | |||
|
|
325 | end function bvalue | |||
|
|
326 | subroutine interv(xt,lxt,x,left,mflag) ! in :full_profile:lagp.f | |||
|
|
327 | real dimension(lxt) :: xt | |||
|
|
328 | integer, optional,check(len(xt)>=lxt),depend(xt) :: lxt=len(xt) | |||
|
|
329 | real :: x | |||
|
|
330 | integer :: left | |||
|
|
331 | integer :: mflag | |||
|
|
332 | end subroutine interv | |||
|
|
333 | subroutine lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) ! in :full_profile:lmdif1.f | |||
|
|
334 | use lmdif__user__routines | |||
|
|
335 | external fcn | |||
|
|
336 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
337 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
338 | real dimension(n) :: x | |||
|
|
339 | real dimension(m) :: fvec | |||
|
|
340 | real :: tol | |||
|
|
341 | integer :: info | |||
|
|
342 | integer dimension(n),depend(n) :: iwa | |||
|
|
343 | real dimension(lwa) :: wa | |||
|
|
344 | integer, optional,check(len(wa)>=lwa),depend(wa) :: lwa=len(wa) | |||
|
|
345 | end subroutine lmdif1 | |||
|
|
346 | function enorm(n,x) ! in :full_profile:lmdif1.f | |||
|
|
347 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
348 | real dimension(n) :: x | |||
|
|
349 | real :: enorm | |||
|
|
350 | end function enorm | |||
|
|
351 | subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa) ! in :full_profile:lmdif1.f | |||
|
|
352 | use fdjac2__user__routines | |||
|
|
353 | external fcn | |||
|
|
354 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
355 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
356 | real dimension(n) :: x | |||
|
|
357 | real dimension(m) :: fvec | |||
|
|
358 | real dimension(ldfjac,n),depend(n) :: fjac | |||
|
|
359 | integer, optional,check(shape(fjac,0)==ldfjac),depend(fjac) :: ldfjac=shape(fjac,0) | |||
|
|
360 | integer :: iflag | |||
|
|
361 | real :: epsfcn | |||
|
|
362 | real dimension(m),depend(m) :: wa | |||
|
|
363 | end subroutine fdjac2 | |||
|
|
364 | subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn,diag,mode,factor,nprint,info,nfev,fjac,ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) ! in :full_profile:lmdif1.f | |||
|
|
365 | use lmdif__user__routines | |||
|
|
366 | external fcn | |||
|
|
367 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
368 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
369 | real dimension(n) :: x | |||
|
|
370 | real dimension(m) :: fvec | |||
|
|
371 | real :: ftol | |||
|
|
372 | real :: xtol | |||
|
|
373 | real :: gtol | |||
|
|
374 | integer :: maxfev | |||
|
|
375 | real :: epsfcn | |||
|
|
376 | real dimension(n),depend(n) :: diag | |||
|
|
377 | integer :: mode | |||
|
|
378 | real :: factor | |||
|
|
379 | integer :: nprint | |||
|
|
380 | integer :: info | |||
|
|
381 | integer :: nfev | |||
|
|
382 | real dimension(ldfjac,n),depend(n) :: fjac | |||
|
|
383 | integer, optional,check(shape(fjac,0)==ldfjac),depend(fjac) :: ldfjac=shape(fjac,0) | |||
|
|
384 | integer dimension(n),depend(n) :: ipvt | |||
|
|
385 | real dimension(n),depend(n) :: qtf | |||
|
|
386 | real dimension(n),depend(n) :: wa1 | |||
|
|
387 | real dimension(n),depend(n) :: wa2 | |||
|
|
388 | real dimension(n),depend(n) :: wa3 | |||
|
|
389 | real dimension(m),depend(m) :: wa4 | |||
|
|
390 | end subroutine lmdif | |||
|
|
391 | subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag,wa1,wa2) ! in :full_profile:lmdif1.f | |||
|
|
392 | integer, optional,check(shape(r,1)==n),depend(r) :: n=shape(r,1) | |||
|
|
393 | real dimension(ldr,n) :: r | |||
|
|
394 | integer, optional,check(shape(r,0)==ldr),depend(r) :: ldr=shape(r,0) | |||
|
|
395 | integer dimension(n),depend(n) :: ipvt | |||
|
|
396 | real dimension(n),depend(n) :: diag | |||
|
|
397 | real dimension(n),depend(n) :: qtb | |||
|
|
398 | real :: delta | |||
|
|
399 | real :: par | |||
|
|
400 | real dimension(n),depend(n) :: x | |||
|
|
401 | real dimension(n),depend(n) :: sdiag | |||
|
|
402 | real dimension(n),depend(n) :: wa1 | |||
|
|
403 | real dimension(n),depend(n) :: wa2 | |||
|
|
404 | end subroutine lmpar | |||
|
|
405 | subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) ! in :full_profile:lmdif1.f | |||
|
|
406 | integer :: m | |||
|
|
407 | integer, optional,check(shape(a,1)==n),depend(a) :: n=shape(a,1) | |||
|
|
408 | real dimension(lda,n) :: a | |||
|
|
409 | integer, optional,check(shape(a,0)==lda),depend(a) :: lda=shape(a,0) | |||
|
|
410 | logical :: pivot | |||
|
|
411 | integer dimension(lipvt) :: ipvt | |||
|
|
412 | integer, optional,check(len(ipvt)>=lipvt),depend(ipvt) :: lipvt=len(ipvt) | |||
|
|
413 | real dimension(n),depend(n) :: rdiag | |||
|
|
414 | real dimension(n),depend(n) :: acnorm | |||
|
|
415 | real dimension(n),depend(n) :: wa | |||
|
|
416 | end subroutine qrfac | |||
|
|
417 | subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) ! in :full_profile:lmdif1.f | |||
|
|
418 | integer, optional,check(shape(r,1)==n),depend(r) :: n=shape(r,1) | |||
|
|
419 | real dimension(ldr,n) :: r | |||
|
|
420 | integer, optional,check(shape(r,0)==ldr),depend(r) :: ldr=shape(r,0) | |||
|
|
421 | integer dimension(n),depend(n) :: ipvt | |||
|
|
422 | real dimension(n),depend(n) :: diag | |||
|
|
423 | real dimension(n),depend(n) :: qtb | |||
|
|
424 | real dimension(n),depend(n) :: x | |||
|
|
425 | real dimension(n),depend(n) :: sdiag | |||
|
|
426 | real dimension(n),depend(n) :: wa | |||
|
|
427 | end subroutine qrsolv | |||
|
|
428 | function spmpar(i) ! in :full_profile:lmdif1.f | |||
|
|
429 | integer :: i | |||
|
|
430 | real :: spmpar | |||
|
|
431 | end function spmpar | |||
|
|
432 | subroutine bndacc(g,mdg,nb,ip,ir,mt,jt) ! in :full_profile:nnls.f | |||
|
|
433 | double precision dimension(mdg,*) :: g | |||
|
|
434 | integer, optional,check(shape(g,0)==mdg),depend(g) :: mdg=shape(g,0) | |||
|
|
435 | integer :: nb | |||
|
|
436 | integer :: ip | |||
|
|
437 | integer :: ir | |||
|
|
438 | integer :: mt | |||
|
|
439 | integer :: jt | |||
|
|
440 | end subroutine bndacc | |||
|
|
441 | subroutine bndsol(mode,g,mdg,nb,ip,ir,x,n,rnorm) ! in :full_profile:nnls.f | |||
|
|
442 | integer :: mode | |||
|
|
443 | double precision dimension(mdg,*) :: g | |||
|
|
444 | integer, optional,check(shape(g,0)==mdg),depend(g) :: mdg=shape(g,0) | |||
|
|
445 | integer :: nb | |||
|
|
446 | integer :: ip | |||
|
|
447 | integer :: ir | |||
|
|
448 | double precision dimension(n) :: x | |||
|
|
449 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
450 | double precision :: rnorm | |||
|
|
451 | end subroutine bndsol | |||
|
|
452 | function diff(x,y) ! in :full_profile:nnls.f | |||
|
|
453 | double precision :: x | |||
|
|
454 | double precision :: y | |||
|
|
455 | double precision :: diff | |||
|
|
456 | end function diff | |||
|
|
457 | subroutine g1(a,b,cterm,sterm,sig) ! in :full_profile:nnls.f | |||
|
|
458 | double precision :: a | |||
|
|
459 | double precision :: b | |||
|
|
460 | double precision :: cterm | |||
|
|
461 | double precision :: sterm | |||
|
|
462 | double precision :: sig | |||
|
|
463 | end subroutine g1 | |||
|
|
464 | subroutine g2(cterm,sterm,x,y) ! in :full_profile:nnls.f | |||
|
|
465 | double precision :: cterm | |||
|
|
466 | double precision :: sterm | |||
|
|
467 | double precision :: x | |||
|
|
468 | double precision :: y | |||
|
|
469 | end subroutine g2 | |||
|
|
470 | function gen2(anoise) ! in :full_profile:nnls.f | |||
|
|
471 | double precision :: anoise | |||
|
|
472 | double precision :: gen2 | |||
|
|
473 | end function gen2 | |||
|
|
474 | subroutine h12(mode,lpivot,l1,m,u,iue,up,c,ice,icv,ncv) ! in :full_profile:nnls.f | |||
|
|
475 | integer :: mode | |||
|
|
476 | integer :: lpivot | |||
|
|
477 | integer :: l1 | |||
|
|
478 | integer :: m | |||
|
|
479 | double precision dimension(iue,*) :: u | |||
|
|
480 | integer, optional,check(shape(u,0)==iue),depend(u) :: iue=shape(u,0) | |||
|
|
481 | double precision :: up | |||
|
|
482 | double precision dimension(*) :: c | |||
|
|
483 | integer :: ice | |||
|
|
484 | integer :: icv | |||
|
|
485 | integer :: ncv | |||
|
|
486 | end subroutine h12 | |||
|
|
487 | subroutine hfti(a,mda,m,n,b,mdb,nb,tau,krank,rnorm,h,g,ip) ! in :full_profile:nnls.f | |||
|
|
488 | double precision dimension(mda,*) :: a | |||
|
|
489 | integer, optional,check(shape(a,0)==mda),depend(a) :: mda=shape(a,0) | |||
|
|
490 | integer :: m | |||
|
|
491 | integer :: n | |||
|
|
492 | double precision dimension(mdb,*) :: b | |||
|
|
493 | integer, optional,check(shape(b,0)==mdb),depend(b) :: mdb=shape(b,0) | |||
|
|
494 | integer :: nb | |||
|
|
495 | double precision :: tau | |||
|
|
496 | integer :: krank | |||
|
|
497 | double precision dimension(*) :: rnorm | |||
|
|
498 | double precision dimension(*) :: h | |||
|
|
499 | double precision dimension(*) :: g | |||
|
|
500 | integer dimension(*) :: ip | |||
|
|
501 | end subroutine hfti | |||
|
|
502 | subroutine ldp(g,mdg,m,n,h,x,xnorm,w,index_bn,mode) ! in :full_profile:nnls.f | |||
|
|
503 | double precision dimension(mdg,*) :: g | |||
|
|
504 | integer, optional,check(shape(g,0)==mdg),depend(g) :: mdg=shape(g,0) | |||
|
|
505 | integer :: m | |||
|
|
506 | integer :: n | |||
|
|
507 | double precision dimension(*) :: h | |||
|
|
508 | double precision dimension(*) :: x | |||
|
|
509 | double precision :: xnorm | |||
|
|
510 | double precision dimension(*) :: w | |||
|
|
511 | integer dimension(*) :: index_bn | |||
|
|
512 | integer :: mode | |||
|
|
513 | end subroutine ldp | |||
|
|
514 | subroutine mfeout(a,mda,m,n,names,mode,unit,width) ! in :full_profile:nnls.f | |||
|
|
515 | double precision dimension(mda,n) :: a | |||
|
|
516 | integer, optional,check(shape(a,0)==mda),depend(a) :: mda=shape(a,0) | |||
|
|
517 | integer, optional,check(shape(names,0)==m),depend(names) :: m=shape(names,0) | |||
|
|
518 | integer, optional,check(shape(a,1)==n),depend(a) :: n=shape(a,1) | |||
|
|
519 | character dimension(m,(*)) :: names | |||
|
|
520 | integer :: mode | |||
|
|
521 | integer :: unit | |||
|
|
522 | integer :: width | |||
|
|
523 | end subroutine mfeout | |||
|
|
524 | subroutine nnls(a,mda,m,n,b,x,rnorm,w,zz,index_bn,mode) ! in :full_profile:nnls.f | |||
|
|
525 | double precision dimension(mda,*) :: a | |||
|
|
526 | integer, optional,check(shape(a,0)==mda),depend(a) :: mda=shape(a,0) | |||
|
|
527 | integer :: m | |||
|
|
528 | integer :: n | |||
|
|
529 | double precision dimension(*) :: b | |||
|
|
530 | double precision dimension(*) :: x | |||
|
|
531 | double precision :: rnorm | |||
|
|
532 | double precision dimension(*) :: w | |||
|
|
533 | double precision dimension(*) :: zz | |||
|
|
534 | integer dimension(*) :: index_bn | |||
|
|
535 | integer :: mode | |||
|
|
536 | end subroutine nnls | |||
|
|
537 | subroutine qrbd(ipass,q,e,nn,v,mdv,nrv,c,mdc,ncc) ! in :full_profile:nnls.f | |||
|
|
538 | integer :: ipass | |||
|
|
539 | double precision dimension(*) :: q | |||
|
|
540 | double precision dimension(*) :: e | |||
|
|
541 | integer :: nn | |||
|
|
542 | double precision dimension(mdv,*) :: v | |||
|
|
543 | integer, optional,check(shape(v,0)==mdv),depend(v) :: mdv=shape(v,0) | |||
|
|
544 | integer :: nrv | |||
|
|
545 | double precision dimension(mdc,*) :: c | |||
|
|
546 | integer, optional,check(shape(c,0)==mdc),depend(c) :: mdc=shape(c,0) | |||
|
|
547 | integer :: ncc | |||
|
|
548 | end subroutine qrbd | |||
|
|
549 | subroutine sva(a,mda,m,n,mdata,b,sing,kpvec,names,iscale,d,work) ! in :full_profile:nnls.f | |||
|
|
550 | double precision dimension(mda,n) :: a | |||
|
|
551 | integer, optional,check(shape(a,0)==mda),depend(a) :: mda=shape(a,0) | |||
|
|
552 | integer, optional,check(len(b)>=m),depend(b) :: m=len(b) | |||
|
|
553 | integer, optional,check(shape(a,1)==n),depend(a) :: n=shape(a,1) | |||
|
|
554 | integer :: mdata | |||
|
|
555 | double precision dimension(m) :: b | |||
|
|
556 | double precision dimension(n),depend(n) :: sing | |||
|
|
557 | integer dimension(4) :: kpvec | |||
|
|
558 | character dimension(n,(*)),intent(c),depend(n) :: names | |||
|
|
559 | integer :: iscale | |||
|
|
560 | double precision dimension(n),depend(n) :: d | |||
|
|
561 | double precision dimension(2 * n),depend(n) :: work | |||
|
|
562 | end subroutine sva | |||
|
|
563 | subroutine svdrs(a,mda,m1,n1,b,mdb,nb,s,work) ! in :full_profile:nnls.f | |||
|
|
564 | double precision dimension(mda,*) :: a | |||
|
|
565 | integer, optional,check(shape(a,0)==mda),depend(a) :: mda=shape(a,0) | |||
|
|
566 | integer :: m1 | |||
|
|
567 | integer, optional,check(shape(work,0)==n1),depend(work) :: n1=shape(work,0) | |||
|
|
568 | double precision dimension(mdb,*) :: b | |||
|
|
569 | integer, optional,check(shape(b,0)==mdb),depend(b) :: mdb=shape(b,0) | |||
|
|
570 | integer :: nb | |||
|
|
571 | double precision dimension(*) :: s | |||
|
|
572 | double precision dimension(n1,2) :: work | |||
|
|
573 | end subroutine svdrs | |||
|
|
574 | subroutine guess(acf,tau,npts,zero,amin,te,tr) ! in :full_profile:fitacf.f | |||
|
|
575 | real dimension(npts) :: acf | |||
|
|
576 | real dimension(npts),depend(npts) :: tau | |||
|
|
577 | integer, optional,check(len(acf)>=npts),depend(acf) :: npts=len(acf) | |||
|
|
578 | real :: zero | |||
|
|
579 | real :: amin | |||
|
|
580 | real :: te | |||
|
|
581 | real :: tr | |||
|
|
582 | end subroutine guess | |||
|
|
583 | subroutine parab1(x,y,a,b,c) ! in :full_profile:fitacf.f | |||
|
|
584 | real dimension(3) :: x | |||
|
|
585 | real dimension(3) :: y | |||
|
|
586 | real :: a | |||
|
|
587 | real :: b | |||
|
|
588 | real :: c | |||
|
|
589 | end subroutine parab1 | |||
|
|
590 | function cdtr1(depth) ! in :full_profile:fitacf.f | |||
|
|
591 | real :: depth | |||
|
|
592 | real :: cdtr1 | |||
|
|
593 | end function cdtr1 | |||
|
|
594 | function czte1(zlag,tr) ! in :full_profile:fitacf.f | |||
|
|
595 | real :: zlag | |||
|
|
596 | real :: tr | |||
|
|
597 | real :: czte1 | |||
|
|
598 | end function czte1 | |||
|
|
599 | subroutine fit(wl,taup,rhop,covar,cinv,sigma2p,paramp,ebp,bfldp,alphap,densp,alt,time,nl,ifitp,ist) ! in :full_profile:fitacf.f | |||
|
|
600 | real :: wl | |||
|
|
601 | real dimension(nl) :: taup | |||
|
|
602 | real dimension(nl),depend(nl) :: rhop | |||
|
|
603 | real dimension(nl,nl),depend(nl,nl) :: covar | |||
|
|
604 | real dimension(nl,nl),depend(nl,nl) :: cinv | |||
|
|
605 | real dimension(nl),depend(nl) :: sigma2p | |||
|
|
606 | real dimension(10) :: paramp | |||
|
|
607 | real dimension(10) :: ebp | |||
|
|
608 | real :: bfldp | |||
|
|
609 | real :: alphap | |||
|
|
610 | real :: densp | |||
|
|
611 | real :: alt | |||
|
|
612 | real :: time | |||
|
|
613 | integer, optional,check(len(taup)>=nl),depend(taup) :: nl=len(taup) | |||
|
|
614 | integer dimension(10) :: ifitp | |||
|
|
615 | integer :: ist | |||
|
|
616 | real :: te | |||
|
|
617 | real dimension(10) :: ti | |||
|
|
618 | real dimension(10) :: fi | |||
|
|
619 | real :: ven | |||
|
|
620 | real dimension(10) :: vin | |||
|
|
621 | real :: alpha | |||
|
|
622 | real :: dens | |||
|
|
623 | real :: bfld | |||
|
|
624 | integer :: nion | |||
|
|
625 | integer dimension(10) :: wi | |||
|
|
626 | real :: ak | |||
|
|
627 | integer :: imode | |||
|
|
628 | real dimension(100) :: tau | |||
|
|
629 | real dimension(100) :: rho | |||
|
|
630 | real dimension(100) :: sigma2 | |||
|
|
631 | real dimension(10) :: params | |||
|
|
632 | integer dimension(10) :: ifit | |||
|
|
633 | real dimension(10000) :: ev | |||
|
|
634 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
635 | common /mode/ imode | |||
|
|
636 | common /fitter/ tau,rho,sigma2,params,ifit | |||
|
|
637 | common /trans/ ev | |||
|
|
638 | end subroutine fit | |||
|
|
639 | subroutine fcn(m,n,x,fvec,iflag) ! in :full_profile:fitacf.f | |||
|
|
640 | integer, optional,check(len(fvec)>=m),depend(fvec) :: m=len(fvec) | |||
|
|
641 | integer, optional,check(len(x)>=n),depend(x) :: n=len(x) | |||
|
|
642 | real dimension(n) :: x | |||
|
|
643 | real dimension(m) :: fvec | |||
|
|
644 | integer :: iflag | |||
|
|
645 | real :: te | |||
|
|
646 | real dimension(10) :: ti | |||
|
|
647 | real dimension(10) :: fi | |||
|
|
648 | real :: ven | |||
|
|
649 | real dimension(10) :: vin | |||
|
|
650 | real :: alpha | |||
|
|
651 | real :: dens | |||
|
|
652 | real :: bfld | |||
|
|
653 | integer :: nion | |||
|
|
654 | integer dimension(10) :: wi | |||
|
|
655 | real :: ak | |||
|
|
656 | real dimension(100) :: tau | |||
|
|
657 | real dimension(100) :: rho | |||
|
|
658 | real dimension(100) :: sigma2 | |||
|
|
659 | real dimension(10) :: params | |||
|
|
660 | integer dimension(10) :: ifit | |||
|
|
661 | real :: chisq | |||
|
|
662 | real dimension(10000) :: ev | |||
|
|
663 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
664 | common /fitter/ tau,rho,sigma2,params,ifit | |||
|
|
665 | common /errs/ chisq | |||
|
|
666 | common /trans/ ev | |||
|
|
667 | end subroutine fcn | |||
|
|
668 | function cj_ion(theta,psi) ! in :full_profile:fitacf.f | |||
|
|
669 | real :: theta | |||
|
|
670 | real :: psi | |||
|
|
671 | complex :: cj_ion | |||
|
|
672 | end function cj_ion | |||
|
|
673 | function cj_electron(theta,phi,psi,alpha) ! in :full_profile:fitacf.f | |||
|
|
674 | real :: theta | |||
|
|
675 | real :: phi | |||
|
|
676 | real :: psi | |||
|
|
677 | real :: alpha | |||
|
|
678 | integer :: imode | |||
|
|
679 | complex :: cj_electron | |||
|
|
680 | common /mode/ imode | |||
|
|
681 | end function cj_electron | |||
|
|
682 | function y_ion(theta,psi) ! in :full_profile:fitacf.f | |||
|
|
683 | real :: theta | |||
|
|
684 | real :: psi | |||
|
|
685 | complex :: y_ion | |||
|
|
686 | end function y_ion | |||
|
|
687 | function y_electron(theta,phi,psi,alpha) ! in :full_profile:fitacf.f | |||
|
|
688 | real :: theta | |||
|
|
689 | real :: phi | |||
|
|
690 | real :: psi | |||
|
|
691 | real :: alpha | |||
|
|
692 | complex :: y_electron | |||
|
|
693 | end function y_electron | |||
|
|
694 | function spect1(omega) ! in :full_profile:fitacf.f | |||
|
|
695 | real :: omega | |||
|
|
696 | real :: te | |||
|
|
697 | real dimension(10) :: ti | |||
|
|
698 | real dimension(10) :: fi | |||
|
|
699 | real :: ven | |||
|
|
700 | real dimension(10) :: vin | |||
|
|
701 | real :: alpha | |||
|
|
702 | real :: dens | |||
|
|
703 | real :: bfld | |||
|
|
704 | integer :: nion | |||
|
|
705 | integer dimension(10) :: wi | |||
|
|
706 | real :: ak | |||
|
|
707 | integer :: imode | |||
|
|
708 | real :: spect1 | |||
|
|
709 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
710 | common /mode/ imode | |||
|
|
711 | end function spect1 | |||
|
|
712 | subroutine acf2(wl,tau,te1,ti1,fi1,ven1,vin1,wi1,nion1,alpha1,dens1,bfld1,acf) ! in :full_profile:fitacf.f | |||
|
|
713 | real :: wl | |||
|
|
714 | real :: tau | |||
|
|
715 | real :: te1 | |||
|
|
716 | real dimension(nion1) :: ti1 | |||
|
|
717 | real dimension(nion1),depend(nion1) :: fi1 | |||
|
|
718 | real :: ven1 | |||
|
|
719 | real dimension(nion1),depend(nion1) :: vin1 | |||
|
|
720 | integer dimension(nion1),depend(nion1) :: wi1 | |||
|
|
721 | integer, optional,check(len(ti1)>=nion1),depend(ti1) :: nion1=len(ti1) | |||
|
|
722 | real :: alpha1 | |||
|
|
723 | real :: dens1 | |||
|
|
724 | real :: bfld1 | |||
|
|
725 | real :: acf | |||
|
|
726 | real :: te | |||
|
|
727 | real dimension(10) :: ti | |||
|
|
728 | real dimension(10) :: fi | |||
|
|
729 | real :: ven | |||
|
|
730 | real dimension(10) :: vin | |||
|
|
731 | real :: alpha | |||
|
|
732 | real :: dens | |||
|
|
733 | real :: bfld | |||
|
|
734 | integer :: nion | |||
|
|
735 | integer dimension(10) :: wi | |||
|
|
736 | real :: ak | |||
|
|
737 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
738 | end subroutine acf2 | |||
|
|
739 | subroutine gaussq(tau,acf) ! in :full_profile:fitacf.f | |||
|
|
740 | real :: tau | |||
|
|
741 | real :: acf | |||
|
|
742 | real :: te | |||
|
|
743 | real dimension(10) :: ti | |||
|
|
744 | real dimension(10) :: fi | |||
|
|
745 | real :: ven | |||
|
|
746 | real dimension(10) :: vin | |||
|
|
747 | real :: alpha | |||
|
|
748 | real :: dens | |||
|
|
749 | real :: bfld | |||
|
|
750 | integer :: nion | |||
|
|
751 | integer dimension(10) :: wi | |||
|
|
752 | real :: ak | |||
|
|
753 | common /spec/ te,ti,fi,ven,vin,alpha,dens,bfld,nion,wi,ak | |||
|
|
754 | end subroutine gaussq | |||
|
|
755 | function r1mach(i) ! in :full_profile:r1mach.f | |||
|
|
756 | integer :: i | |||
|
|
757 | integer :: cray1 | |||
|
|
758 | real :: r1mach | |||
|
|
759 | common /d8mach/ cray1 | |||
|
|
760 | end function r1mach | |||
|
|
761 | end interface | |||
|
|
762 | end python module full_profile | |||
|
|
763 | ||||
|
|
764 | ! This file was auto-generated with f2py (version:2). | |||
|
|
765 | ! See http://cens.ioc.ee/projects/f2py2e/ | |||
| This diff has been collapsed as it changes many lines, (646 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,646 | |||||
|
|
1 | c | |||
|
|
2 | c $Id: full_profile.f,v 1.3 2013/09/12 19:11:48 daveh Exp daveh $ DLH | |||
|
|
3 | c | |||
|
|
4 | ||||
|
|
5 | subroutine profile(acf_sum,acf_err,power,en,alag,thb2,bfm2, | |||
|
|
6 | & ote,ete,oti,eti,oph,eph,ophe,ephe,range2,ut, | |||
|
|
7 | & NHTS,NACF,IBITS,acf_avg_real,status) | |||
|
|
8 | c | |||
|
|
9 | complex acf_sum(4,NHTS,IBITS) | |||
|
|
10 | real acf_avg_real(NHTS,IBITS) | |||
|
|
11 | real acf_err(NHTS,IBITS),range2(NHTS) | |||
|
|
12 | real power(NHTS),en(NHTS),alag(IBITS),thb2(NHTS),bfm2(NHTS) | |||
|
|
13 | real ote(NHTS),ete(NHTS),oti(NHTS),eti(NHTS),oph(NHTS),eph(NHTS) | |||
|
|
14 | real ophe(NHTS),ephe(NHTS) | |||
|
|
15 | integer NHTS,NACF,IBITS | |||
|
|
16 | real status(1) | |||
|
|
17 | common /chisq/chi2 | |||
|
|
18 | c | |||
|
|
19 | c arguments above, internal variables below: have to make these match | |||
|
|
20 | c | |||
|
|
21 | include 'fpa.h' | |||
|
|
22 | include 'bfield.h' | |||
|
|
23 | c | |||
|
|
24 | common /mode/imode | |||
|
|
25 | common /utime/uttime | |||
|
|
26 | c | |||
|
|
27 | include 'spline.h' | |||
|
|
28 | include 'fitter.h' | |||
|
|
29 | c | |||
|
|
30 | c functions to minimize are all lagged profiles plus penalties | |||
|
|
31 | c variables to minimize them with are all spline values | |||
|
|
32 | c | |||
|
|
33 | ||||
|
|
34 | parameter(nfun=nrange*nl+nstate*(nspline-2)+npen) | |||
|
|
35 | parameter(nvar=nspline*nstate) | |||
|
|
36 | parameter(lwa=nfun*nvar+nstate*nvar+nfun) | |||
|
|
37 | real fvec(nfun),wa(lwa),xe(nvar) | |||
|
|
38 | integer iwa(nvar) | |||
|
|
39 | c integer lwa | |||
|
|
40 | c | |||
|
|
41 | external fcn_lpreg | |||
|
|
42 | c | |||
|
|
43 | pi=4.0*atan(1.0) | |||
|
|
44 | uttime=ut | |||
|
|
45 | c write(*,*) "ut: ",ut | |||
|
|
46 | c write(*,*) "NHTS: ",NHTS | |||
|
|
47 | c write(*,*) "NACF: ",NACF | |||
|
|
48 | c write(*,*) "IBITS: ",IBITS | |||
|
|
49 | c call exit | |||
|
|
50 | c write(*,*) "acf_sum: ", acf_sum(1,111,11) | |||
|
|
51 | c write(*,*) "Starting Profile Process" | |||
|
|
52 | c set up basic physical parameters | |||
|
|
53 | c dens=639747.44 | |||
|
|
54 | c dens=509664.781 | |||
|
|
55 | c te=3971.98926 | |||
|
|
56 | c write(*,*) "acf_sum: ", acf_sum(1,31,2) | |||
|
|
57 | c call exit | |||
|
|
58 | ||||
|
|
59 | wl=3.0 | |||
|
|
60 | ak=2.0*pi/wl | |||
|
|
61 | ||||
|
|
62 | c analysis starts at gate 15 | |||
|
|
63 | ||||
|
|
64 | ir0=15 | |||
|
|
65 | ||||
|
|
66 | r0=range2(ir0) | |||
|
|
67 | dr=range2(ir0+1)-range2(ir0) | |||
|
|
68 | ||||
|
|
69 | do i=1,nfield ! nrange+10 memory hole | |||
|
|
70 | bfld_prof(i)=bfm2(i+ir0-1) | |||
|
|
71 | alpha_prof(i)=thb2(i+ir0-1)*pi/180.0 | |||
|
|
72 | end do | |||
|
|
73 | ||||
|
|
74 | do i=1,nrange+nl ! careful ... check nfield compared to nrange+nl | |||
|
|
75 | densp(i)=en(i+ir0-1) | |||
|
|
76 | do j=1,nl | |||
|
|
77 | c write(*,*) acf_sum(1,i+ir0-1,j) | |||
|
|
78 | plag(j,i)=acf_sum(1,i+ir0-1,j) | |||
|
|
79 | ||||
|
|
80 | plag_errors(j,i)=acf_err(i+ir0-1,j) | |||
|
|
81 | c write(*,*) j,i,plag_errors(j,i) | |||
|
|
82 | end do | |||
|
|
83 | end do | |||
|
|
84 | c call exit | |||
|
|
85 | c set some fitting conventions | |||
|
|
86 | c write(*,*) "plag: ",plag(2,2) | |||
|
|
87 | imode=2 | |||
|
|
88 | nion=3 | |||
|
|
89 | ||||
|
|
90 | ven=0.0 | |||
|
|
91 | do i=1,nion | |||
|
|
92 | vin(i)=0.0 | |||
|
|
93 | end do | |||
|
|
94 | wi(1)=16 | |||
|
|
95 | wi(2)=1 | |||
|
|
96 | wi(3)=4 | |||
|
|
97 | ||||
|
|
98 | c system constant | |||
|
|
99 | ||||
|
|
100 | sconst=1.0 | |||
|
|
101 | ||||
|
|
102 | c set up splines: DLH need to modify for different nu. splines | |||
|
|
103 | ||||
|
|
104 | do i=1,nspline+norder | |||
|
|
105 | ta(i)=r0+float(i-1-2)*delr ! 2-knot offset for 4th order spline | |||
|
|
106 | end do | |||
|
|
107 | ||||
|
|
108 | c initial guess - set density, He+ profiles here | |||
|
|
109 | ||||
|
|
110 | do i=1,nspline ! DLH modify for different no. splines | |||
|
|
111 | bcoef(i,1)=log10(abs(densp(1+int(float(i-1)*delr/dr)))) | |||
|
|
112 | ! need good guess for density profile | |||
|
|
113 | tmp=0.03 | |||
|
|
114 | bcoef(i,5)=atanh(2.0*tmp-1.0) ! not so critical | |||
|
|
115 | end do | |||
|
|
116 | ||||
|
|
117 | c write(*,*) bcoef | |||
|
|
118 | c call exit | |||
|
|
119 | ||||
|
|
120 | c grid search for other params to help set initial guess | |||
|
|
121 | c could include Ne, He+ in grid search too | |||
|
|
122 | c write(*,fmt='("before GRID")') | |||
|
|
123 | call grid() | |||
|
|
124 | c write(*,fmt='("After GRID")') | |||
|
|
125 | write(*,*) "chi2 after grid:",chi2 | |||
|
|
126 | c write(*,fmt='("Just After chi")') | |||
|
|
127 | c call exit | |||
|
|
128 | if(chi2.le.3.5) then | |||
|
|
129 | ||||
|
|
130 | c write(*,fmt='("After chi")') | |||
|
|
131 | c call exit | |||
|
|
132 | tol=1.0e-9 | |||
|
|
133 | ||||
|
|
134 | c call lmdif1(fcn_lpreg,nfun-nl*nl,nvar,bcoef,fvec,tol, | |||
|
|
135 | c & info,iwa,wa,lwa) | |||
|
|
136 | ||||
|
|
137 | info=0 | |||
|
|
138 | m=nfun-nl*nl | |||
|
|
139 | n=nvar | |||
|
|
140 | zero=0.0 | |||
|
|
141 | factor=1.0e-2 ! rather small initial step size | |||
|
|
142 | ||||
|
|
143 | maxfev = 200*(n + 1) | |||
|
|
144 | ftol = tol | |||
|
|
145 | xtol = tol | |||
|
|
146 | gtol = zero | |||
|
|
147 | epsfcn = zero | |||
|
|
148 | mode = 1 | |||
|
|
149 | nprint = 0 | |||
|
|
150 | mp5n = m + 5*n | |||
|
|
151 | c write(*,*) wa(5*n+1) | |||
|
|
152 | c call exit | |||
|
|
153 | write(*,*) "before densp:", densp(1),bcoef(1,2) | |||
|
|
154 | call lmdif(fcn_lpreg,m,n,bcoef,fvec,ftol,xtol,gtol, | |||
|
|
155 | & maxfev,epsfcn,wa(1), | |||
|
|
156 | * mode,factor,nprint,info,nfev,wa(mp5n+1),m,iwa, | |||
|
|
157 | * wa(n+1),wa(2*n+1),wa(3*n+1),wa(4*n+1),wa(5*n+1)) | |||
|
|
158 | ||||
|
|
159 | c write(*,fmt='("After lmdif")') | |||
|
|
160 | c write(*,*) info | |||
|
|
161 | write(*,*) "densp_after:", densp(1),bcoef(1,2) | |||
|
|
162 | c call exit | |||
|
|
163 | ||||
|
|
164 | c | |||
|
|
165 | c error handling; evalate solution point first, then Jacobian | |||
|
|
166 | c | |||
|
|
167 | iflag=0 | |||
|
|
168 | c write(*,fmt='("before fcn_lpreg")') | |||
|
|
169 | call fcn_lpreg(m,n,bcoef,fvec,iflag) ! common sys constant throughout | |||
|
|
170 | c write(*,fmt='("After fcn_lpreg")') | |||
|
|
171 | nm1=n*m+1 | |||
|
|
172 | call fdjac2(fcn_lpreg,m,n,bcoef,fvec,wa,m,iflag,epsfcn,wa(nm1)) | |||
|
|
173 | ||||
|
|
174 | do i=1,n | |||
|
|
175 | err=0.0 | |||
|
|
176 | xe(i)=0.0 | |||
|
|
177 | do j=1,m-npen | |||
|
|
178 | c do j=2+(nspline-2)*nstate,m-npen ! skip equations unrelated to data | |||
|
|
179 | err=err+MIN(wa(j+(i-1)*m)**2,10.0) | |||
|
|
180 | end do | |||
|
|
181 | if(err.gt.0.0) xe(i)=sqrt(err**(-1)) | |||
|
|
182 | end do | |||
|
|
183 | ||||
|
|
184 | call propagate(xe) | |||
|
|
185 | ||||
|
|
186 | do i=1,nrange | |||
|
|
187 | ete(i+ir0)=etep(i) | |||
|
|
188 | eti(i+ir0)=etip(i) | |||
|
|
189 | eph(i+ir0)=ehfp(i) | |||
|
|
190 | ephe(i+ir0)=ehefp(i) | |||
|
|
191 | end do | |||
|
|
192 | ||||
|
|
193 | c | |||
|
|
194 | c output parameters | |||
|
|
195 | c | |||
|
|
196 | ||||
|
|
197 | do i=1,nrange | |||
|
|
198 | altp(i)=r0+dr*float(i-1) | |||
|
|
199 | call get_spline(altp(i),densp(i),tep(i),tip(i), | |||
|
|
200 | & hfp(i),hefp(i)) | |||
|
|
201 | ote(i+ir0)=MAX(tep(i),tip(i)) | |||
|
|
202 | oti(i+ir0)=tip(i) | |||
|
|
203 | oph(i+ir0)=hfp(i) | |||
|
|
204 | ophe(i+ir0)=hefp(i) | |||
|
|
205 | end do | |||
|
|
206 | c | |||
|
|
207 | c theoretical lag products and other quantities for plotting | |||
|
|
208 | c | |||
|
|
209 | ||||
|
|
210 | call lagp(plag,wl,r0,dr,nl,nrange) | |||
|
|
211 | write(*,*) "plag_plag",REAL(plag(12,58)) | |||
|
|
212 | write(*,*) "plag_plag",REAL(plag(12,72)) | |||
|
|
213 | c write(*,*) "plag_plag",AIMAG(plag(12,72)) | |||
|
|
214 | do i=1,nrange ! | |||
|
|
215 | en(i+ir0-1)=densp(i) | |||
|
|
216 | do j=1,nl | |||
|
|
217 | acf_avg_real(i+ir0-1,j)=REAL(plag(j,i)) | |||
|
|
218 | c acf_avg_imag(i+ir0-1,j)=AIMAG(acf_sum(1,i+ir0-1,j)) | |||
|
|
219 | end do | |||
|
|
220 | end do | |||
|
|
221 | write(*,*) "acf",acf_avg_real(72,12) | |||
|
|
222 | c write(*,*) "acf",acf_avg_imag(72,12) | |||
|
|
223 | end if | |||
|
|
224 | status(1)=chi2 | |||
|
|
225 | ||||
|
|
226 | c write(*,*) "status: ",status | |||
|
|
227 | ||||
|
|
228 | 5 return | |||
|
|
229 | end | |||
|
|
230 | ||||
|
|
231 | ||||
|
|
232 | subroutine grid() | |||
|
|
233 | c | |||
|
|
234 | c minimize chi-squared statistic through grid search | |||
|
|
235 | c just optmize temperature and H+ profiles | |||
|
|
236 | c | |||
|
|
237 | include 'spline.h' | |||
|
|
238 | include 'fpa.h' | |||
|
|
239 | include 'fitter.h' | |||
|
|
240 | c | |||
|
|
241 | real plag2(nl,nrange) | |||
|
|
242 | real fvec(nrange*nl) | |||
|
|
243 | real chmin,uttime | |||
|
|
244 | integer lmin,mmin,nmin | |||
|
|
245 | integer iloop,iskip,l1,l2,m1,m2,n1,n2 | |||
|
|
246 | c | |||
|
|
247 | common /chisq/chi2 | |||
|
|
248 | common /utime/uttime | |||
|
|
249 | c | |||
|
|
250 | chmin=1.0e10 | |||
|
|
251 | ||||
|
|
252 | do i=1,nrange | |||
|
|
253 | altp(i)=r0+dr*float(i-1) | |||
|
|
254 | end do | |||
|
|
255 | ||||
|
|
256 | goto 3 | |||
|
|
257 | call newplot(.true.) | |||
|
|
258 | call graphinit() | |||
|
|
259 | call erase | |||
|
|
260 | ||||
|
|
261 | call setorigin(6.5,3.5,90.0) | |||
|
|
262 | call linearaxis("L",altp(1),altp(nrange),1.5,5.0,2,0.0,50.0) | |||
|
|
263 | call linearaxis("B",0.0,5000.0,1.5,5.0,2,0.0,500.0) | |||
|
|
264 | call drawaxis("T",2) | |||
|
|
265 | call drawaxis("R",2) | |||
|
|
266 | call labelaxis("B","(f5.0)",.1,2,0.0,2000.0) | |||
|
|
267 | call labelaxis("L","(f5.0)",.1,2,0.0,100.0) | |||
|
|
268 | call ctitle("L","Altitude (km)",.125,2) | |||
|
|
269 | call ctitle("B","T\\se\\u (K)",.125,2) | |||
|
|
270 | ||||
|
|
271 | call setorigin(6.5,7.5,90.0) | |||
|
|
272 | call linearaxis("L",altp(1),altp(nrange),1.5,5.0,2,0.0,50.0) | |||
|
|
273 | call linearaxis("B",0.0,1.0,1.5,5.0,2,0.0,0.25) | |||
|
|
274 | call drawaxis("T",2) | |||
|
|
275 | call drawaxis("R",2) | |||
|
|
276 | call labelaxis("B","(f5.1)",.1,2,0.0,0.5) | |||
|
|
277 | call labelaxis("L","(f5.0)",.1,2,0.0,100.0) | |||
|
|
278 | call ctitle("B","H\\S+\\U frac.",.125,2) | |||
|
|
279 | ||||
|
|
280 | 3 continue | |||
|
|
281 | ||||
|
|
282 | do iloop=1,2 | |||
|
|
283 | if(iloop.eq.1) then | |||
|
|
284 | l1=2 | |||
|
|
285 | l2=26 | |||
|
|
286 | m1=2 | |||
|
|
287 | m2=10 | |||
|
|
288 | n1=2 | |||
|
|
289 | n2=16 | |||
|
|
290 | iskip=2 | |||
|
|
291 | else | |||
|
|
292 | l1=lmin-2 | |||
|
|
293 | l2=lmin+2 | |||
|
|
294 | m1=mmin-2 | |||
|
|
295 | m2=mmin+2 | |||
|
|
296 | n1=nmin-2 | |||
|
|
297 | n2=nmin+2 | |||
|
|
298 | iskip=1 | |||
|
|
299 | end if | |||
|
|
300 | ||||
|
|
301 | do l=l1,l2,iskip ! temperature search | |||
|
|
302 | do k=1,nspline | |||
|
|
303 | ||||
|
|
304 | tmp=-2.5+float(k-1)*float(l-1)*1.3e-2 | |||
|
|
305 | c if(uttime.ge.2.0.and.uttime.lt.10.0) then | |||
|
|
306 | c tmp=-1.5+float(k-1)*float(l-1)*8.0e-3 | |||
|
|
307 | c else | |||
|
|
308 | c tmp = -0.75 -0.2*float(l) + 3.5e-1*float(k-1) ! was 3.5 | |||
|
|
309 | c tmp=-1.5 + 3.0e-2*float(l-1) | |||
|
|
310 | c & *(float(k-1)**3.0/float(nspline-1)**2.0) | |||
|
|
311 | c end if | |||
|
|
312 | ||||
|
|
313 | bcoef(k,2)=tmp | |||
|
|
314 | if(uttime.ge.10.0.and.uttime.le.14.0) then ! was 10.5 | |||
|
|
315 | bcoef(k,3)=tmp-0.1 | |||
|
|
316 | else | |||
|
|
317 | bcoef(k,3)=tmp-0.02 | |||
|
|
318 | end if | |||
|
|
319 | end do | |||
|
|
320 | ||||
|
|
321 | do m=m1,m2,iskip ! H+ scale height search DLH 2015 | |||
|
|
322 | ||||
|
|
323 | do n=n1,n2,iskip ! H+ crossing height search | |||
|
|
324 | ||||
|
|
325 | do k=1,nspline | |||
|
|
326 | tmp=float(k-nspline/4-n)*(float(m-1)*5.0e-2+0.1) | |||
|
|
327 | bcoef(k,4)=tmp | |||
|
|
328 | end do | |||
|
|
329 | ||||
|
|
330 | do i=1,nrange | |||
|
|
331 | call get_spline(altp(i),densp(i),tep(i),tip(i), | |||
|
|
332 | & hfp(i),hefp(i)) | |||
|
|
333 | ||||
|
|
334 | end do | |||
|
|
335 | ||||
|
|
336 | goto 4 | |||
|
|
337 | call setorigin(6.5,3.5,90.0) | |||
|
|
338 | call setscale("L",altp(1),altp(nrange),1) | |||
|
|
339 | call setscale("B",0.0,5000.0,1) | |||
|
|
340 | call setclip("L",250.0,1500.0) | |||
|
|
341 | call plotline("B,L",tep,altp,nrange,2,0) | |||
|
|
342 | ||||
|
|
343 | if(l.eq.1) then | |||
|
|
344 | call setorigin(6.5,7.5,90.0) | |||
|
|
345 | call setscale("L",altp(1),altp(nrange),1) | |||
|
|
346 | call setscale("B",0.0,1.0,1) | |||
|
|
347 | call setclip("L",250.0,1500.0) | |||
|
|
348 | call plotline("B,L",hfp,altp,nrange,2,0) | |||
|
|
349 | end if | |||
|
|
350 | 4 continue | |||
|
|
351 | ||||
|
|
352 | c calculate chi-2 | |||
|
|
353 | c write(*,*) "wl: ",wl, "r0: ",r0 | |||
|
|
354 | c write(*,*) "dr: ",dr,"nl: ",n,"nrange", nrange | |||
|
|
355 | c write(*,*) "before lagp inside grid" | |||
|
|
356 | call lagp(plag2,wl,r0,dr,nl,nrange) | |||
|
|
357 | c write(*,*) "plag2: ",plag2(12,72) | |||
|
|
358 | c write(*,*) "plag2: ",plag2 | |||
|
|
359 | c call exit | |||
|
|
360 | call get_scale(plag2) | |||
|
|
361 | c write(*,*) "plag: ",plag(13,70) | |||
|
|
362 | c write(*,*) "plag2: ",plag2(13,70) | |||
|
|
363 | c write(*,*) "plag_errors: ",plag_errors(13,70) | |||
|
|
364 | c write(*,*) "sconst: ",sconst | |||
|
|
365 | c call exit | |||
|
|
366 | c write(*,*) "cal chi2.1: ", chi2 | |||
|
|
367 | c call exit | |||
|
|
368 | chi2=0.0 | |||
|
|
369 | ipt=0 | |||
|
|
370 | c write(*,*) "cal chi2.1: ", chi2 | |||
|
|
371 | do j=nl+1,nrange | |||
|
|
372 | do i=1,nl | |||
|
|
373 | ipt=ipt+1 | |||
|
|
374 | fvec(ipt)=(plag(i,j)-plag2(i,j)*sconst)/ | |||
|
|
375 | & plag_errors(i,j) | |||
|
|
376 | c write(*,*) j,i,plag(i,j),plag2(i,j), | |||
|
|
377 | c & plag_errors(i,j),sconst | |||
|
|
378 | c call exit | |||
|
|
379 | chi2=chi2+fvec(ipt)**2 | |||
|
|
380 | c write(*,*) "cal chi2.1: ", chi2 | |||
|
|
381 | end do | |||
|
|
382 | c call exit | |||
|
|
383 | end do | |||
|
|
384 | c write(*,*) "cal chi2.2: ", chi2 | |||
|
|
385 | c call exit | |||
|
|
386 | chi2=sqrt(chi2/float(nrange*nl))!+float(l)*0.005 ! DLH?? | |||
|
|
387 | if(chi2.lt.chmin) then | |||
|
|
388 | lmin=l | |||
|
|
389 | mmin=m | |||
|
|
390 | nmin=n | |||
|
|
391 | chmin=chi2 | |||
|
|
392 | end if | |||
|
|
393 | ||||
|
|
394 | write(*,*) "A",l,m,n,chi2,chmin,"B" ! best | |||
|
|
395 | c call exit | |||
|
|
396 | c write(*,fmt='("intermediate")') | |||
|
|
397 | end do | |||
|
|
398 | end do | |||
|
|
399 | end do | |||
|
|
400 | ||||
|
|
401 | end do | |||
|
|
402 | c write(*,fmt='("befire flush")') | |||
|
|
403 | c call where() | |||
|
|
404 | write(22,*) lmin,mmin,nmin,chmin | |||
|
|
405 | call flush(22) | |||
|
|
406 | c write(*,fmt='("after flush")') | |||
|
|
407 | c best result here | |||
|
|
408 | ||||
|
|
409 | do k=1,nspline | |||
|
|
410 | tmp=-2.5+float(k-1)*float(lmin-1)*1.3e-2 | |||
|
|
411 | c if(uttime.ge.2.0.and.uttime.lt.10.0) then | |||
|
|
412 | c tmp=-1.5+float(k-1)*float(lmin-1)*8.0e-3 | |||
|
|
413 | c else | |||
|
|
414 | c tmp = -0.75 -0.2*float(l) + 3.5e-1*float(k-1) ! was 3.5 | |||
|
|
415 | c tmp=-1.5 + 3.0e-2*float(lmin-1) ! new family of temps | |||
|
|
416 | c & *(float(k-1)**3.0/float(nspline-1)**2.0) | |||
|
|
417 | c end if | |||
|
|
418 | bcoef(k,2)=tmp | |||
|
|
419 | if(uttime.ge.10.0.and.uttime.le.14.0) then ! was 10.5 | |||
|
|
420 | bcoef(k,3)=tmp-0.1 | |||
|
|
421 | else | |||
|
|
422 | bcoef(k,3)=tmp-0.02 | |||
|
|
423 | end if | |||
|
|
424 | tmp=float(k-nspline/4-nmin)*(float(mmin-1)*5.0e-2+0.1) | |||
|
|
425 | bcoef(k,4)=tmp | |||
|
|
426 | end do | |||
|
|
427 | ||||
|
|
428 | c reset system constant | |||
|
|
429 | ||||
|
|
430 | do i=1,nrange | |||
|
|
431 | call get_spline(altp(i),densp(i),tep(i),tip(i), | |||
|
|
432 | & hfp(i),hefp(i)) | |||
|
|
433 | end do | |||
|
|
434 | c write(*,fmt='("------------before lagp------------")') | |||
|
|
435 | c write(*,*) chi2 | |||
|
|
436 | c call exit | |||
|
|
437 | call lagp(plag2,wl,r0,dr,nl,nrange) | |||
|
|
438 | c write(*,fmt='("after lagp")') | |||
|
|
439 | call get_scale(plag2) | |||
|
|
440 | c write(*,*) chi2 | |||
|
|
441 | chi2=chmin | |||
|
|
442 | return | |||
|
|
443 | end | |||
|
|
444 | ||||
|
|
445 | subroutine propagate(xe) | |||
|
|
446 | c | |||
|
|
447 | c propagate errors through splines | |||
|
|
448 | c | |||
|
|
449 | include 'fpa.h' | |||
|
|
450 | include 'spline.h' | |||
|
|
451 | parameter(nvar=nspline*nstate) | |||
|
|
452 | real xe(nvar) | |||
|
|
453 | ||||
|
|
454 | ||||
|
|
455 | do i=1,nrange | |||
|
|
456 | ||||
|
|
457 | write(*,*) "densp:", densp(i),bcoef(1,2) | |||
|
|
458 | c call exit | |||
|
|
459 | c | |||
|
|
460 | edensp(i)=bvalue(ta,xe(1+0*nspline),nspline,norder,altp(i),0) | |||
|
|
461 | & *densp(i)*2.30 | |||
|
|
462 | x=bvalue(ta,bcoef(1,2),nspline,norder,altp(i),0) | |||
|
|
463 | etep(i)=bvalue(ta,xe(1+1*nspline),nspline,norder,altp(i),0) | |||
|
|
464 | & *(t1/2.0)/cosh(x)**2 ! DLH 10/14 was 3500 | |||
|
|
465 | ||||
|
|
466 | write(*,*) i,altp(i),x, | |||
|
|
467 | & bvalue(ta,xe(1+1*nspline),nspline,norder,altp(i),0), | |||
|
|
468 | & (3500.0/2.0)/cosh(x)**2,xe(1+i/4+1*nspline) | |||
|
|
469 | ||||
|
|
470 | x=bvalue(ta,bcoef(1,3),nspline,norder,altp(i),0) | |||
|
|
471 | etip(i)=bvalue(ta,xe(1+2*nspline),nspline,norder,altp(i),0) | |||
|
|
472 | & *(t1/2.0)/cosh(x)**2 ! DLH 10/14 was 3500 | |||
|
|
473 | x=bvalue(ta,bcoef(1,4),nspline,norder,altp(i),0) | |||
|
|
474 | ehfp(i)=bvalue(ta,xe(1+3*nspline),nspline,norder,altp(i),0) | |||
|
|
475 | & *(1.0/2.0)/cosh(x)**2 | |||
|
|
476 | x=bvalue(ta,bcoef(1,5),nspline,norder,altp(i),0) | |||
|
|
477 | ehefp(i)=bvalue(ta,xe(1+4*nspline),nspline,norder,altp(i),0) | |||
|
|
478 | & *(1.0/2.0)/cosh(x)**2 | |||
|
|
479 | ||||
|
|
480 | write(*,*) altp(i),edensp(i),etep(i),etip(i),ehfp(i),ehefp(i) | |||
|
|
481 | c call exit | |||
|
|
482 | end do | |||
|
|
483 | ||||
|
|
484 | c stop | |||
|
|
485 | ||||
|
|
486 | return | |||
|
|
487 | end | |||
|
|
488 | ||||
|
|
489 | subroutine fcn_lpreg(m,n,x,fvec,iflag) | |||
|
|
490 | c | |||
|
|
491 | include 'spline.h' | |||
|
|
492 | include 'fpa.h' | |||
|
|
493 | include 'fitter.h' | |||
|
|
494 | c | |||
|
|
495 | integer m,n,iflag,iflaglast | |||
|
|
496 | real x(n),fvec(m),pen(nstate+npen) | |||
|
|
497 | real plag2(nl,nrange) | |||
|
|
498 | real regu(nstate+npen) | |||
|
|
499 | data regu/1.0e1,5.0e1,10.0e1,1.0e2,5.0e1, | |||
|
|
500 | & 1.0e1,2.0e0,1.0e0,5.0e-3,1.0e0/ | |||
|
|
501 | ||||
|
|
502 | c 2019 | |||
|
|
503 | common /iflaglast/iflaglast | |||
|
|
504 | common /chisq/chi2 | |||
|
|
505 | common /utime/uttime | |||
|
|
506 | c | |||
|
|
507 | c write(*,*)uttime," 3 *" | |||
|
|
508 | ||||
|
|
509 | c zero out, copy over some arrays | |||
|
|
510 | ||||
|
|
511 | c write(*,*) "Starting fcn_lpreg" | |||
|
|
512 | write(*,*) "x:",x(2) | |||
|
|
513 | ||||
|
|
514 | do j=1,nstate+npen | |||
|
|
515 | pen(j)=0.0 | |||
|
|
516 | end do | |||
|
|
517 | ||||
|
|
518 | ipt=0 | |||
|
|
519 | do j=1,nstate | |||
|
|
520 | do i=1,nspline | |||
|
|
521 | ipt=ipt+1 | |||
|
|
522 | bcoef(i,j)=x(ipt) | |||
|
|
523 | c write(*,*)j,i,bcoef(i,j) | |||
|
|
524 | end do | |||
|
|
525 | end do | |||
|
|
526 | ||||
|
|
527 | c populate profiles from splines | |||
|
|
528 | write(*,*) "densp1:",densp(1) | |||
|
|
529 | do i=1,nrange | |||
|
|
530 | altp(i)=r0+dr*float(i-1) | |||
|
|
531 | c write(*,*) "densp1:",densp(i) | |||
|
|
532 | call get_spline(altp(i),densp(i),tep(i),tip(i), | |||
|
|
533 | & hfp(i),hefp(i)) | |||
|
|
534 | c write(*,*) "densp2:",densp(i) | |||
|
|
535 | c call exit | |||
|
|
536 | end do | |||
|
|
537 | write(*,*) "densp2:",densp(1) | |||
|
|
538 | c regularize spline coefficients, establish boundary conditions | |||
|
|
539 | c write(*,*) "After spline_fcn_lpreg" | |||
|
|
540 | ipt=0 | |||
|
|
541 | do i=2,nspline-1 | |||
|
|
542 | do j=1,nstate | |||
|
|
543 | ||||
|
|
544 | fac=1.2 ! DLH 7/14 could be bendy (or else get spurious He+) | |||
|
|
545 | if((uttime.lt.10.0.or.uttime.gt.15.0).and.j.eq.2) fac=4.0 | |||
|
|
546 | ||||
|
|
547 | ipt=ipt+1 | |||
|
|
548 | tmp=(bcoef(i-1,j)-2.*bcoef(i,j)+bcoef(i+1,j)) | |||
|
|
549 | fvec(ipt)=tmp*regu(j)*fac | |||
|
|
550 | pen(j)=pen(j)+fvec(ipt)**2 | |||
|
|
551 | end do | |||
|
|
552 | end do | |||
|
|
553 | ||||
|
|
554 | c rescale for clearer diagnostic (just for printing) | |||
|
|
555 | ||||
|
|
556 | do i=1,nstate | |||
|
|
557 | pen(i)=sqrt(pen(i)/float(nspline)) | |||
|
|
558 | end do | |||
|
|
559 | ||||
|
|
560 | c write(*,*) x | |||
|
|
561 | ||||
|
|
562 | c compute model prediction error to minimize in LS sense | |||
|
|
563 | c write(*,*) "before lagp_fcn_lpreg" | |||
|
|
564 | call lagp(plag2,wl,r0,dr,nl,nrange) | |||
|
|
565 | c write(*,*) "before lagp_fcn_lpreg" | |||
|
|
566 | c adjust system constant | |||
|
|
567 | write(*,*) "flgas:",iflag,iflaglast | |||
|
|
568 | if(iflag.eq.1.and.iflaglast.eq.2) then | |||
|
|
569 | sclast=sconst | |||
|
|
570 | call get_scale(plag2) | |||
|
|
571 | sconst=0.1*sconst+0.9*sclast | |||
|
|
572 | end if | |||
|
|
573 | iflaglast=iflag | |||
|
|
574 | ||||
|
|
575 | chi2=0.0 | |||
|
|
576 | do j=nl+1,nrange | |||
|
|
577 | do i=1,nl | |||
|
|
578 | ipt=ipt+1 | |||
|
|
579 | fvec(ipt)=(plag(i,j)-plag2(i,j)*sconst)/plag_errors(i,j) | |||
|
|
580 | chi2=chi2+fvec(ipt)**2 | |||
|
|
581 | end do | |||
|
|
582 | end do | |||
|
|
583 | chi2=sqrt(chi2/float(nrange*nl)) | |||
|
|
584 | ||||
|
|
585 | c add penalties for Tr, composition, He+, lower boundary values, etc. | |||
|
|
586 | c have to adjust penalties for different conditions (e.g. sunrise, night) | |||
|
|
587 | ||||
|
|
588 | do i=1,nrange | |||
|
|
589 | pen(nstate+1)=pen(nstate+1)+hefp(i)**2 | |||
|
|
590 | ||||
|
|
591 | if(tep(i).gt.tip(i)) then ! 3/2015 500 -> 1000 ? | |||
|
|
592 | if(uttime.ge.10.0.and.uttime.le.15.0) then ! was 10.5, 14->15 | |||
|
|
593 | scale=500.0 ! dlh 7/14 was 1500, but this defeated He+, so 500 | |||
|
|
594 | else | |||
|
|
595 | scale=50.0 | |||
|
|
596 | end if | |||
|
|
597 | else | |||
|
|
598 | scale=10.0 | |||
|
|
599 | end if | |||
|
|
600 | ||||
|
|
601 | pen(nstate+2)=pen(nstate+2)+((tip(i)-tep(i))/scale)**2 | |||
|
|
602 | pen(nstate+3)=pen(nstate+3)+exp((hfp(i)+hefp(i)-1.0)/2.0)**2 | |||
|
|
603 | ||||
|
|
604 | end do | |||
|
|
605 | ||||
|
|
606 | pen(nstate+4)=(tip(1)-700.0)**2*float(nrange) ! or 800? | |||
|
|
607 | pen(nstate+5)=(hfp(nrange)-1.0)**2*float(nrange) | |||
|
|
608 | ||||
|
|
609 | do i=1,npen | |||
|
|
610 | tmp=sqrt(pen(nstate+i))*regu(nstate+i) | |||
|
|
611 | ipt=ipt+1 | |||
|
|
612 | fvec(ipt)=tmp | |||
|
|
613 | pen(nstate+i)=tmp/sqrt(float(nrange)) | |||
|
|
614 | end do | |||
|
|
615 | ||||
|
|
616 | c write(*,*) "chi2:",chi2," sys const:",sconst, | |||
|
|
617 | c & " flag:",iflag," penalties:" | |||
|
|
618 | c write(*,*)(pen(i),i=1,5) | |||
|
|
619 | c write(*,*)(pen(i),i=6,10) | |||
|
|
620 | c write(*,*) "ut:",uttime | |||
|
|
621 | c write(*,*) fvec(222) | |||
|
|
622 | ||||
|
|
623 | return | |||
|
|
624 | end | |||
|
|
625 | ||||
|
|
626 | subroutine get_scale(plag2) | |||
|
|
627 | c | |||
|
|
628 | include 'fpa.h' | |||
|
|
629 | real plag2(nl,nrange) | |||
|
|
630 | c | |||
|
|
631 | a=0. | |||
|
|
632 | b=0. | |||
|
|
633 | c do j=3*nrange/4,nrange | |||
|
|
634 | do j=nl+1,nrange | |||
|
|
635 | c write(*,*) j,plag(1,j),plag2(1,j) | |||
|
|
636 | a=a+plag(1,j)*plag2(1,j)/plag_errors(1,j)**2 | |||
|
|
637 | b=b+plag(1,j)*plag(1,j)/plag_errors(1,j)**2 | |||
|
|
638 | end do | |||
|
|
639 | ||||
|
|
640 | sconst=b/a | |||
|
|
641 | ||||
|
|
642 | write(*,*)"sconst_inside_get_scape:",sconst,a,b | |||
|
|
643 | c stop | |||
|
|
644 | ||||
|
|
645 | return | |||
|
|
646 | end | |||
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| @@ -0,0 +1,198 | |||||
|
|
1 | *DECK GAMLN | |||
|
|
2 | REAL FUNCTION GAMLN (Z, IERR) | |||
|
|
3 | C***BEGIN PROLOGUE GAMLN | |||
|
|
4 | C***SUBSIDIARY | |||
|
|
5 | C***PURPOSE Compute the logarithm of the Gamma function | |||
|
|
6 | C***LIBRARY SLATEC | |||
|
|
7 | C***CATEGORY C7A | |||
|
|
8 | C***TYPE SINGLE PRECISION (GAMLN-S, DGAMLN-D) | |||
|
|
9 | C***KEYWORDS LOGARITHM OF GAMMA FUNCTION | |||
|
|
10 | C***AUTHOR Amos, D. E., (SNL) | |||
|
|
11 | C***DESCRIPTION | |||
|
|
12 | C | |||
|
|
13 | C GAMLN COMPUTES THE NATURAL LOG OF THE GAMMA FUNCTION FOR | |||
|
|
14 | C Z.GT.0. THE ASYMPTOTIC EXPANSION IS USED TO GENERATE VALUES | |||
|
|
15 | C GREATER THAN ZMIN WHICH ARE ADJUSTED BY THE RECURSION | |||
|
|
16 | C G(Z+1)=Z*G(Z) FOR Z.LE.ZMIN. THE FUNCTION WAS MADE AS | |||
|
|
17 | C PORTABLE AS POSSIBLE BY COMPUTING ZMIN FROM THE NUMBER OF BASE | |||
|
|
18 | C 10 DIGITS IN A WORD, RLN=MAX(-ALOG10(R1MACH(4)),0.5E-18) | |||
|
|
19 | C LIMITED TO 18 DIGITS OF (RELATIVE) ACCURACY. | |||
|
|
20 | C | |||
|
|
21 | C SINCE INTEGER ARGUMENTS ARE COMMON, A TABLE LOOK UP ON 100 | |||
|
|
22 | C VALUES IS USED FOR SPEED OF EXECUTION. | |||
|
|
23 | C | |||
|
|
24 | C DESCRIPTION OF ARGUMENTS | |||
|
|
25 | C | |||
|
|
26 | C INPUT | |||
|
|
27 | C Z - REAL ARGUMENT, Z.GT.0.0E0 | |||
|
|
28 | C | |||
|
|
29 | C OUTPUT | |||
|
|
30 | C GAMLN - NATURAL LOG OF THE GAMMA FUNCTION AT Z | |||
|
|
31 | C IERR - ERROR FLAG | |||
|
|
32 | C IERR=0, NORMAL RETURN, COMPUTATION COMPLETED | |||
|
|
33 | C IERR=1, Z.LE.0.0E0, NO COMPUTATION | |||
|
|
34 | C | |||
|
|
35 | C***REFERENCES COMPUTATION OF BESSEL FUNCTIONS OF COMPLEX ARGUMENT | |||
|
|
36 | C BY D. E. AMOS, SAND83-0083, MAY, 1983. | |||
|
|
37 | C***ROUTINES CALLED I1MACH, R1MACH | |||
|
|
38 | C***REVISION HISTORY (YYMMDD) | |||
|
|
39 | C 830501 DATE WRITTEN | |||
|
|
40 | C 830501 REVISION DATE from Version 3.2 | |||
|
|
41 | C 910415 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
42 | C 920128 Category corrected. (WRB) | |||
|
|
43 | C 921215 GAMLN defined for Z negative. (WRB) | |||
|
|
44 | C***END PROLOGUE GAMLN | |||
|
|
45 | C | |||
|
|
46 | INTEGER I, I1M, K, MZ, NZ, IERR, I1MACH | |||
|
|
47 | REAL CF, CON, FLN, FZ, GLN, RLN, S, TLG, TRM, TST, T1, WDTOL, Z, | |||
|
|
48 | * ZDMY, ZINC, ZM, ZMIN, ZP, ZSQ | |||
|
|
49 | REAL R1MACH | |||
|
|
50 | DIMENSION CF(22), GLN(100) | |||
|
|
51 | C LNGAMMA(N), N=1,100 | |||
|
|
52 | DATA GLN(1), GLN(2), GLN(3), GLN(4), GLN(5), GLN(6), GLN(7), | |||
|
|
53 | 1 GLN(8), GLN(9), GLN(10), GLN(11), GLN(12), GLN(13), GLN(14), | |||
|
|
54 | 2 GLN(15), GLN(16), GLN(17), GLN(18), GLN(19), GLN(20), | |||
|
|
55 | 3 GLN(21), GLN(22)/ | |||
|
|
56 | 4 0.00000000000000000E+00, 0.00000000000000000E+00, | |||
|
|
57 | 5 6.93147180559945309E-01, 1.79175946922805500E+00, | |||
|
|
58 | 6 3.17805383034794562E+00, 4.78749174278204599E+00, | |||
|
|
59 | 7 6.57925121201010100E+00, 8.52516136106541430E+00, | |||
|
|
60 | 8 1.06046029027452502E+01, 1.28018274800814696E+01, | |||
|
|
61 | 9 1.51044125730755153E+01, 1.75023078458738858E+01, | |||
|
|
62 | A 1.99872144956618861E+01, 2.25521638531234229E+01, | |||
|
|
63 | B 2.51912211827386815E+01, 2.78992713838408916E+01, | |||
|
|
64 | C 3.06718601060806728E+01, 3.35050734501368889E+01, | |||
|
|
65 | D 3.63954452080330536E+01, 3.93398841871994940E+01, | |||
|
|
66 | E 4.23356164607534850E+01, 4.53801388984769080E+01/ | |||
|
|
67 | DATA GLN(23), GLN(24), GLN(25), GLN(26), GLN(27), GLN(28), | |||
|
|
68 | 1 GLN(29), GLN(30), GLN(31), GLN(32), GLN(33), GLN(34), | |||
|
|
69 | 2 GLN(35), GLN(36), GLN(37), GLN(38), GLN(39), GLN(40), | |||
|
|
70 | 3 GLN(41), GLN(42), GLN(43), GLN(44)/ | |||
|
|
71 | 4 4.84711813518352239E+01, 5.16066755677643736E+01, | |||
|
|
72 | 5 5.47847293981123192E+01, 5.80036052229805199E+01, | |||
|
|
73 | 6 6.12617017610020020E+01, 6.45575386270063311E+01, | |||
|
|
74 | 7 6.78897431371815350E+01, 7.12570389671680090E+01, | |||
|
|
75 | 8 7.46582363488301644E+01, 7.80922235533153106E+01, | |||
|
|
76 | 9 8.15579594561150372E+01, 8.50544670175815174E+01, | |||
|
|
77 | A 8.85808275421976788E+01, 9.21361756036870925E+01, | |||
|
|
78 | B 9.57196945421432025E+01, 9.93306124547874269E+01, | |||
|
|
79 | C 1.02968198614513813E+02, 1.06631760260643459E+02, | |||
|
|
80 | D 1.10320639714757395E+02, 1.14034211781461703E+02, | |||
|
|
81 | E 1.17771881399745072E+02, 1.21533081515438634E+02/ | |||
|
|
82 | DATA GLN(45), GLN(46), GLN(47), GLN(48), GLN(49), GLN(50), | |||
|
|
83 | 1 GLN(51), GLN(52), GLN(53), GLN(54), GLN(55), GLN(56), | |||
|
|
84 | 2 GLN(57), GLN(58), GLN(59), GLN(60), GLN(61), GLN(62), | |||
|
|
85 | 3 GLN(63), GLN(64), GLN(65), GLN(66)/ | |||
|
|
86 | 4 1.25317271149356895E+02, 1.29123933639127215E+02, | |||
|
|
87 | 5 1.32952575035616310E+02, 1.36802722637326368E+02, | |||
|
|
88 | 6 1.40673923648234259E+02, 1.44565743946344886E+02, | |||
|
|
89 | 7 1.48477766951773032E+02, 1.52409592584497358E+02, | |||
|
|
90 | 8 1.56360836303078785E+02, 1.60331128216630907E+02, | |||
|
|
91 | 9 1.64320112263195181E+02, 1.68327445448427652E+02, | |||
|
|
92 | A 1.72352797139162802E+02, 1.76395848406997352E+02, | |||
|
|
93 | B 1.80456291417543771E+02, 1.84533828861449491E+02, | |||
|
|
94 | C 1.88628173423671591E+02, 1.92739047287844902E+02, | |||
|
|
95 | D 1.96866181672889994E+02, 2.01009316399281527E+02, | |||
|
|
96 | E 2.05168199482641199E+02, 2.09342586752536836E+02/ | |||
|
|
97 | DATA GLN(67), GLN(68), GLN(69), GLN(70), GLN(71), GLN(72), | |||
|
|
98 | 1 GLN(73), GLN(74), GLN(75), GLN(76), GLN(77), GLN(78), | |||
|
|
99 | 2 GLN(79), GLN(80), GLN(81), GLN(82), GLN(83), GLN(84), | |||
|
|
100 | 3 GLN(85), GLN(86), GLN(87), GLN(88)/ | |||
|
|
101 | 4 2.13532241494563261E+02, 2.17736934113954227E+02, | |||
|
|
102 | 5 2.21956441819130334E+02, 2.26190548323727593E+02, | |||
|
|
103 | 6 2.30439043565776952E+02, 2.34701723442818268E+02, | |||
|
|
104 | 7 2.38978389561834323E+02, 2.43268849002982714E+02, | |||
|
|
105 | 8 2.47572914096186884E+02, 2.51890402209723194E+02, | |||
|
|
106 | 9 2.56221135550009525E+02, 2.60564940971863209E+02, | |||
|
|
107 | A 2.64921649798552801E+02, 2.69291097651019823E+02, | |||
|
|
108 | B 2.73673124285693704E+02, 2.78067573440366143E+02, | |||
|
|
109 | C 2.82474292687630396E+02, 2.86893133295426994E+02, | |||
|
|
110 | D 2.91323950094270308E+02, 2.95766601350760624E+02, | |||
|
|
111 | E 3.00220948647014132E+02, 3.04686856765668715E+02/ | |||
|
|
112 | DATA GLN(89), GLN(90), GLN(91), GLN(92), GLN(93), GLN(94), | |||
|
|
113 | 1 GLN(95), GLN(96), GLN(97), GLN(98), GLN(99), GLN(100)/ | |||
|
|
114 | 2 3.09164193580146922E+02, 3.13652829949879062E+02, | |||
|
|
115 | 3 3.18152639620209327E+02, 3.22663499126726177E+02, | |||
|
|
116 | 4 3.27185287703775217E+02, 3.31717887196928473E+02, | |||
|
|
117 | 5 3.36261181979198477E+02, 3.40815058870799018E+02, | |||
|
|
118 | 6 3.45379407062266854E+02, 3.49954118040770237E+02, | |||
|
|
119 | 7 3.54539085519440809E+02, 3.59134205369575399E+02/ | |||
|
|
120 | C COEFFICIENTS OF ASYMPTOTIC EXPANSION | |||
|
|
121 | DATA CF(1), CF(2), CF(3), CF(4), CF(5), CF(6), CF(7), CF(8), | |||
|
|
122 | 1 CF(9), CF(10), CF(11), CF(12), CF(13), CF(14), CF(15), | |||
|
|
123 | 2 CF(16), CF(17), CF(18), CF(19), CF(20), CF(21), CF(22)/ | |||
|
|
124 | 3 8.33333333333333333E-02, -2.77777777777777778E-03, | |||
|
|
125 | 4 7.93650793650793651E-04, -5.95238095238095238E-04, | |||
|
|
126 | 5 8.41750841750841751E-04, -1.91752691752691753E-03, | |||
|
|
127 | 6 6.41025641025641026E-03, -2.95506535947712418E-02, | |||
|
|
128 | 7 1.79644372368830573E-01, -1.39243221690590112E+00, | |||
|
|
129 | 8 1.34028640441683920E+01, -1.56848284626002017E+02, | |||
|
|
130 | 9 2.19310333333333333E+03, -3.61087712537249894E+04, | |||
|
|
131 | A 6.91472268851313067E+05, -1.52382215394074162E+07, | |||
|
|
132 | B 3.82900751391414141E+08, -1.08822660357843911E+10, | |||
|
|
133 | C 3.47320283765002252E+11, -1.23696021422692745E+13, | |||
|
|
134 | D 4.88788064793079335E+14, -2.13203339609193739E+16/ | |||
|
|
135 | C | |||
|
|
136 | C LN(2*PI) | |||
|
|
137 | DATA CON / 1.83787706640934548E+00/ | |||
|
|
138 | C | |||
|
|
139 | C***FIRST EXECUTABLE STATEMENT GAMLN | |||
|
|
140 | IERR=0 | |||
|
|
141 | IF (Z.LE.0.0E0) GO TO 70 | |||
|
|
142 | IF (Z.GT.101.0E0) GO TO 10 | |||
|
|
143 | NZ = Z | |||
|
|
144 | FZ = Z - NZ | |||
|
|
145 | IF (FZ.GT.0.0E0) GO TO 10 | |||
|
|
146 | IF (NZ.GT.100) GO TO 10 | |||
|
|
147 | GAMLN = GLN(NZ) | |||
|
|
148 | RETURN | |||
|
|
149 | 10 CONTINUE | |||
|
|
150 | WDTOL = R1MACH(4) | |||
|
|
151 | WDTOL = MAX(WDTOL,0.5E-18) | |||
|
|
152 | I1M = I1MACH(11) | |||
|
|
153 | RLN = R1MACH(5)*I1M | |||
|
|
154 | FLN = MIN(RLN,20.0E0) | |||
|
|
155 | FLN = MAX(FLN,3.0E0) | |||
|
|
156 | FLN = FLN - 3.0E0 | |||
|
|
157 | ZM = 1.8000E0 + 0.3875E0*FLN | |||
|
|
158 | MZ = ZM + 1 | |||
|
|
159 | ZMIN = MZ | |||
|
|
160 | ZDMY = Z | |||
|
|
161 | ZINC = 0.0E0 | |||
|
|
162 | IF (Z.GE.ZMIN) GO TO 20 | |||
|
|
163 | ZINC = ZMIN - NZ | |||
|
|
164 | ZDMY = Z + ZINC | |||
|
|
165 | 20 CONTINUE | |||
|
|
166 | ZP = 1.0E0/ZDMY | |||
|
|
167 | T1 = CF(1)*ZP | |||
|
|
168 | S = T1 | |||
|
|
169 | IF (ZP.LT.WDTOL) GO TO 40 | |||
|
|
170 | ZSQ = ZP*ZP | |||
|
|
171 | TST = T1*WDTOL | |||
|
|
172 | DO 30 K=2,22 | |||
|
|
173 | ZP = ZP*ZSQ | |||
|
|
174 | TRM = CF(K)*ZP | |||
|
|
175 | IF (ABS(TRM).LT.TST) GO TO 40 | |||
|
|
176 | S = S + TRM | |||
|
|
177 | 30 CONTINUE | |||
|
|
178 | 40 CONTINUE | |||
|
|
179 | IF (ZINC.NE.0.0E0) GO TO 50 | |||
|
|
180 | TLG = ALOG(Z) | |||
|
|
181 | GAMLN = Z*(TLG-1.0E0) + 0.5E0*(CON-TLG) + S | |||
|
|
182 | RETURN | |||
|
|
183 | 50 CONTINUE | |||
|
|
184 | ZP = 1.0E0 | |||
|
|
185 | NZ = ZINC | |||
|
|
186 | DO 60 I=1,NZ | |||
|
|
187 | ZP = ZP*(Z+(I-1)) | |||
|
|
188 | 60 CONTINUE | |||
|
|
189 | TLG = ALOG(ZDMY) | |||
|
|
190 | GAMLN = ZDMY*(TLG-1.0E0) - ALOG(ZP) + 0.5E0*(CON-TLG) + S | |||
|
|
191 | RETURN | |||
|
|
192 | C | |||
|
|
193 | C | |||
|
|
194 | 70 CONTINUE | |||
|
|
195 | GAMLN = R1MACH(2) | |||
|
|
196 | IERR=1 | |||
|
|
197 | RETURN | |||
|
|
198 | END | |||
| @@ -0,0 +1,10 | |||||
|
|
1 | ||||
|
|
2 | subroutine get_path(fqual_temp) | |||
|
|
3 | c | |||
|
|
4 | c create table of magnetic field components | |||
|
|
5 | c | |||
|
|
6 | c character*47 L | |||
|
|
7 | ||||
|
|
8 | character(1024) :: fqual_temp | |||
|
|
9 | character(512) :: ppath | |||
|
|
10 | character(512) :: cpath | |||
| @@ -0,0 +1,6 | |||||
|
|
1 | ||||
|
|
2 | c write(*,*) "Len:", L | |||
|
|
3 | fqual_temp = TRIM(ppath)//TRIM(cpath) | |||
|
|
4 | c write(*,*) "Len:", fqual_temp | |||
|
|
5 | return | |||
|
|
6 | end | |||
| This diff has been collapsed as it changes many lines, (888 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,888 | |||||
|
|
1 | *DECK I1MACH | |||
|
|
2 | INTEGER FUNCTION I1MACH (I) | |||
|
|
3 | C***BEGIN PROLOGUE I1MACH | |||
|
|
4 | C***PURPOSE Return integer machine dependent constants. | |||
|
|
5 | C***LIBRARY SLATEC | |||
|
|
6 | C***CATEGORY R1 | |||
|
|
7 | C***TYPE INTEGER (I1MACH-I) | |||
|
|
8 | C***KEYWORDS MACHINE CONSTANTS | |||
|
|
9 | C***AUTHOR Fox, P. A., (Bell Labs) | |||
|
|
10 | C Hall, A. D., (Bell Labs) | |||
|
|
11 | C Schryer, N. L., (Bell Labs) | |||
|
|
12 | C***DESCRIPTION | |||
|
|
13 | C | |||
|
|
14 | C I1MACH can be used to obtain machine-dependent parameters for the | |||
|
|
15 | C local machine environment. It is a function subprogram with one | |||
|
|
16 | C (input) argument and can be referenced as follows: | |||
|
|
17 | C | |||
|
|
18 | C K = I1MACH(I) | |||
|
|
19 | C | |||
|
|
20 | C where I=1,...,16. The (output) value of K above is determined by | |||
|
|
21 | C the (input) value of I. The results for various values of I are | |||
|
|
22 | C discussed below. | |||
|
|
23 | C | |||
|
|
24 | C I/O unit numbers: | |||
|
|
25 | C I1MACH( 1) = the standard input unit. | |||
|
|
26 | C I1MACH( 2) = the standard output unit. | |||
|
|
27 | C I1MACH( 3) = the standard punch unit. | |||
|
|
28 | C I1MACH( 4) = the standard error message unit. | |||
|
|
29 | C | |||
|
|
30 | C Words: | |||
|
|
31 | C I1MACH( 5) = the number of bits per integer storage unit. | |||
|
|
32 | C I1MACH( 6) = the number of characters per integer storage unit. | |||
|
|
33 | C | |||
|
|
34 | C Integers: | |||
|
|
35 | C assume integers are represented in the S-digit, base-A form | |||
|
|
36 | C | |||
|
|
37 | C sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) | |||
|
|
38 | C | |||
|
|
39 | C where 0 .LE. X(I) .LT. A for I=0,...,S-1. | |||
|
|
40 | C I1MACH( 7) = A, the base. | |||
|
|
41 | C I1MACH( 8) = S, the number of base-A digits. | |||
|
|
42 | C I1MACH( 9) = A**S - 1, the largest magnitude. | |||
|
|
43 | C | |||
|
|
44 | C Floating-Point Numbers: | |||
|
|
45 | C Assume floating-point numbers are represented in the T-digit, | |||
|
|
46 | C base-B form | |||
|
|
47 | C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) | |||
|
|
48 | C | |||
|
|
49 | C where 0 .LE. X(I) .LT. B for I=1,...,T, | |||
|
|
50 | C 0 .LT. X(1), and EMIN .LE. E .LE. EMAX. | |||
|
|
51 | C I1MACH(10) = B, the base. | |||
|
|
52 | C | |||
|
|
53 | C Single-Precision: | |||
|
|
54 | C I1MACH(11) = T, the number of base-B digits. | |||
|
|
55 | C I1MACH(12) = EMIN, the smallest exponent E. | |||
|
|
56 | C I1MACH(13) = EMAX, the largest exponent E. | |||
|
|
57 | C | |||
|
|
58 | C Double-Precision: | |||
|
|
59 | C I1MACH(14) = T, the number of base-B digits. | |||
|
|
60 | C I1MACH(15) = EMIN, the smallest exponent E. | |||
|
|
61 | C I1MACH(16) = EMAX, the largest exponent E. | |||
|
|
62 | C | |||
|
|
63 | C To alter this function for a particular environment, the desired | |||
|
|
64 | C set of DATA statements should be activated by removing the C from | |||
|
|
65 | C column 1. Also, the values of I1MACH(1) - I1MACH(4) should be | |||
|
|
66 | C checked for consistency with the local operating system. | |||
|
|
67 | C | |||
|
|
68 | C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for | |||
|
|
69 | C a portable library, ACM Transactions on Mathematical | |||
|
|
70 | C Software 4, 2 (June 1978), pp. 177-188. | |||
|
|
71 | C***ROUTINES CALLED (NONE) | |||
|
|
72 | C***REVISION HISTORY (YYMMDD) | |||
|
|
73 | C 750101 DATE WRITTEN | |||
|
|
74 | C 891012 Added VAX G-floating constants. (WRB) | |||
|
|
75 | C 891012 REVISION DATE from Version 3.2 | |||
|
|
76 | C 891214 Prologue converted to Version 4.0 format. (BAB) | |||
|
|
77 | C 900618 Added DEC RISC constants. (WRB) | |||
|
|
78 | C 900723 Added IBM RS 6000 constants. (WRB) | |||
|
|
79 | C 901009 Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16. | |||
|
|
80 | C (RWC) | |||
|
|
81 | C 910710 Added HP 730 constants. (SMR) | |||
|
|
82 | C 911114 Added Convex IEEE constants. (WRB) | |||
|
|
83 | C 920121 Added SUN -r8 compiler option constants. (WRB) | |||
|
|
84 | C 920229 Added Touchstone Delta i860 constants. (WRB) | |||
|
|
85 | C 920501 Reformatted the REFERENCES section. (WRB) | |||
|
|
86 | C 920625 Added Convex -p8 and -pd8 compiler option constants. | |||
|
|
87 | C (BKS, WRB) | |||
|
|
88 | C 930201 Added DEC Alpha and SGI constants. (RWC and WRB) | |||
|
|
89 | C 930618 Corrected I1MACH(5) for Convex -p8 and -pd8 compiler | |||
|
|
90 | C options. (DWL, RWC and WRB). | |||
|
|
91 | C***END PROLOGUE I1MACH | |||
|
|
92 | C | |||
|
|
93 | INTEGER IMACH(16),OUTPUT | |||
|
|
94 | SAVE IMACH | |||
|
|
95 | EQUIVALENCE (IMACH(4),OUTPUT) | |||
|
|
96 | C | |||
|
|
97 | C MACHINE CONSTANTS FOR THE AMIGA | |||
|
|
98 | C ABSOFT COMPILER | |||
|
|
99 | C | |||
|
|
100 | C DATA IMACH( 1) / 5 / | |||
|
|
101 | C DATA IMACH( 2) / 6 / | |||
|
|
102 | C DATA IMACH( 3) / 5 / | |||
|
|
103 | C DATA IMACH( 4) / 6 / | |||
|
|
104 | C DATA IMACH( 5) / 32 / | |||
|
|
105 | C DATA IMACH( 6) / 4 / | |||
|
|
106 | C DATA IMACH( 7) / 2 / | |||
|
|
107 | C DATA IMACH( 8) / 31 / | |||
|
|
108 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
109 | C DATA IMACH(10) / 2 / | |||
|
|
110 | C DATA IMACH(11) / 24 / | |||
|
|
111 | C DATA IMACH(12) / -126 / | |||
|
|
112 | C DATA IMACH(13) / 127 / | |||
|
|
113 | C DATA IMACH(14) / 53 / | |||
|
|
114 | C DATA IMACH(15) / -1022 / | |||
|
|
115 | C DATA IMACH(16) / 1023 / | |||
|
|
116 | C | |||
|
|
117 | C MACHINE CONSTANTS FOR THE APOLLO | |||
|
|
118 | C | |||
|
|
119 | C DATA IMACH( 1) / 5 / | |||
|
|
120 | C DATA IMACH( 2) / 6 / | |||
|
|
121 | C DATA IMACH( 3) / 6 / | |||
|
|
122 | C DATA IMACH( 4) / 6 / | |||
|
|
123 | C DATA IMACH( 5) / 32 / | |||
|
|
124 | C DATA IMACH( 6) / 4 / | |||
|
|
125 | C DATA IMACH( 7) / 2 / | |||
|
|
126 | C DATA IMACH( 8) / 31 / | |||
|
|
127 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
128 | C DATA IMACH(10) / 2 / | |||
|
|
129 | C DATA IMACH(11) / 24 / | |||
|
|
130 | C DATA IMACH(12) / -125 / | |||
|
|
131 | C DATA IMACH(13) / 129 / | |||
|
|
132 | C DATA IMACH(14) / 53 / | |||
|
|
133 | C DATA IMACH(15) / -1021 / | |||
|
|
134 | C DATA IMACH(16) / 1025 / | |||
|
|
135 | C | |||
|
|
136 | C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM | |||
|
|
137 | C | |||
|
|
138 | C DATA IMACH( 1) / 7 / | |||
|
|
139 | C DATA IMACH( 2) / 2 / | |||
|
|
140 | C DATA IMACH( 3) / 2 / | |||
|
|
141 | C DATA IMACH( 4) / 2 / | |||
|
|
142 | C DATA IMACH( 5) / 36 / | |||
|
|
143 | C DATA IMACH( 6) / 4 / | |||
|
|
144 | C DATA IMACH( 7) / 2 / | |||
|
|
145 | C DATA IMACH( 8) / 33 / | |||
|
|
146 | C DATA IMACH( 9) / Z1FFFFFFFF / | |||
|
|
147 | C DATA IMACH(10) / 2 / | |||
|
|
148 | C DATA IMACH(11) / 24 / | |||
|
|
149 | C DATA IMACH(12) / -256 / | |||
|
|
150 | C DATA IMACH(13) / 255 / | |||
|
|
151 | C DATA IMACH(14) / 60 / | |||
|
|
152 | C DATA IMACH(15) / -256 / | |||
|
|
153 | C DATA IMACH(16) / 255 / | |||
|
|
154 | C | |||
|
|
155 | C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM | |||
|
|
156 | C | |||
|
|
157 | C DATA IMACH( 1) / 5 / | |||
|
|
158 | C DATA IMACH( 2) / 6 / | |||
|
|
159 | C DATA IMACH( 3) / 7 / | |||
|
|
160 | C DATA IMACH( 4) / 6 / | |||
|
|
161 | C DATA IMACH( 5) / 48 / | |||
|
|
162 | C DATA IMACH( 6) / 6 / | |||
|
|
163 | C DATA IMACH( 7) / 2 / | |||
|
|
164 | C DATA IMACH( 8) / 39 / | |||
|
|
165 | C DATA IMACH( 9) / O0007777777777777 / | |||
|
|
166 | C DATA IMACH(10) / 8 / | |||
|
|
167 | C DATA IMACH(11) / 13 / | |||
|
|
168 | C DATA IMACH(12) / -50 / | |||
|
|
169 | C DATA IMACH(13) / 76 / | |||
|
|
170 | C DATA IMACH(14) / 26 / | |||
|
|
171 | C DATA IMACH(15) / -50 / | |||
|
|
172 | C DATA IMACH(16) / 76 / | |||
|
|
173 | C | |||
|
|
174 | C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS | |||
|
|
175 | C | |||
|
|
176 | C DATA IMACH( 1) / 5 / | |||
|
|
177 | C DATA IMACH( 2) / 6 / | |||
|
|
178 | C DATA IMACH( 3) / 7 / | |||
|
|
179 | C DATA IMACH( 4) / 6 / | |||
|
|
180 | C DATA IMACH( 5) / 48 / | |||
|
|
181 | C DATA IMACH( 6) / 6 / | |||
|
|
182 | C DATA IMACH( 7) / 2 / | |||
|
|
183 | C DATA IMACH( 8) / 39 / | |||
|
|
184 | C DATA IMACH( 9) / O0007777777777777 / | |||
|
|
185 | C DATA IMACH(10) / 8 / | |||
|
|
186 | C DATA IMACH(11) / 13 / | |||
|
|
187 | C DATA IMACH(12) / -50 / | |||
|
|
188 | C DATA IMACH(13) / 76 / | |||
|
|
189 | C DATA IMACH(14) / 26 / | |||
|
|
190 | C DATA IMACH(15) / -32754 / | |||
|
|
191 | C DATA IMACH(16) / 32780 / | |||
|
|
192 | C | |||
|
|
193 | C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE | |||
|
|
194 | C | |||
|
|
195 | C DATA IMACH( 1) / 5 / | |||
|
|
196 | C DATA IMACH( 2) / 6 / | |||
|
|
197 | C DATA IMACH( 3) / 7 / | |||
|
|
198 | C DATA IMACH( 4) / 6 / | |||
|
|
199 | C DATA IMACH( 5) / 64 / | |||
|
|
200 | C DATA IMACH( 6) / 8 / | |||
|
|
201 | C DATA IMACH( 7) / 2 / | |||
|
|
202 | C DATA IMACH( 8) / 63 / | |||
|
|
203 | C DATA IMACH( 9) / 9223372036854775807 / | |||
|
|
204 | C DATA IMACH(10) / 2 / | |||
|
|
205 | C DATA IMACH(11) / 47 / | |||
|
|
206 | C DATA IMACH(12) / -4095 / | |||
|
|
207 | C DATA IMACH(13) / 4094 / | |||
|
|
208 | C DATA IMACH(14) / 94 / | |||
|
|
209 | C DATA IMACH(15) / -4095 / | |||
|
|
210 | C DATA IMACH(16) / 4094 / | |||
|
|
211 | C | |||
|
|
212 | C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES | |||
|
|
213 | C | |||
|
|
214 | C DATA IMACH( 1) / 5 / | |||
|
|
215 | C DATA IMACH( 2) / 6 / | |||
|
|
216 | C DATA IMACH( 3) / 7 / | |||
|
|
217 | C DATA IMACH( 4) / 6LOUTPUT/ | |||
|
|
218 | C DATA IMACH( 5) / 60 / | |||
|
|
219 | C DATA IMACH( 6) / 10 / | |||
|
|
220 | C DATA IMACH( 7) / 2 / | |||
|
|
221 | C DATA IMACH( 8) / 48 / | |||
|
|
222 | C DATA IMACH( 9) / 00007777777777777777B / | |||
|
|
223 | C DATA IMACH(10) / 2 / | |||
|
|
224 | C DATA IMACH(11) / 47 / | |||
|
|
225 | C DATA IMACH(12) / -929 / | |||
|
|
226 | C DATA IMACH(13) / 1070 / | |||
|
|
227 | C DATA IMACH(14) / 94 / | |||
|
|
228 | C DATA IMACH(15) / -929 / | |||
|
|
229 | C DATA IMACH(16) / 1069 / | |||
|
|
230 | C | |||
|
|
231 | C MACHINE CONSTANTS FOR THE CELERITY C1260 | |||
|
|
232 | C | |||
|
|
233 | C DATA IMACH( 1) / 5 / | |||
|
|
234 | C DATA IMACH( 2) / 6 / | |||
|
|
235 | C DATA IMACH( 3) / 6 / | |||
|
|
236 | C DATA IMACH( 4) / 0 / | |||
|
|
237 | C DATA IMACH( 5) / 32 / | |||
|
|
238 | C DATA IMACH( 6) / 4 / | |||
|
|
239 | C DATA IMACH( 7) / 2 / | |||
|
|
240 | C DATA IMACH( 8) / 31 / | |||
|
|
241 | C DATA IMACH( 9) / Z'7FFFFFFF' / | |||
|
|
242 | C DATA IMACH(10) / 2 / | |||
|
|
243 | C DATA IMACH(11) / 24 / | |||
|
|
244 | C DATA IMACH(12) / -126 / | |||
|
|
245 | C DATA IMACH(13) / 127 / | |||
|
|
246 | C DATA IMACH(14) / 53 / | |||
|
|
247 | C DATA IMACH(15) / -1022 / | |||
|
|
248 | C DATA IMACH(16) / 1023 / | |||
|
|
249 | C | |||
|
|
250 | C MACHINE CONSTANTS FOR THE CONVEX | |||
|
|
251 | C USING THE -fn COMPILER OPTION | |||
|
|
252 | C | |||
|
|
253 | C DATA IMACH( 1) / 5 / | |||
|
|
254 | C DATA IMACH( 2) / 6 / | |||
|
|
255 | C DATA IMACH( 3) / 7 / | |||
|
|
256 | C DATA IMACH( 4) / 6 / | |||
|
|
257 | C DATA IMACH( 5) / 32 / | |||
|
|
258 | C DATA IMACH( 6) / 4 / | |||
|
|
259 | C DATA IMACH( 7) / 2 / | |||
|
|
260 | C DATA IMACH( 8) / 31 / | |||
|
|
261 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
262 | C DATA IMACH(10) / 2 / | |||
|
|
263 | C DATA IMACH(11) / 24 / | |||
|
|
264 | C DATA IMACH(12) / -127 / | |||
|
|
265 | C DATA IMACH(13) / 127 / | |||
|
|
266 | C DATA IMACH(14) / 53 / | |||
|
|
267 | C DATA IMACH(15) / -1023 / | |||
|
|
268 | C DATA IMACH(16) / 1023 / | |||
|
|
269 | C | |||
|
|
270 | C MACHINE CONSTANTS FOR THE CONVEX | |||
|
|
271 | C USING THE -fi COMPILER OPTION | |||
|
|
272 | C | |||
|
|
273 | C DATA IMACH( 1) / 5 / | |||
|
|
274 | C DATA IMACH( 2) / 6 / | |||
|
|
275 | C DATA IMACH( 3) / 7 / | |||
|
|
276 | C DATA IMACH( 4) / 6 / | |||
|
|
277 | C DATA IMACH( 5) / 32 / | |||
|
|
278 | C DATA IMACH( 6) / 4 / | |||
|
|
279 | C DATA IMACH( 7) / 2 / | |||
|
|
280 | C DATA IMACH( 8) / 31 / | |||
|
|
281 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
282 | C DATA IMACH(10) / 2 / | |||
|
|
283 | C DATA IMACH(11) / 24 / | |||
|
|
284 | C DATA IMACH(12) / -125 / | |||
|
|
285 | C DATA IMACH(13) / 128 / | |||
|
|
286 | C DATA IMACH(14) / 53 / | |||
|
|
287 | C DATA IMACH(15) / -1021 / | |||
|
|
288 | C DATA IMACH(16) / 1024 / | |||
|
|
289 | C | |||
|
|
290 | C MACHINE CONSTANTS FOR THE CONVEX | |||
|
|
291 | C USING THE -p8 COMPILER OPTION | |||
|
|
292 | C | |||
|
|
293 | C DATA IMACH( 1) / 5 / | |||
|
|
294 | C DATA IMACH( 2) / 6 / | |||
|
|
295 | C DATA IMACH( 3) / 7 / | |||
|
|
296 | C DATA IMACH( 4) / 6 / | |||
|
|
297 | C DATA IMACH( 5) / 64 / | |||
|
|
298 | C DATA IMACH( 6) / 4 / | |||
|
|
299 | C DATA IMACH( 7) / 2 / | |||
|
|
300 | C DATA IMACH( 8) / 63 / | |||
|
|
301 | C DATA IMACH( 9) / 9223372036854775807 / | |||
|
|
302 | C DATA IMACH(10) / 2 / | |||
|
|
303 | C DATA IMACH(11) / 53 / | |||
|
|
304 | C DATA IMACH(12) / -1023 / | |||
|
|
305 | C DATA IMACH(13) / 1023 / | |||
|
|
306 | C DATA IMACH(14) / 113 / | |||
|
|
307 | C DATA IMACH(15) / -16383 / | |||
|
|
308 | C DATA IMACH(16) / 16383 / | |||
|
|
309 | C | |||
|
|
310 | C MACHINE CONSTANTS FOR THE CONVEX | |||
|
|
311 | C USING THE -pd8 COMPILER OPTION | |||
|
|
312 | C | |||
|
|
313 | C DATA IMACH( 1) / 5 / | |||
|
|
314 | C DATA IMACH( 2) / 6 / | |||
|
|
315 | C DATA IMACH( 3) / 7 / | |||
|
|
316 | C DATA IMACH( 4) / 6 / | |||
|
|
317 | C DATA IMACH( 5) / 64 / | |||
|
|
318 | C DATA IMACH( 6) / 4 / | |||
|
|
319 | C DATA IMACH( 7) / 2 / | |||
|
|
320 | C DATA IMACH( 8) / 63 / | |||
|
|
321 | C DATA IMACH( 9) / 9223372036854775807 / | |||
|
|
322 | C DATA IMACH(10) / 2 / | |||
|
|
323 | C DATA IMACH(11) / 53 / | |||
|
|
324 | C DATA IMACH(12) / -1023 / | |||
|
|
325 | C DATA IMACH(13) / 1023 / | |||
|
|
326 | C DATA IMACH(14) / 53 / | |||
|
|
327 | C DATA IMACH(15) / -1023 / | |||
|
|
328 | C DATA IMACH(16) / 1023 / | |||
|
|
329 | C | |||
|
|
330 | C MACHINE CONSTANTS FOR THE CRAY | |||
|
|
331 | C USING THE 46 BIT INTEGER COMPILER OPTION | |||
|
|
332 | C | |||
|
|
333 | C DATA IMACH( 1) / 100 / | |||
|
|
334 | C DATA IMACH( 2) / 101 / | |||
|
|
335 | C DATA IMACH( 3) / 102 / | |||
|
|
336 | C DATA IMACH( 4) / 101 / | |||
|
|
337 | C DATA IMACH( 5) / 64 / | |||
|
|
338 | C DATA IMACH( 6) / 8 / | |||
|
|
339 | C DATA IMACH( 7) / 2 / | |||
|
|
340 | C DATA IMACH( 8) / 46 / | |||
|
|
341 | C DATA IMACH( 9) / 1777777777777777B / | |||
|
|
342 | C DATA IMACH(10) / 2 / | |||
|
|
343 | C DATA IMACH(11) / 47 / | |||
|
|
344 | C DATA IMACH(12) / -8189 / | |||
|
|
345 | C DATA IMACH(13) / 8190 / | |||
|
|
346 | C DATA IMACH(14) / 94 / | |||
|
|
347 | C DATA IMACH(15) / -8099 / | |||
|
|
348 | C DATA IMACH(16) / 8190 / | |||
|
|
349 | C | |||
|
|
350 | C MACHINE CONSTANTS FOR THE CRAY | |||
|
|
351 | C USING THE 64 BIT INTEGER COMPILER OPTION | |||
|
|
352 | C | |||
|
|
353 | C DATA IMACH( 1) / 100 / | |||
|
|
354 | C DATA IMACH( 2) / 101 / | |||
|
|
355 | C DATA IMACH( 3) / 102 / | |||
|
|
356 | C DATA IMACH( 4) / 101 / | |||
|
|
357 | C DATA IMACH( 5) / 64 / | |||
|
|
358 | C DATA IMACH( 6) / 8 / | |||
|
|
359 | C DATA IMACH( 7) / 2 / | |||
|
|
360 | C DATA IMACH( 8) / 63 / | |||
|
|
361 | C DATA IMACH( 9) / 777777777777777777777B / | |||
|
|
362 | C DATA IMACH(10) / 2 / | |||
|
|
363 | C DATA IMACH(11) / 47 / | |||
|
|
364 | C DATA IMACH(12) / -8189 / | |||
|
|
365 | C DATA IMACH(13) / 8190 / | |||
|
|
366 | C DATA IMACH(14) / 94 / | |||
|
|
367 | C DATA IMACH(15) / -8099 / | |||
|
|
368 | C DATA IMACH(16) / 8190 / | |||
|
|
369 | C | |||
|
|
370 | C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 | |||
|
|
371 | C | |||
|
|
372 | C DATA IMACH( 1) / 11 / | |||
|
|
373 | C DATA IMACH( 2) / 12 / | |||
|
|
374 | C DATA IMACH( 3) / 8 / | |||
|
|
375 | C DATA IMACH( 4) / 10 / | |||
|
|
376 | C DATA IMACH( 5) / 16 / | |||
|
|
377 | C DATA IMACH( 6) / 2 / | |||
|
|
378 | C DATA IMACH( 7) / 2 / | |||
|
|
379 | C DATA IMACH( 8) / 15 / | |||
|
|
380 | C DATA IMACH( 9) / 32767 / | |||
|
|
381 | C DATA IMACH(10) / 16 / | |||
|
|
382 | C DATA IMACH(11) / 6 / | |||
|
|
383 | C DATA IMACH(12) / -64 / | |||
|
|
384 | C DATA IMACH(13) / 63 / | |||
|
|
385 | C DATA IMACH(14) / 14 / | |||
|
|
386 | C DATA IMACH(15) / -64 / | |||
|
|
387 | C DATA IMACH(16) / 63 / | |||
|
|
388 | C | |||
|
|
389 | C MACHINE CONSTANTS FOR THE DEC ALPHA | |||
|
|
390 | C USING G_FLOAT | |||
|
|
391 | C | |||
|
|
392 | C DATA IMACH( 1) / 5 / | |||
|
|
393 | C DATA IMACH( 2) / 6 / | |||
|
|
394 | C DATA IMACH( 3) / 5 / | |||
|
|
395 | C DATA IMACH( 4) / 6 / | |||
|
|
396 | C DATA IMACH( 5) / 32 / | |||
|
|
397 | C DATA IMACH( 6) / 4 / | |||
|
|
398 | C DATA IMACH( 7) / 2 / | |||
|
|
399 | C DATA IMACH( 8) / 31 / | |||
|
|
400 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
401 | C DATA IMACH(10) / 2 / | |||
|
|
402 | C DATA IMACH(11) / 24 / | |||
|
|
403 | C DATA IMACH(12) / -127 / | |||
|
|
404 | C DATA IMACH(13) / 127 / | |||
|
|
405 | C DATA IMACH(14) / 53 / | |||
|
|
406 | C DATA IMACH(15) / -1023 / | |||
|
|
407 | C DATA IMACH(16) / 1023 / | |||
|
|
408 | C | |||
|
|
409 | C MACHINE CONSTANTS FOR THE DEC ALPHA | |||
|
|
410 | C USING IEEE_FLOAT | |||
|
|
411 | C | |||
|
|
412 | C DATA IMACH( 1) / 5 / | |||
|
|
413 | C DATA IMACH( 2) / 6 / | |||
|
|
414 | C DATA IMACH( 3) / 6 / | |||
|
|
415 | C DATA IMACH( 4) / 6 / | |||
|
|
416 | C DATA IMACH( 5) / 32 / | |||
|
|
417 | C DATA IMACH( 6) / 4 / | |||
|
|
418 | C DATA IMACH( 7) / 2 / | |||
|
|
419 | C DATA IMACH( 8) / 31 / | |||
|
|
420 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
421 | C DATA IMACH(10) / 2 / | |||
|
|
422 | C DATA IMACH(11) / 24 / | |||
|
|
423 | C DATA IMACH(12) / -125 / | |||
|
|
424 | C DATA IMACH(13) / 128 / | |||
|
|
425 | C DATA IMACH(14) / 53 / | |||
|
|
426 | C DATA IMACH(15) / -1021 / | |||
|
|
427 | C DATA IMACH(16) / 1024 / | |||
|
|
428 | C | |||
|
|
429 | C MACHINE CONSTANTS FOR THE DEC RISC | |||
|
|
430 | C | |||
|
|
431 | C DATA IMACH( 1) / 5 / | |||
|
|
432 | C DATA IMACH( 2) / 6 / | |||
|
|
433 | C DATA IMACH( 3) / 6 / | |||
|
|
434 | C DATA IMACH( 4) / 6 / | |||
|
|
435 | C DATA IMACH( 5) / 32 / | |||
|
|
436 | C DATA IMACH( 6) / 4 / | |||
|
|
437 | C DATA IMACH( 7) / 2 / | |||
|
|
438 | C DATA IMACH( 8) / 31 / | |||
|
|
439 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
440 | C DATA IMACH(10) / 2 / | |||
|
|
441 | C DATA IMACH(11) / 24 / | |||
|
|
442 | C DATA IMACH(12) / -125 / | |||
|
|
443 | C DATA IMACH(13) / 128 / | |||
|
|
444 | C DATA IMACH(14) / 53 / | |||
|
|
445 | C DATA IMACH(15) / -1021 / | |||
|
|
446 | C DATA IMACH(16) / 1024 / | |||
|
|
447 | C | |||
|
|
448 | C MACHINE CONSTANTS FOR THE DEC VAX | |||
|
|
449 | C USING D_FLOATING | |||
|
|
450 | C | |||
|
|
451 | C DATA IMACH( 1) / 5 / | |||
|
|
452 | C DATA IMACH( 2) / 6 / | |||
|
|
453 | C DATA IMACH( 3) / 5 / | |||
|
|
454 | C DATA IMACH( 4) / 6 / | |||
|
|
455 | C DATA IMACH( 5) / 32 / | |||
|
|
456 | C DATA IMACH( 6) / 4 / | |||
|
|
457 | C DATA IMACH( 7) / 2 / | |||
|
|
458 | C DATA IMACH( 8) / 31 / | |||
|
|
459 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
460 | C DATA IMACH(10) / 2 / | |||
|
|
461 | C DATA IMACH(11) / 24 / | |||
|
|
462 | C DATA IMACH(12) / -127 / | |||
|
|
463 | C DATA IMACH(13) / 127 / | |||
|
|
464 | C DATA IMACH(14) / 56 / | |||
|
|
465 | C DATA IMACH(15) / -127 / | |||
|
|
466 | C DATA IMACH(16) / 127 / | |||
|
|
467 | C | |||
|
|
468 | C MACHINE CONSTANTS FOR THE DEC VAX | |||
|
|
469 | C USING G_FLOATING | |||
|
|
470 | C | |||
|
|
471 | C DATA IMACH( 1) / 5 / | |||
|
|
472 | C DATA IMACH( 2) / 6 / | |||
|
|
473 | C DATA IMACH( 3) / 5 / | |||
|
|
474 | C DATA IMACH( 4) / 6 / | |||
|
|
475 | C DATA IMACH( 5) / 32 / | |||
|
|
476 | C DATA IMACH( 6) / 4 / | |||
|
|
477 | C DATA IMACH( 7) / 2 / | |||
|
|
478 | C DATA IMACH( 8) / 31 / | |||
|
|
479 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
480 | C DATA IMACH(10) / 2 / | |||
|
|
481 | C DATA IMACH(11) / 24 / | |||
|
|
482 | C DATA IMACH(12) / -127 / | |||
|
|
483 | C DATA IMACH(13) / 127 / | |||
|
|
484 | C DATA IMACH(14) / 53 / | |||
|
|
485 | C DATA IMACH(15) / -1023 / | |||
|
|
486 | C DATA IMACH(16) / 1023 / | |||
|
|
487 | C | |||
|
|
488 | C MACHINE CONSTANTS FOR THE ELXSI 6400 | |||
|
|
489 | C | |||
|
|
490 | C DATA IMACH( 1) / 5 / | |||
|
|
491 | C DATA IMACH( 2) / 6 / | |||
|
|
492 | C DATA IMACH( 3) / 6 / | |||
|
|
493 | C DATA IMACH( 4) / 6 / | |||
|
|
494 | C DATA IMACH( 5) / 32 / | |||
|
|
495 | C DATA IMACH( 6) / 4 / | |||
|
|
496 | C DATA IMACH( 7) / 2 / | |||
|
|
497 | C DATA IMACH( 8) / 32 / | |||
|
|
498 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
499 | C DATA IMACH(10) / 2 / | |||
|
|
500 | C DATA IMACH(11) / 24 / | |||
|
|
501 | C DATA IMACH(12) / -126 / | |||
|
|
502 | C DATA IMACH(13) / 127 / | |||
|
|
503 | C DATA IMACH(14) / 53 / | |||
|
|
504 | C DATA IMACH(15) / -1022 / | |||
|
|
505 | C DATA IMACH(16) / 1023 / | |||
|
|
506 | C | |||
|
|
507 | C MACHINE CONSTANTS FOR THE HARRIS 220 | |||
|
|
508 | C | |||
|
|
509 | C DATA IMACH( 1) / 5 / | |||
|
|
510 | C DATA IMACH( 2) / 6 / | |||
|
|
511 | C DATA IMACH( 3) / 0 / | |||
|
|
512 | C DATA IMACH( 4) / 6 / | |||
|
|
513 | C DATA IMACH( 5) / 24 / | |||
|
|
514 | C DATA IMACH( 6) / 3 / | |||
|
|
515 | C DATA IMACH( 7) / 2 / | |||
|
|
516 | C DATA IMACH( 8) / 23 / | |||
|
|
517 | C DATA IMACH( 9) / 8388607 / | |||
|
|
518 | C DATA IMACH(10) / 2 / | |||
|
|
519 | C DATA IMACH(11) / 23 / | |||
|
|
520 | C DATA IMACH(12) / -127 / | |||
|
|
521 | C DATA IMACH(13) / 127 / | |||
|
|
522 | C DATA IMACH(14) / 38 / | |||
|
|
523 | C DATA IMACH(15) / -127 / | |||
|
|
524 | C DATA IMACH(16) / 127 / | |||
|
|
525 | C | |||
|
|
526 | C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES | |||
|
|
527 | C | |||
|
|
528 | C DATA IMACH( 1) / 5 / | |||
|
|
529 | C DATA IMACH( 2) / 6 / | |||
|
|
530 | C DATA IMACH( 3) / 43 / | |||
|
|
531 | C DATA IMACH( 4) / 6 / | |||
|
|
532 | C DATA IMACH( 5) / 36 / | |||
|
|
533 | C DATA IMACH( 6) / 6 / | |||
|
|
534 | C DATA IMACH( 7) / 2 / | |||
|
|
535 | C DATA IMACH( 8) / 35 / | |||
|
|
536 | C DATA IMACH( 9) / O377777777777 / | |||
|
|
537 | C DATA IMACH(10) / 2 / | |||
|
|
538 | C DATA IMACH(11) / 27 / | |||
|
|
539 | C DATA IMACH(12) / -127 / | |||
|
|
540 | C DATA IMACH(13) / 127 / | |||
|
|
541 | C DATA IMACH(14) / 63 / | |||
|
|
542 | C DATA IMACH(15) / -127 / | |||
|
|
543 | C DATA IMACH(16) / 127 / | |||
|
|
544 | C | |||
|
|
545 | C MACHINE CONSTANTS FOR THE HP 730 | |||
|
|
546 | C | |||
|
|
547 | C DATA IMACH( 1) / 5 / | |||
|
|
548 | C DATA IMACH( 2) / 6 / | |||
|
|
549 | C DATA IMACH( 3) / 6 / | |||
|
|
550 | C DATA IMACH( 4) / 6 / | |||
|
|
551 | C DATA IMACH( 5) / 32 / | |||
|
|
552 | C DATA IMACH( 6) / 4 / | |||
|
|
553 | C DATA IMACH( 7) / 2 / | |||
|
|
554 | C DATA IMACH( 8) / 31 / | |||
|
|
555 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
556 | C DATA IMACH(10) / 2 / | |||
|
|
557 | C DATA IMACH(11) / 24 / | |||
|
|
558 | C DATA IMACH(12) / -125 / | |||
|
|
559 | C DATA IMACH(13) / 128 / | |||
|
|
560 | C DATA IMACH(14) / 53 / | |||
|
|
561 | C DATA IMACH(15) / -1021 / | |||
|
|
562 | C DATA IMACH(16) / 1024 / | |||
|
|
563 | C | |||
|
|
564 | C MACHINE CONSTANTS FOR THE HP 2100 | |||
|
|
565 | C 3 WORD DOUBLE PRECISION OPTION WITH FTN4 | |||
|
|
566 | C | |||
|
|
567 | C DATA IMACH( 1) / 5 / | |||
|
|
568 | C DATA IMACH( 2) / 6 / | |||
|
|
569 | C DATA IMACH( 3) / 4 / | |||
|
|
570 | C DATA IMACH( 4) / 1 / | |||
|
|
571 | C DATA IMACH( 5) / 16 / | |||
|
|
572 | C DATA IMACH( 6) / 2 / | |||
|
|
573 | C DATA IMACH( 7) / 2 / | |||
|
|
574 | C DATA IMACH( 8) / 15 / | |||
|
|
575 | C DATA IMACH( 9) / 32767 / | |||
|
|
576 | C DATA IMACH(10) / 2 / | |||
|
|
577 | C DATA IMACH(11) / 23 / | |||
|
|
578 | C DATA IMACH(12) / -128 / | |||
|
|
579 | C DATA IMACH(13) / 127 / | |||
|
|
580 | C DATA IMACH(14) / 39 / | |||
|
|
581 | C DATA IMACH(15) / -128 / | |||
|
|
582 | C DATA IMACH(16) / 127 / | |||
|
|
583 | C | |||
|
|
584 | C MACHINE CONSTANTS FOR THE HP 2100 | |||
|
|
585 | C 4 WORD DOUBLE PRECISION OPTION WITH FTN4 | |||
|
|
586 | C | |||
|
|
587 | C DATA IMACH( 1) / 5 / | |||
|
|
588 | C DATA IMACH( 2) / 6 / | |||
|
|
589 | C DATA IMACH( 3) / 4 / | |||
|
|
590 | C DATA IMACH( 4) / 1 / | |||
|
|
591 | C DATA IMACH( 5) / 16 / | |||
|
|
592 | C DATA IMACH( 6) / 2 / | |||
|
|
593 | C DATA IMACH( 7) / 2 / | |||
|
|
594 | C DATA IMACH( 8) / 15 / | |||
|
|
595 | C DATA IMACH( 9) / 32767 / | |||
|
|
596 | C DATA IMACH(10) / 2 / | |||
|
|
597 | C DATA IMACH(11) / 23 / | |||
|
|
598 | C DATA IMACH(12) / -128 / | |||
|
|
599 | C DATA IMACH(13) / 127 / | |||
|
|
600 | C DATA IMACH(14) / 55 / | |||
|
|
601 | C DATA IMACH(15) / -128 / | |||
|
|
602 | C DATA IMACH(16) / 127 / | |||
|
|
603 | C | |||
|
|
604 | C MACHINE CONSTANTS FOR THE HP 9000 | |||
|
|
605 | C | |||
|
|
606 | C DATA IMACH( 1) / 5 / | |||
|
|
607 | C DATA IMACH( 2) / 6 / | |||
|
|
608 | C DATA IMACH( 3) / 6 / | |||
|
|
609 | C DATA IMACH( 4) / 7 / | |||
|
|
610 | C DATA IMACH( 5) / 32 / | |||
|
|
611 | C DATA IMACH( 6) / 4 / | |||
|
|
612 | C DATA IMACH( 7) / 2 / | |||
|
|
613 | C DATA IMACH( 8) / 32 / | |||
|
|
614 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
615 | C DATA IMACH(10) / 2 / | |||
|
|
616 | C DATA IMACH(11) / 24 / | |||
|
|
617 | C DATA IMACH(12) / -126 / | |||
|
|
618 | C DATA IMACH(13) / 127 / | |||
|
|
619 | C DATA IMACH(14) / 53 / | |||
|
|
620 | C DATA IMACH(15) / -1015 / | |||
|
|
621 | C DATA IMACH(16) / 1017 / | |||
|
|
622 | C | |||
|
|
623 | C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, | |||
|
|
624 | C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND | |||
|
|
625 | C THE PERKIN ELMER (INTERDATA) 7/32. | |||
|
|
626 | C | |||
|
|
627 | C DATA IMACH( 1) / 5 / | |||
|
|
628 | C DATA IMACH( 2) / 6 / | |||
|
|
629 | C DATA IMACH( 3) / 7 / | |||
|
|
630 | C DATA IMACH( 4) / 6 / | |||
|
|
631 | C DATA IMACH( 5) / 32 / | |||
|
|
632 | C DATA IMACH( 6) / 4 / | |||
|
|
633 | C DATA IMACH( 7) / 2 / | |||
|
|
634 | C DATA IMACH( 8) / 31 / | |||
|
|
635 | C DATA IMACH( 9) / Z7FFFFFFF / | |||
|
|
636 | C DATA IMACH(10) / 16 / | |||
|
|
637 | C DATA IMACH(11) / 6 / | |||
|
|
638 | C DATA IMACH(12) / -64 / | |||
|
|
639 | C DATA IMACH(13) / 63 / | |||
|
|
640 | C DATA IMACH(14) / 14 / | |||
|
|
641 | C DATA IMACH(15) / -64 / | |||
|
|
642 | C DATA IMACH(16) / 63 / | |||
|
|
643 | C | |||
|
|
644 | C MACHINE CONSTANTS FOR THE IBM PC | |||
|
|
645 | C | |||
|
|
646 | C DATA IMACH( 1) / 5 / | |||
|
|
647 | C DATA IMACH( 2) / 6 / | |||
|
|
648 | C DATA IMACH( 3) / 0 / | |||
|
|
649 | C DATA IMACH( 4) / 0 / | |||
|
|
650 | C DATA IMACH( 5) / 32 / | |||
|
|
651 | C DATA IMACH( 6) / 4 / | |||
|
|
652 | C DATA IMACH( 7) / 2 / | |||
|
|
653 | C DATA IMACH( 8) / 31 / | |||
|
|
654 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
655 | C DATA IMACH(10) / 2 / | |||
|
|
656 | C DATA IMACH(11) / 24 / | |||
|
|
657 | C DATA IMACH(12) / -125 / | |||
|
|
658 | C DATA IMACH(13) / 127 / | |||
|
|
659 | C DATA IMACH(14) / 53 / | |||
|
|
660 | C DATA IMACH(15) / -1021 / | |||
|
|
661 | C DATA IMACH(16) / 1023 / | |||
|
|
662 | C | |||
|
|
663 | C MACHINE CONSTANTS FOR THE IBM RS 6000 | |||
|
|
664 | C | |||
|
|
665 | C DATA IMACH( 1) / 5 / | |||
|
|
666 | C DATA IMACH( 2) / 6 / | |||
|
|
667 | C DATA IMACH( 3) / 6 / | |||
|
|
668 | C DATA IMACH( 4) / 0 / | |||
|
|
669 | C DATA IMACH( 5) / 32 / | |||
|
|
670 | C DATA IMACH( 6) / 4 / | |||
|
|
671 | C DATA IMACH( 7) / 2 / | |||
|
|
672 | C DATA IMACH( 8) / 31 / | |||
|
|
673 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
674 | C DATA IMACH(10) / 2 / | |||
|
|
675 | C DATA IMACH(11) / 24 / | |||
|
|
676 | C DATA IMACH(12) / -125 / | |||
|
|
677 | C DATA IMACH(13) / 128 / | |||
|
|
678 | C DATA IMACH(14) / 53 / | |||
|
|
679 | C DATA IMACH(15) / -1021 / | |||
|
|
680 | C DATA IMACH(16) / 1024 / | |||
|
|
681 | C | |||
|
|
682 | C MACHINE CONSTANTS FOR THE INTEL i860 | |||
|
|
683 | C | |||
|
|
684 | C DATA IMACH( 1) / 5 / | |||
|
|
685 | C DATA IMACH( 2) / 6 / | |||
|
|
686 | C DATA IMACH( 3) / 6 / | |||
|
|
687 | C DATA IMACH( 4) / 6 / | |||
|
|
688 | C DATA IMACH( 5) / 32 / | |||
|
|
689 | C DATA IMACH( 6) / 4 / | |||
|
|
690 | C DATA IMACH( 7) / 2 / | |||
|
|
691 | C DATA IMACH( 8) / 31 / | |||
|
|
692 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
693 | C DATA IMACH(10) / 2 / | |||
|
|
694 | C DATA IMACH(11) / 24 / | |||
|
|
695 | C DATA IMACH(12) / -125 / | |||
|
|
696 | C DATA IMACH(13) / 128 / | |||
|
|
697 | C DATA IMACH(14) / 53 / | |||
|
|
698 | C DATA IMACH(15) / -1021 / | |||
|
|
699 | C DATA IMACH(16) / 1024 / | |||
|
|
700 | C | |||
|
|
701 | C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR) | |||
|
|
702 | C | |||
|
|
703 | C DATA IMACH( 1) / 5 / | |||
|
|
704 | C DATA IMACH( 2) / 6 / | |||
|
|
705 | C DATA IMACH( 3) / 5 / | |||
|
|
706 | C DATA IMACH( 4) / 6 / | |||
|
|
707 | C DATA IMACH( 5) / 36 / | |||
|
|
708 | C DATA IMACH( 6) / 5 / | |||
|
|
709 | C DATA IMACH( 7) / 2 / | |||
|
|
710 | C DATA IMACH( 8) / 35 / | |||
|
|
711 | C DATA IMACH( 9) / "377777777777 / | |||
|
|
712 | C DATA IMACH(10) / 2 / | |||
|
|
713 | C DATA IMACH(11) / 27 / | |||
|
|
714 | C DATA IMACH(12) / -128 / | |||
|
|
715 | C DATA IMACH(13) / 127 / | |||
|
|
716 | C DATA IMACH(14) / 54 / | |||
|
|
717 | C DATA IMACH(15) / -101 / | |||
|
|
718 | C DATA IMACH(16) / 127 / | |||
|
|
719 | C | |||
|
|
720 | C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR) | |||
|
|
721 | C | |||
|
|
722 | C DATA IMACH( 1) / 5 / | |||
|
|
723 | C DATA IMACH( 2) / 6 / | |||
|
|
724 | C DATA IMACH( 3) / 5 / | |||
|
|
725 | C DATA IMACH( 4) / 6 / | |||
|
|
726 | C DATA IMACH( 5) / 36 / | |||
|
|
727 | C DATA IMACH( 6) / 5 / | |||
|
|
728 | C DATA IMACH( 7) / 2 / | |||
|
|
729 | C DATA IMACH( 8) / 35 / | |||
|
|
730 | C DATA IMACH( 9) / "377777777777 / | |||
|
|
731 | C DATA IMACH(10) / 2 / | |||
|
|
732 | C DATA IMACH(11) / 27 / | |||
|
|
733 | C DATA IMACH(12) / -128 / | |||
|
|
734 | C DATA IMACH(13) / 127 / | |||
|
|
735 | C DATA IMACH(14) / 62 / | |||
|
|
736 | C DATA IMACH(15) / -128 / | |||
|
|
737 | C DATA IMACH(16) / 127 / | |||
|
|
738 | C | |||
|
|
739 | C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING | |||
|
|
740 | C 32-BIT INTEGER ARITHMETIC. | |||
|
|
741 | C | |||
|
|
742 | C DATA IMACH( 1) / 5 / | |||
|
|
743 | C DATA IMACH( 2) / 6 / | |||
|
|
744 | C DATA IMACH( 3) / 5 / | |||
|
|
745 | C DATA IMACH( 4) / 6 / | |||
|
|
746 | C DATA IMACH( 5) / 32 / | |||
|
|
747 | C DATA IMACH( 6) / 4 / | |||
|
|
748 | C DATA IMACH( 7) / 2 / | |||
|
|
749 | C DATA IMACH( 8) / 31 / | |||
|
|
750 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
751 | C DATA IMACH(10) / 2 / | |||
|
|
752 | C DATA IMACH(11) / 24 / | |||
|
|
753 | C DATA IMACH(12) / -127 / | |||
|
|
754 | C DATA IMACH(13) / 127 / | |||
|
|
755 | C DATA IMACH(14) / 56 / | |||
|
|
756 | C DATA IMACH(15) / -127 / | |||
|
|
757 | C DATA IMACH(16) / 127 / | |||
|
|
758 | C | |||
|
|
759 | C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING | |||
|
|
760 | C 16-BIT INTEGER ARITHMETIC. | |||
|
|
761 | C | |||
|
|
762 | C DATA IMACH( 1) / 5 / | |||
|
|
763 | C DATA IMACH( 2) / 6 / | |||
|
|
764 | C DATA IMACH( 3) / 5 / | |||
|
|
765 | C DATA IMACH( 4) / 6 / | |||
|
|
766 | C DATA IMACH( 5) / 16 / | |||
|
|
767 | C DATA IMACH( 6) / 2 / | |||
|
|
768 | C DATA IMACH( 7) / 2 / | |||
|
|
769 | C DATA IMACH( 8) / 15 / | |||
|
|
770 | C DATA IMACH( 9) / 32767 / | |||
|
|
771 | C DATA IMACH(10) / 2 / | |||
|
|
772 | C DATA IMACH(11) / 24 / | |||
|
|
773 | C DATA IMACH(12) / -127 / | |||
|
|
774 | C DATA IMACH(13) / 127 / | |||
|
|
775 | C DATA IMACH(14) / 56 / | |||
|
|
776 | C DATA IMACH(15) / -127 / | |||
|
|
777 | C DATA IMACH(16) / 127 / | |||
|
|
778 | C | |||
|
|
779 | C MACHINE CONSTANTS FOR THE SILICON GRAPHICS | |||
|
|
780 | C | |||
|
|
781 | C DATA IMACH( 1) / 5 / | |||
|
|
782 | C DATA IMACH( 2) / 6 / | |||
|
|
783 | C DATA IMACH( 3) / 6 / | |||
|
|
784 | C DATA IMACH( 4) / 6 / | |||
|
|
785 | C DATA IMACH( 5) / 32 / | |||
|
|
786 | C DATA IMACH( 6) / 4 / | |||
|
|
787 | C DATA IMACH( 7) / 2 / | |||
|
|
788 | C DATA IMACH( 8) / 31 / | |||
|
|
789 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
790 | C DATA IMACH(10) / 2 / | |||
|
|
791 | C DATA IMACH(11) / 24 / | |||
|
|
792 | C DATA IMACH(12) / -125 / | |||
|
|
793 | C DATA IMACH(13) / 128 / | |||
|
|
794 | C DATA IMACH(14) / 53 / | |||
|
|
795 | C DATA IMACH(15) / -1021 / | |||
|
|
796 | C DATA IMACH(16) / 1024 / | |||
|
|
797 | C | |||
|
|
798 | C MACHINE CONSTANTS FOR THE SUN | |||
|
|
799 | C | |||
|
|
800 | C DATA IMACH( 1) / 5 / | |||
|
|
801 | C DATA IMACH( 2) / 6 / | |||
|
|
802 | C DATA IMACH( 3) / 6 / | |||
|
|
803 | C DATA IMACH( 4) / 6 / | |||
|
|
804 | C DATA IMACH( 5) / 32 / | |||
|
|
805 | C DATA IMACH( 6) / 4 / | |||
|
|
806 | C DATA IMACH( 7) / 2 / | |||
|
|
807 | C DATA IMACH( 8) / 31 / | |||
|
|
808 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
809 | C DATA IMACH(10) / 2 / | |||
|
|
810 | C DATA IMACH(11) / 24 / | |||
|
|
811 | C DATA IMACH(12) / -125 / | |||
|
|
812 | C DATA IMACH(13) / 128 / | |||
|
|
813 | C DATA IMACH(14) / 53 / | |||
|
|
814 | C DATA IMACH(15) / -1021 / | |||
|
|
815 | C DATA IMACH(16) / 1024 / | |||
|
|
816 | C | |||
|
|
817 | C MACHINE CONSTANTS FOR THE SUN | |||
|
|
818 | C USING THE -r8 COMPILER OPTION | |||
|
|
819 | C | |||
|
|
820 | C DATA IMACH( 1) / 5 / | |||
|
|
821 | C DATA IMACH( 2) / 6 / | |||
|
|
822 | C DATA IMACH( 3) / 6 / | |||
|
|
823 | C DATA IMACH( 4) / 6 / | |||
|
|
824 | C DATA IMACH( 5) / 32 / | |||
|
|
825 | C DATA IMACH( 6) / 4 / | |||
|
|
826 | C DATA IMACH( 7) / 2 / | |||
|
|
827 | C DATA IMACH( 8) / 31 / | |||
|
|
828 | C DATA IMACH( 9) / 2147483647 / | |||
|
|
829 | C DATA IMACH(10) / 2 / | |||
|
|
830 | C DATA IMACH(11) / 53 / | |||
|
|
831 | C DATA IMACH(12) / -1021 / | |||
|
|
832 | C DATA IMACH(13) / 1024 / | |||
|
|
833 | C DATA IMACH(14) / 113 / | |||
|
|
834 | C DATA IMACH(15) / -16381 / | |||
|
|
835 | C DATA IMACH(16) / 16384 / | |||
|
|
836 | C | |||
|
|
837 | C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER | |||
|
|
838 | C | |||
|
|
839 | C DATA IMACH( 1) / 5 / | |||
|
|
840 | C DATA IMACH( 2) / 6 / | |||
|
|
841 | C DATA IMACH( 3) / 1 / | |||
|
|
842 | C DATA IMACH( 4) / 6 / | |||
|
|
843 | C DATA IMACH( 5) / 36 / | |||
|
|
844 | C DATA IMACH( 6) / 4 / | |||
|
|
845 | C DATA IMACH( 7) / 2 / | |||
|
|
846 | C DATA IMACH( 8) / 35 / | |||
|
|
847 | C DATA IMACH( 9) / O377777777777 / | |||
|
|
848 | C DATA IMACH(10) / 2 / | |||
|
|
849 | C DATA IMACH(11) / 27 / | |||
|
|
850 | C DATA IMACH(12) / -128 / | |||
|
|
851 | C DATA IMACH(13) / 127 / | |||
|
|
852 | C DATA IMACH(14) / 60 / | |||
|
|
853 | C DATA IMACH(15) / -1024 / | |||
|
|
854 | C DATA IMACH(16) / 1023 / | |||
|
|
855 | C | |||
|
|
856 | C MACHINE CONSTANTS FOR THE Z80 MICROPROCESSOR | |||
|
|
857 | C | |||
|
|
858 | C DATA IMACH( 1) / 1 / | |||
|
|
859 | C DATA IMACH( 2) / 1 / | |||
|
|
860 | C DATA IMACH( 3) / 0 / | |||
|
|
861 | C DATA IMACH( 4) / 1 / | |||
|
|
862 | C DATA IMACH( 5) / 16 / | |||
|
|
863 | C DATA IMACH( 6) / 2 / | |||
|
|
864 | C DATA IMACH( 7) / 2 / | |||
|
|
865 | C DATA IMACH( 8) / 15 / | |||
|
|
866 | C DATA IMACH( 9) / 32767 / | |||
|
|
867 | C DATA IMACH(10) / 2 / | |||
|
|
868 | C DATA IMACH(11) / 24 / | |||
|
|
869 | C DATA IMACH(12) / -127 / | |||
|
|
870 | C DATA IMACH(13) / 127 / | |||
|
|
871 | C DATA IMACH(14) / 56 / | |||
|
|
872 | C DATA IMACH(15) / -127 / | |||
|
|
873 | C DATA IMACH(16) / 127 / | |||
|
|
874 | C | |||
|
|
875 | C***FIRST EXECUTABLE STATEMENT I1MACH | |||
|
|
876 | IF (I .LT. 1 .OR. I .GT. 16) GO TO 10 | |||
|
|
877 | C | |||
|
|
878 | I1MACH = IMACH(I) | |||
|
|
879 | RETURN | |||
|
|
880 | C | |||
|
|
881 | 10 CONTINUE | |||
|
|
882 | WRITE (UNIT = OUTPUT, FMT = 9000) | |||
|
|
883 | 9000 FORMAT ('1ERROR 1 IN I1MACH - I OUT OF BOUNDS') | |||
|
|
884 | C | |||
|
|
885 | C CALL FDUMP | |||
|
|
886 | C | |||
|
|
887 | STOP | |||
|
|
888 | END | |||
| @@ -0,0 +1,102 | |||||
|
|
1 | subroutine interv ( xt, lxt, x, left, mflag ) | |||
|
|
2 | c from * a practical guide to splines * by C. de Boor | |||
|
|
3 | computes left = max( i : xt(i) .lt. xt(lxt) .and. xt(i) .le. x ) . | |||
|
|
4 | c | |||
|
|
5 | c****** i n p u t ****** | |||
|
|
6 | c xt.....a real sequence, of length lxt , assumed to be nondecreasing | |||
|
|
7 | c lxt.....number of terms in the sequence xt . | |||
|
|
8 | c x.....the point whose location with respect to the sequence xt is | |||
|
|
9 | c to be determined. | |||
|
|
10 | c | |||
|
|
11 | c****** o u t p u t ****** | |||
|
|
12 | c left, mflag.....both integers, whose value is | |||
|
|
13 | c | |||
|
|
14 | c 1 -1 if x .lt. xt(1) | |||
|
|
15 | c i 0 if xt(i) .le. x .lt. xt(i+1) | |||
|
|
16 | c i 0 if xt(i) .lt. x .eq. xt(i+1) .eq. xt(lxt) | |||
|
|
17 | c i 1 if xt(i) .lt. xt(i+1) .eq. xt(lxt) .lt. x | |||
|
|
18 | c | |||
|
|
19 | c In particular, mflag = 0 is the 'usual' case. mflag .ne. 0 | |||
|
|
20 | c indicates that x lies outside the CLOSED interval | |||
|
|
21 | c xt(1) .le. y .le. xt(lxt) . The asymmetric treatment of the | |||
|
|
22 | c intervals is due to the decision to make all pp functions cont- | |||
|
|
23 | c inuous from the right, but, by returning mflag = 0 even if | |||
|
|
24 | C x = xt(lxt), there is the option of having the computed pp function | |||
|
|
25 | c continuous from the left at xt(lxt) . | |||
|
|
26 | c | |||
|
|
27 | c****** m e t h o d ****** | |||
|
|
28 | c The program is designed to be efficient in the common situation that | |||
|
|
29 | c it is called repeatedly, with x taken from an increasing or decrea- | |||
|
|
30 | c sing sequence. This will happen, e.g., when a pp function is to be | |||
|
|
31 | c graphed. The first guess for left is therefore taken to be the val- | |||
|
|
32 | c ue returned at the previous call and stored in the l o c a l varia- | |||
|
|
33 | c ble ilo . A first check ascertains that ilo .lt. lxt (this is nec- | |||
|
|
34 | c essary since the present call may have nothing to do with the previ- | |||
|
|
35 | c ous call). Then, if xt(ilo) .le. x .lt. xt(ilo+1), we set left = | |||
|
|
36 | c ilo and are done after just three comparisons. | |||
|
|
37 | c Otherwise, we repeatedly double the difference istep = ihi - ilo | |||
|
|
38 | c while also moving ilo and ihi in the direction of x , until | |||
|
|
39 | c xt(ilo) .le. x .lt. xt(ihi) , | |||
|
|
40 | c after which we use bisection to get, in addition, ilo+1 = ihi . | |||
|
|
41 | c left = ilo is then returned. | |||
|
|
42 | c | |||
|
|
43 | integer left,lxt,mflag, ihi,ilo,istep,middle | |||
|
|
44 | real x,xt(lxt) | |||
|
|
45 | data ilo /1/ | |||
|
|
46 | save ilo | |||
|
|
47 | ihi = ilo + 1 | |||
|
|
48 | if (ihi .lt. lxt) go to 20 | |||
|
|
49 | if (x .ge. xt(lxt)) go to 110 | |||
|
|
50 | if (lxt .le. 1) go to 90 | |||
|
|
51 | ilo = lxt - 1 | |||
|
|
52 | ihi = lxt | |||
|
|
53 | c | |||
|
|
54 | 20 if (x .ge. xt(ihi)) go to 40 | |||
|
|
55 | if (x .ge. xt(ilo)) go to 100 | |||
|
|
56 | c | |||
|
|
57 | c **** now x .lt. xt(ilo) . decrease ilo to capture x . | |||
|
|
58 | istep = 1 | |||
|
|
59 | 31 ihi = ilo | |||
|
|
60 | ilo = ihi - istep | |||
|
|
61 | if (ilo .le. 1) go to 35 | |||
|
|
62 | if (x .ge. xt(ilo)) go to 50 | |||
|
|
63 | istep = istep*2 | |||
|
|
64 | go to 31 | |||
|
|
65 | 35 ilo = 1 | |||
|
|
66 | if (x .lt. xt(1)) go to 90 | |||
|
|
67 | go to 50 | |||
|
|
68 | c **** now x .ge. xt(ihi) . increase ihi to capture x . | |||
|
|
69 | 40 istep = 1 | |||
|
|
70 | 41 ilo = ihi | |||
|
|
71 | ihi = ilo + istep | |||
|
|
72 | if (ihi .ge. lxt) go to 45 | |||
|
|
73 | if (x .lt. xt(ihi)) go to 50 | |||
|
|
74 | istep = istep*2 | |||
|
|
75 | go to 41 | |||
|
|
76 | 45 if (x .ge. xt(lxt)) go to 110 | |||
|
|
77 | ihi = lxt | |||
|
|
78 | c | |||
|
|
79 | c **** now xt(ilo) .le. x .lt. xt(ihi) . narrow the interval. | |||
|
|
80 | 50 middle = (ilo + ihi)/2 | |||
|
|
81 | if (middle .eq. ilo) go to 100 | |||
|
|
82 | c note. it is assumed that middle = ilo in case ihi = ilo+1 . | |||
|
|
83 | if (x .lt. xt(middle)) go to 53 | |||
|
|
84 | ilo = middle | |||
|
|
85 | go to 50 | |||
|
|
86 | 53 ihi = middle | |||
|
|
87 | go to 50 | |||
|
|
88 | c**** set output and return. | |||
|
|
89 | 90 mflag = -1 | |||
|
|
90 | left = 1 | |||
|
|
91 | return | |||
|
|
92 | 100 mflag = 0 | |||
|
|
93 | left = ilo | |||
|
|
94 | return | |||
|
|
95 | 110 mflag = 1 | |||
|
|
96 | if (x .eq. xt(lxt)) mflag = 0 | |||
|
|
97 | left = lxt | |||
|
|
98 | 111 if (left .eq. 1) return | |||
|
|
99 | left = left - 1 | |||
|
|
100 | if (xt(left) .lt. xt(lxt)) return | |||
|
|
101 | go to 111 | |||
|
|
102 | end | |||
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| This diff has been collapsed as it changes many lines, (555 lines changed) Show them Hide them | |||||
| @@ -0,0 +1,555 | |||||
|
|
1 | subroutine lagp(plag,wl,r0,dr,nl,nrange) | |||
|
|
2 | c | |||
|
|
3 | c predict lagged product matrix using state parameters stored | |||
|
|
4 | c as cubic b-splines | |||
|
|
5 | c read weights for numeric integration from a file | |||
|
|
6 | c | |||
|
|
7 | c faster version - assumes samples taken at half-integer lags, ranges | |||
|
|
8 | c | |||
|
|
9 | include 'fitter.h' | |||
|
|
10 | include 'spline.h' | |||
|
|
11 | include 'bfield.h' | |||
|
|
12 | integer nl,nrange | |||
|
|
13 | real plag(nl,nrange),taus(nl) | |||
|
|
14 | parameter(nw=1000) | |||
|
|
15 | integer ilag(nw) | |||
|
|
16 | real weight(nw),dtau(nw),drange(nw) | |||
|
|
17 | logical first | |||
|
|
18 | real store(2*nl,2*nrange,2) | |||
|
|
19 | data first/.true./ | |||
|
|
20 | c | |||
|
|
21 | ||||
|
|
22 | c write(*,*) "dens_before: ",dens | |||
|
|
23 | c call exit | |||
|
|
24 | c zero out array | |||
|
|
25 | c write(*,*) "Starting lagp" | |||
|
|
26 | do i=1,nrange | |||
|
|
27 | do j=1,nl | |||
|
|
28 | plag(j,i)=0.0 | |||
|
|
29 | end do | |||
|
|
30 | end do | |||
|
|
31 | ||||
|
|
32 | c | |||
|
|
33 | c compute all required acfs | |||
|
|
34 | c | |||
|
|
35 | do i=1,2*nrange | |||
|
|
36 | ii=(i-1)/2+1 | |||
|
|
37 | alt=r0+float(i-1)*dr*0.5 ! half integer ranges | |||
|
|
38 | c write(*,*) "dens_before: ",dens | |||
|
|
39 | c call exit | |||
|
|
40 | c write(*,*) "alt: ",alt | |||
|
|
41 | c write(*,*) "dens: ",dens | |||
|
|
42 | c write(*,*) "te: ",te | |||
|
|
43 | c write(*,*) "ti1: ",ti1 | |||
|
|
44 | c write(*,*) "hf: ",hf | |||
|
|
45 | c write(*,*) "hef: ",hef | |||
|
|
46 | c call exit | |||
|
|
47 | call get_spline(alt,dens,te,ti1,hf,hef) | |||
|
|
48 | c write(*,*) "dens_after: ",dens | |||
|
|
49 | c call exit | |||
|
|
50 | do k=1,nion | |||
|
|
51 | ti(k)=ti1 | |||
|
|
52 | end do | |||
|
|
53 | fi(2)=hf | |||
|
|
54 | fi(3)=hef | |||
|
|
55 | fi(1)=1.0-hf-hef | |||
|
|
56 | ||||
|
|
57 | do j=1,2*nl | |||
|
|
58 | tau=float(j-1)*(dr/1.5e5)*0.5 ! half integer lags | |||
|
|
59 | ||||
|
|
60 | c just consider a single azimuth angle for now | |||
|
|
61 | ||||
|
|
62 | c call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
63 | c & alpha_prof(ii)+1.74e-2,dens,bfld_prof(ii),rho) | |||
|
|
64 | c store(j,i,1)=rho*dens*(100.0/alt)**2 | |||
|
|
65 | ||||
|
|
66 | c call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
67 | c & alpha_prof(ii)-1.74e-2,dens,bfld_prof(ii),rho) | |||
|
|
68 | c store(j,i,2)=rho*dens*(100.0/alt)**2 | |||
|
|
69 | ||||
|
|
70 | call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
71 | & alpha_prof(ii),dens,bfld_prof(ii),rho) | |||
|
|
72 | store(j,i,1)=rho*dens*(100.0/alt)**2 | |||
|
|
73 | c write(*,*) "store", store(j,i,1) | |||
|
|
74 | c call exit | |||
|
|
75 | end do | |||
|
|
76 | end do | |||
|
|
77 | ||||
|
|
78 | c construct lagged products | |||
|
|
79 | c | |||
|
|
80 | c write(*,*) "before weights" | |||
|
|
81 | c write(*,*) first | |||
|
|
82 | c write(*,*) "weight before: ",weight | |||
|
|
83 | if(first) then | |||
|
|
84 | open(unit=25,file='/usr/local/lib/faraday/weights.dat', | |||
|
|
85 | & status='old') | |||
|
|
86 | read (25,*) nwt | |||
|
|
87 | do i=1,nwt | |||
|
|
88 | read(25,*) weight(i),dtau(i),drange(i),ilag(i) | |||
|
|
89 | c write(*,*) "ilag: ",ilag(i) | |||
|
|
90 | end do | |||
|
|
91 | c flush(25) | |||
|
|
92 | close(25) | |||
|
|
93 | c first=.false. | |||
|
|
94 | end if | |||
|
|
95 | ||||
|
|
96 | c write(*,*) "after weights" | |||
|
|
97 | ||||
|
|
98 | c write(*,*) "weight(3): ",weight(3) | |||
|
|
99 | c call exit | |||
|
|
100 | c write(*,*) "nl: ",nl,"nrange: ",nrange,"nwt: ",nwt | |||
|
|
101 | ||||
|
|
102 | do i=1+nl,nrange ! don't worry about redundancy here | |||
|
|
103 | ||||
|
|
104 | do j=1,nwt | |||
|
|
105 | c write(*,*) "j: ",j | |||
|
|
106 | alt=r0+(float(i-1)+drange(j))*dr | |||
|
|
107 | tau=abs(dtau(j)*dr/1.5e5) | |||
|
|
108 | lag=ilag(j)+1 | |||
|
|
109 | c write(*,*) tau | |||
|
|
110 | ||||
|
|
111 | k=1+2.0*(tau/(dr/1.5e5)) | |||
|
|
112 | l=1+2.0*(alt-r0)/dr | |||
|
|
113 | ||||
|
|
114 | do m=1,1 ! 2 | |||
|
|
115 | ||||
|
|
116 | c call exit | |||
|
|
117 | c write(*,*) i | |||
|
|
118 | c call exit | |||
|
|
119 | c if (i .eq. nrange) then | |||
|
|
120 | c if (j .eq. 227) then | |||
|
|
121 | ||||
|
|
122 | c write(*,*) "lag: ",lag | |||
|
|
123 | c write(*,*) "ilag: ",ilag(j) | |||
|
|
124 | c call exit | |||
|
|
125 | c write(*,*) "plag: ",plag(lag,i) | |||
|
|
126 | c write(*,*) "weight: ",weight | |||
|
|
127 | c | |||
|
|
128 | c write(*,*) "weight: ",weight(j) | |||
|
|
129 | c write(*,*) "store: ",store(k,l,m) | |||
|
|
130 | c call exit | |||
|
|
131 | c end if | |||
|
|
132 | c end if | |||
|
|
133 | plag(lag,i)=plag(lag,i)+weight(j)*store(k,l,m) | |||
|
|
134 | c if (i .eq. nrange) then | |||
|
|
135 | c write(*,*) "lag: ",lag | |||
|
|
136 | c write(*,*) "plag: ",plag(lag,i) | |||
|
|
137 | c write(*,*) "plag: ",plag(lag,i) | |||
|
|
138 | c call exit | |||
|
|
139 | c end if | |||
|
|
140 | end do | |||
|
|
141 | c write(*,*) "plag: ",plag(lag,i) | |||
|
|
142 | c write(*,*) "plag: ",plag(12,72) | |||
|
|
143 | c call exit | |||
|
|
144 | end do | |||
|
|
145 | c call exit | |||
|
|
146 | c write(*,*) "plag: ",plag(12,72) | |||
|
|
147 | end do | |||
|
|
148 | c write(*,*) "plag: ",plag(12,72) | |||
|
|
149 | c call exit | |||
|
|
150 | c write(*,*) "End LAGP" | |||
|
|
151 | return | |||
|
|
152 | end | |||
|
|
153 | ||||
|
|
154 | subroutine lagp_old(plag,wl,r0,dr,nl,nrange) | |||
|
|
155 | c | |||
|
|
156 | c predict lagged product matrix using state parameters stored | |||
|
|
157 | c as cubic b-splines | |||
|
|
158 | c read weights for numeric integration from a file | |||
|
|
159 | c | |||
|
|
160 | c general version - samples can be anywhere | |||
|
|
161 | c | |||
|
|
162 | include 'fitter.h' | |||
|
|
163 | include 'spline.h' | |||
|
|
164 | include 'bfield.h' | |||
|
|
165 | integer nl,nrange | |||
|
|
166 | real plag(nl,nrange),taus(nl) | |||
|
|
167 | parameter(nw=1000) | |||
|
|
168 | integer ilag(nw) | |||
|
|
169 | real weight(nw),dtau(nw),drange(nw) | |||
|
|
170 | logical first | |||
|
|
171 | data first/.true./ | |||
|
|
172 | c | |||
|
|
173 | ||||
|
|
174 | c zero out array | |||
|
|
175 | ||||
|
|
176 | do i=1,nrange | |||
|
|
177 | do j=1,nl | |||
|
|
178 | plag(j,i)=0.0 | |||
|
|
179 | end do | |||
|
|
180 | end do | |||
|
|
181 | ||||
|
|
182 | c | |||
|
|
183 | c construct lagged products | |||
|
|
184 | c | |||
|
|
185 | ||||
|
|
186 | if(first) then | |||
|
|
187 | open(unit=25,file='weights.dat',status='old') | |||
|
|
188 | read (25,*) nwt | |||
|
|
189 | do i=1,nwt | |||
|
|
190 | read(25,*) weight(i),dtau(i),drange(i),ilag(i) | |||
|
|
191 | end do | |||
|
|
192 | close(25) | |||
|
|
193 | first=.false. | |||
|
|
194 | end if | |||
|
|
195 | ||||
|
|
196 | c can avoid recalculating splines and/or ACFs when parameters repeat | |||
|
|
197 | ||||
|
|
198 | altp=-1.0 | |||
|
|
199 | taup=-1.0 | |||
|
|
200 | ||||
|
|
201 | do i=1+nl,nrange | |||
|
|
202 | do j=1,nwt | |||
|
|
203 | alt=r0+(float(i-1)+drange(j))*dr | |||
|
|
204 | ii=(alt-r0)/dr+1 | |||
|
|
205 | ||||
|
|
206 | if(alt.ne.altp) then | |||
|
|
207 | call get_spline(alt,dens,te,ti1,hf,hef) | |||
|
|
208 | ||||
|
|
209 | c write(*,*) alt,dens,te,ti1,hf,hef | |||
|
|
210 | ||||
|
|
211 | do k=1,nion | |||
|
|
212 | ti(k)=ti1 | |||
|
|
213 | end do | |||
|
|
214 | fi(2)=hf | |||
|
|
215 | fi(3)=hef | |||
|
|
216 | fi(1)=1.0-hf-hef | |||
|
|
217 | end if | |||
|
|
218 | ||||
|
|
219 | tau=abs(dtau(j)*dr/1.5e5) | |||
|
|
220 | lag=ilag(j)+1 | |||
|
|
221 | ||||
|
|
222 | c write(*,*) i,alpha_prof(i),bfld_prof(i) | |||
|
|
223 | ||||
|
|
224 | if(tau.ne.taup.or.alt.ne.altp) then | |||
|
|
225 | ||||
|
|
226 | c two- or three- point Gauss Hermite quadrature rule | |||
|
|
227 | ||||
|
|
228 | c call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
229 | c & alpha_prof(ii)+1.74e-2,dens,bfld_prof(ii),rho1) | |||
|
|
230 | ||||
|
|
231 | c call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
232 | c & alpha_prof(ii)-1.74e-2,dens,bfld_prof(ii),rho2) | |||
|
|
233 | ||||
|
|
234 | c call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
235 | c & alpha_prof(ii),dens,bfld_prof(ii),rho1) | |||
|
|
236 | ||||
|
|
237 | c call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
238 | c & alpha_prof(ii)+1.9e-2,dens,bfld_prof(ii),rho2) | |||
|
|
239 | ||||
|
|
240 | c call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
241 | c & alpha_prof(ii)-1.9e-2,dens,bfld_prof(ii),rho3) | |||
|
|
242 | ||||
|
|
243 | call acf2(wl,tau,te,ti,fi,ven,vin,wi,nion, | |||
|
|
244 | & alpha_prof(ii),dens,bfld_prof(ii),rho) | |||
|
|
245 | ||||
|
|
246 | c rho=(rho1+rho2)/2.0 | |||
|
|
247 | c rho=(rho2+rho3)*0.29541+rho1*1.18164)/1.77246 | |||
|
|
248 | ||||
|
|
249 | end if | |||
|
|
250 | ||||
|
|
251 | plag(lag,i)=plag(lag,i)+weight(j)*rho*dens*(100.0/alt)**2 | |||
|
|
252 | ||||
|
|
253 | altp=alt | |||
|
|
254 | taup=tau | |||
|
|
255 | ||||
|
|
256 | end do | |||
|
|
257 | end do | |||
|
|
258 | ||||
|
|
259 | return | |||
|
|
260 | end | |||
|
|
261 | ||||
|
|
262 | function atanh(x) | |||
|
|
263 | c | |||
|
|
264 | real atanh,x | |||
|
|
265 | c | |||
|
|
266 | atanh=log(sqrt((1.+x)/(1.-x))) | |||
|
|
267 | return | |||
|
|
268 | end | |||
|
|
269 | ||||
|
|
270 | subroutine get_spline(alt,dens,te,ti,hf,hef) | |||
|
|
271 | c | |||
|
|
272 | c routines for handling cubic b-spline interpolation | |||
|
|
273 | c gets values consistent with stored coefficients | |||
|
|
274 | c | |||
|
|
275 | ||||
|
|
276 | include 'spline.h' | |||
|
|
277 | ||||
|
|
278 | c | |||
|
|
279 | c bspline values from 200-1500 km in 15-km intervals | |||
|
|
280 | c must specify five knots above ceiling | |||
|
|
281 | c note offset ... start accessing splines above bottom two knots | |||
|
|
282 | c | |||
|
|
283 | c five banks of splines, for Ne, Te, Ti, H+, and He+ versus altitude | |||
|
|
284 | c need to initialize ta somewhere | |||
|
|
285 | c | |||
|
|
286 | c write(*,*) "ta: ",ta | |||
|
|
287 | c write(*,*) "bcoef(1,1): ",bcoef(1,1) | |||
|
|
288 | c write(*,*) "nspline: ",nspline | |||
|
|
289 | c write(*,*) "norder: ",norder | |||
|
|
290 | c write(*,*) "alt: ",alt | |||
|
|
291 | dens=bvalue(ta,bcoef(1,1),nspline,norder,alt,0) | |||
|
|
292 | c write(*,*) "dens_inside_get_spline: ",dens | |||
|
|
293 | c write(*,*) dens | |||
|
|
294 | c call exit | |||
|
|
295 | dens=10.0**MAX(dens,2.0) | |||
|
|
296 | c write(*,*) dens | |||
|
|
297 | c call exit | |||
|
|
298 | te=bvalue(ta,bcoef(1,2),nspline,norder,alt,0) | |||
|
|
299 | te=t0+t1*(1.0+tanh(te))/2.0 ! DLH 10/14 was 3500 | |||
|
|
300 | c tr=bvalue(ta,bcoef(1,3),nspline,norder,alt,0) | |||
|
|
301 | c tr=exp(tr) | |||
|
|
302 | c ti=te/tr | |||
|
|
303 | ti=bvalue(ta,bcoef(1,3),nspline,norder,alt,0) | |||
|
|
304 | ti=t0+t1*(1.0+tanh(ti))/2.0 ! DLH 10/14 was 3500 | |||
|
|
305 | hf=bvalue(ta,bcoef(1,4),nspline,norder,alt,0) | |||
|
|
306 | hf=(1.0+tanh(hf))/2.0 | |||
|
|
307 | hef=bvalue(ta,bcoef(1,5),nspline,norder,alt,0) | |||
|
|
308 | hef=(1.0+tanh(hef))/2.0 | |||
|
|
309 | return | |||
|
|
310 | end | |||
|
|
311 | ||||
|
|
312 | ||||
|
|
313 | real function bvalue ( t, bcoef, n, k, x, jderiv ) | |||
|
|
314 | c from * a practical guide to splines * by c. de boor | |||
|
|
315 | calls interv | |||
|
|
316 | c | |||
|
|
317 | calculates value at x of jderiv-th derivative of spline from b-repr. | |||
|
|
318 | c the spline is taken to be continuous from the right, EXCEPT at the | |||
|
|
319 | c rightmost knot, where it is taken to be continuous from the left. | |||
|
|
320 | c | |||
|
|
321 | c****** i n p u t ****** | |||
|
|
322 | c t, bcoef, n, k......forms the b-representation of the spline f to | |||
|
|
323 | c be evaluated. specifically, | |||
|
|
324 | c t.....knot sequence, of length n+k, assumed nondecreasing. | |||
|
|
325 | c bcoef.....b-coefficient sequence, of length n . | |||
|
|
326 | c n.....length of bcoef and dimension of spline(k,t), | |||
|
|
327 | c a s s u m e d positive . | |||
|
|
328 | c k.....order of the spline . | |||
|
|
329 | c | |||
|
|
330 | c w a r n i n g . . . the restriction k .le. kmax (=20) is imposed | |||
|
|
331 | c arbitrarily by the dimension statement for aj, dl, dr below, | |||
|
|
332 | c but is n o w h e r e c h e c k e d for. | |||
|
|
333 | c | |||
|
|
334 | c x.....the point at which to evaluate . | |||
|
|
335 | c jderiv.....integer giving the order of the derivative to be evaluated | |||
|
|
336 | c a s s u m e d to be zero or positive. | |||
|
|
337 | c | |||
|
|
338 | c****** o u t p u t ****** | |||
|
|
339 | c bvalue.....the value of the (jderiv)-th derivative of f at x . | |||
|
|
340 | c | |||
|
|
341 | c****** m e t h o d ****** | |||
|
|
342 | c The nontrivial knot interval (t(i),t(i+1)) containing x is lo- | |||
|
|
343 | c cated with the aid of interv . The k b-coeffs of f relevant for | |||
|
|
344 | c this interval are then obtained from bcoef (or taken to be zero if | |||
|
|
345 | c not explicitly available) and are then differenced jderiv times to | |||
|
|
346 | c obtain the b-coeffs of (d**jderiv)f relevant for that interval. | |||
|
|
347 | c Precisely, with j = jderiv, we have from x.(12) of the text that | |||
|
|
348 | c | |||
|
|
349 | c (d**j)f = sum ( bcoef(.,j)*b(.,k-j,t) ) | |||
|
|
350 | c | |||
|
|
351 | c where | |||
|
|
352 | c / bcoef(.), , j .eq. 0 | |||
|
|
353 | c / | |||
|
|
354 | c bcoef(.,j) = / bcoef(.,j-1) - bcoef(.-1,j-1) | |||
|
|
355 | c / ----------------------------- , j .gt. 0 | |||
|
|
356 | c / (t(.+k-j) - t(.))/(k-j) | |||
|
|
357 | c | |||
|
|
358 | c Then, we use repeatedly the fact that | |||
|
|
359 | c | |||
|
|
360 | c sum ( a(.)*b(.,m,t)(x) ) = sum ( a(.,x)*b(.,m-1,t)(x) ) | |||
|
|
361 | c with | |||
|
|
362 | c (x - t(.))*a(.) + (t(.+m-1) - x)*a(.-1) | |||
|
|
363 | c a(.,x) = --------------------------------------- | |||
|
|
364 | c (x - t(.)) + (t(.+m-1) - x) | |||
|
|
365 | c | |||
|
|
366 | c to write (d**j)f(x) eventually as a linear combination of b-splines | |||
|
|
367 | c of order 1 , and the coefficient for b(i,1,t)(x) must then be the | |||
|
|
368 | c desired number (d**j)f(x). (see x.(17)-(19) of text). | |||
|
|
369 | c | |||
|
|
370 | parameter (kmax = 40) | |||
|
|
371 | integer jderiv,k,n, i,ilo,imk,j,jc,jcmin,jcmax,jj,kmj,km1 | |||
|
|
372 | * ,mflag,nmi,jdrvp1 | |||
|
|
373 | c integer kmax | |||
|
|
374 | C real bcoef(n),t(1),x, aj(20),dl(20),dr(20),fkmj | |||
|
|
375 | real bcoef(n),x, aj(kmax),dl(kmax),dr(kmax),fkmj | |||
|
|
376 | dimension t(n+k) | |||
|
|
377 | c former fortran standard made it impossible to specify the length of t | |||
|
|
378 | c precisely without the introduction of otherwise superfluous addition- | |||
|
|
379 | c al arguments. | |||
|
|
380 | bvalue = 0. | |||
|
|
381 | if (jderiv .ge. k) go to 99 | |||
|
|
382 | c | |||
|
|
383 | c *** Find i s.t. 1 .le. i .lt. n+k and t(i) .lt. t(i+1) and | |||
|
|
384 | c t(i) .le. x .lt. t(i+1) . If no such i can be found, x lies | |||
|
|
385 | c outside the support of the spline f , hence bvalue = 0. | |||
|
|
386 | c (The asymmetry in this choice of i makes f rightcontinuous, except | |||
|
|
387 | c at t(n+k) where it is leftcontinuous.) | |||
|
|
388 | call interv ( t, n+k, x, i, mflag ) | |||
|
|
389 | if (mflag .ne. 0) go to 99 | |||
|
|
390 | c *** if k = 1 (and jderiv = 0), bvalue = bcoef(i). | |||
|
|
391 | km1 = k - 1 | |||
|
|
392 | if (km1 .gt. 0) go to 1 | |||
|
|
393 | bvalue = bcoef(i) | |||
|
|
394 | go to 99 | |||
|
|
395 | c | |||
|
|
396 | c *** store the k b-spline coefficients relevant for the knot interval | |||
|
|
397 | c (t(i),t(i+1)) in aj(1),...,aj(k) and compute dl(j) = x - t(i+1-j), | |||
|
|
398 | c dr(j) = t(i+j) - x, j=1,...,k-1 . set any of the aj not obtainable | |||
|
|
399 | c from input to zero. set any t.s not obtainable equal to t(1) or | |||
|
|
400 | c to t(n+k) appropriately. | |||
|
|
401 | 1 jcmin = 1 | |||
|
|
402 | imk = i - k | |||
|
|
403 | if (imk .ge. 0) go to 8 | |||
|
|
404 | jcmin = 1 - imk | |||
|
|
405 | do 5 j=1,i | |||
|
|
406 | 5 dl(j) = x - t(i+1-j) | |||
|
|
407 | do 6 j=i,km1 | |||
|
|
408 | aj(k-j) = 0. | |||
|
|
409 | 6 dl(j) = dl(i) | |||
|
|
410 | go to 10 | |||
|
|
411 | 8 do 9 j=1,km1 | |||
|
|
412 | 9 dl(j) = x - t(i+1-j) | |||
|
|
413 | c | |||
|
|
414 | 10 jcmax = k | |||
|
|
415 | nmi = n - i | |||
|
|
416 | if (nmi .ge. 0) go to 18 | |||
|
|
417 | jcmax = k + nmi | |||
|
|
418 | do 15 j=1,jcmax | |||
|
|
419 | 15 dr(j) = t(i+j) - x | |||
|
|
420 | do 16 j=jcmax,km1 | |||
|
|
421 | aj(j+1) = 0. | |||
|
|
422 | 16 dr(j) = dr(jcmax) | |||
|
|
423 | go to 20 | |||
|
|
424 | 18 do 19 j=1,km1 | |||
|
|
425 | 19 dr(j) = t(i+j) - x | |||
|
|
426 | c | |||
|
|
427 | 20 do 21 jc=jcmin,jcmax | |||
|
|
428 | 21 aj(jc) = bcoef(imk + jc) | |||
|
|
429 | c | |||
|
|
430 | c *** difference the coefficients jderiv times. | |||
|
|
431 | if (jderiv .eq. 0) go to 30 | |||
|
|
432 | do 23 j=1,jderiv | |||
|
|
433 | kmj = k-j | |||
|
|
434 | fkmj = float(kmj) | |||
|
|
435 | ilo = kmj | |||
|
|
436 | do 23 jj=1,kmj | |||
|
|
437 | aj(jj) = ((aj(jj+1) - aj(jj))/(dl(ilo) + dr(jj)))*fkmj | |||
|
|
438 | 23 ilo = ilo - 1 | |||
|
|
439 | c | |||
|
|
440 | c *** compute value at x in (t(i),t(i+1)) of jderiv-th derivative, | |||
|
|
441 | c given its relevant b-spline coeffs in aj(1),...,aj(k-jderiv). | |||
|
|
442 | 30 if (jderiv .eq. km1) go to 39 | |||
|
|
443 | jdrvp1 = jderiv + 1 | |||
|
|
444 | do 33 j=jdrvp1,km1 | |||
|
|
445 | kmj = k-j | |||
|
|
446 | ilo = kmj | |||
|
|
447 | do 33 jj=1,kmj | |||
|
|
448 | aj(jj) = (aj(jj+1)*dl(ilo) + aj(jj)*dr(jj))/(dl(ilo)+dr(jj)) | |||
|
|
449 | 33 ilo = ilo - 1 | |||
|
|
450 | 39 bvalue = aj(1) | |||
|
|
451 | c | |||
|
|
452 | 99 return | |||
|
|
453 | end | |||
|
|
454 | subroutine interv ( xt, lxt, x, left, mflag ) | |||
|
|
455 | c from * a practical guide to splines * by C. de Boor | |||
|
|
456 | computes left = max( i : xt(i) .lt. xt(lxt) .and. xt(i) .le. x ) . | |||
|
|
457 | c | |||
|
|
458 | c****** i n p u t ****** | |||
|
|
459 | c xt.....a real sequence, of length lxt , assumed to be nondecreasing | |||
|
|
460 | c lxt.....number of terms in the sequence xt . | |||
|
|
461 | c x.....the point whose location with respect to the sequence xt is | |||
|
|
462 | c to be determined. | |||
|
|
463 | c | |||
|
|
464 | c****** o u t p u t ****** | |||
|
|
465 | c left, mflag.....both integers, whose value is | |||
|
|
466 | c | |||
|
|
467 | c 1 -1 if x .lt. xt(1) | |||
|
|
468 | c i 0 if xt(i) .le. x .lt. xt(i+1) | |||
|
|
469 | c i 0 if xt(i) .lt. x .eq. xt(i+1) .eq. xt(lxt) | |||
|
|
470 | c i 1 if xt(i) .lt. xt(i+1) .eq. xt(lxt) .lt. x | |||
|
|
471 | c | |||
|
|
472 | c In particular, mflag = 0 is the 'usual' case. mflag .ne. 0 | |||
|
|
473 | c indicates that x lies outside the CLOSED interval | |||
|
|
474 | c xt(1) .le. y .le. xt(lxt) . The asymmetric treatment of the | |||
|
|
475 | c intervals is due to the decision to make all pp functions cont- | |||
|
|
476 | c inuous from the right, but, by returning mflag = 0 even if | |||
|
|
477 | C x = xt(lxt), there is the option of having the computed pp function | |||
|
|
478 | c continuous from the left at xt(lxt) . | |||
|
|
479 | c | |||
|
|
480 | c****** m e t h o d ****** | |||
|
|
481 | c The program is designed to be efficient in the common situation that | |||
|
|
482 | c it is called repeatedly, with x taken from an increasing or decrea- | |||
|
|
483 | c sing sequence. This will happen, e.g., when a pp function is to be | |||
|
|
484 | c graphed. The first guess for left is therefore taken to be the val- | |||
|
|
485 | c ue returned at the previous call and stored in the l o c a l varia- | |||
|
|
486 | c ble ilo . A first check ascertains that ilo .lt. lxt (this is nec- | |||
|
|
487 | c essary since the present call may have nothing to do with the previ- | |||
|
|
488 | c ous call). Then, if xt(ilo) .le. x .lt. xt(ilo+1), we set left = | |||
|
|
489 | c ilo and are done after just three comparisons. | |||
|
|
490 | c Otherwise, we repeatedly double the difference istep = ihi - ilo | |||
|
|
491 | c while also moving ilo and ihi in the direction of x , until | |||
|
|
492 | c xt(ilo) .le. x .lt. xt(ihi) , | |||
|
|
493 | c after which we use bisection to get, in addition, ilo+1 = ihi . | |||
|
|
494 | c left = ilo is then returned. | |||
|
|
495 | c | |||
|
|
496 | integer left,lxt,mflag, ihi,ilo,istep,middle | |||
|
|
497 | real x,xt(lxt) | |||
|
|
498 | data ilo /1/ | |||
|
|
499 | save ilo | |||
|
|
500 | ihi = ilo + 1 | |||
|
|
501 | if (ihi .lt. lxt) go to 20 | |||
|
|
502 | if (x .ge. xt(lxt)) go to 110 | |||
|
|
503 | if (lxt .le. 1) go to 90 | |||
|
|
504 | ilo = lxt - 1 | |||
|
|
505 | ihi = lxt | |||
|
|
506 | c | |||
|
|
507 | 20 if (x .ge. xt(ihi)) go to 40 | |||
|
|
508 | if (x .ge. xt(ilo)) go to 100 | |||
|
|
509 | c | |||
|
|
510 | c **** now x .lt. xt(ilo) . decrease ilo to capture x . | |||
|
|
511 | istep = 1 | |||
|
|
512 | 31 ihi = ilo | |||
|
|
513 | ilo = ihi - istep | |||
|
|
514 | if (ilo .le. 1) go to 35 | |||
|
|
515 | if (x .ge. xt(ilo)) go to 50 | |||
|
|
516 | istep = istep*2 | |||
|
|
517 | go to 31 | |||
|
|
518 | 35 ilo = 1 | |||
|
|
519 | if (x .lt. xt(1)) go to 90 | |||
|
|
520 | go to 50 | |||
|
|
521 | c **** now x .ge. xt(ihi) . increase ihi to capture x . | |||
|
|
522 | 40 istep = 1 | |||
|
|
523 | 41 ilo = ihi | |||
|
|
524 | ihi = ilo + istep | |||
|
|
525 | if (ihi .ge. lxt) go to 45 | |||
|
|
526 | if (x .lt. xt(ihi)) go to 50 | |||
|
|
527 | istep = istep*2 | |||
|
|
528 | go to 41 | |||
|
|
529 | 45 if (x .ge. xt(lxt)) go to 110 | |||
|
|
530 | ihi = lxt | |||
|
|
531 | c | |||
|
|
532 | c **** now xt(ilo) .le. x .lt. xt(ihi) . narrow the interval. | |||
|
|
533 | 50 middle = (ilo + ihi)/2 | |||
|
|
534 | if (middle .eq. ilo) go to 100 | |||
|
|
535 | c note. it is assumed that middle = ilo in case ihi = ilo+1 . | |||
|
|
536 | if (x .lt. xt(middle)) go to 53 | |||
|
|
537 | ilo = middle | |||
|
|
538 | go to 50 | |||
|
|
539 | 53 ihi = middle | |||
|
|
540 | go to 50 | |||
|
|
541 | c**** set output and return. | |||
|
|
542 | 90 mflag = -1 | |||
|
|
543 | left = 1 | |||
|
|
544 | return | |||
|
|
545 | 100 mflag = 0 | |||
|
|
546 | left = ilo | |||
|
|
547 | return | |||
|
|
548 | 110 mflag = 1 | |||
|
|
549 | if (x .eq. xt(lxt)) mflag = 0 | |||
|
|
550 | left = lxt | |||
|
|
551 | 111 if (left .eq. 1) return | |||
|
|
552 | left = left - 1 | |||
|
|
553 | if (xt(left) .lt. xt(lxt)) return | |||
|
|
554 | go to 111 | |||
|
|
555 | end | |||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644, binary diff hidden |
|
NO CONTENT: new file 100644, binary diff hidden |
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100755 |
|
NO CONTENT: new file 100755 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
| 1 | NO CONTENT: new file 100644 |
|
NO CONTENT: new file 100644 | ||
| The requested commit or file is too big and content was truncated. Show full diff | |||||
General Comments 0
You need to be logged in to leave comments.
Login now