-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathCF_FORMFACTOR.FOR
541 lines (535 loc) · 20 KB
/
CF_FORMFACTOR.FOR
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
c***********************************************************************
real*8 function formfactor(qnorm,nre) ! Formfaktor f(Q)
c***********************************************************************
implicit none
integer nre ! nummer der seltenen erde
integer info
real*8 qnorm,fsq2
qnorm = abs(qnorm)
call reform(qnorm,fsq2,nre,info)
formfactor = sqrt( fsq2 ) ! da reform f(q)**2 berechnet
return
end
c***********************************************************************
c Formfaktoren aus Fit-c09
c***********************************************************************
C***********************************************************************
C
SUBROUTINE REFORM (Q,YS,NRE,INFO)
C
C***********************************************************************
C
C----------- LAST UPDATE 1. JUL 91 --------- E. H-M ------------------
C
C***********************************************************************
C
C CO9 = CO8
C
C***********************************************************************
C
C SUBROUTINE REFORM CALCULATES RARE EARTH FORM FACTORS
C
C
C Q (A**(-1)) (INPUT)
C YS = F**2(XS)) (OUTPUT)
C
C NRE : 100 f(Q)**2=1
C 1 - CE3+ ; 2 - PR3+ ; 3 - ND3+ ; 4 - PM3+(DUMMY)
C 5 - SM3+ ; 6 - EU2+ ; 7 - GD3+ ; 8 - TB3+
C 9 - DY3+ ; 10 - HO3+ ; 11 - ER3+ ; 12 - TM3+
C 13 - YB3+ ; 14 - Lu3+
C 24 - NP3+ ; 25 - PU3+
C 26 - AM3+ ; 27 - CU3+
C 0 - EXTERNAL INPUT FOR KNOTS Q/(4*PI) AND CORRESPONDING
C VALUES OF FORMFACTOR f(Q)
C INFO - 0 Q OUT OF D
C -1 Q < D
C 1 Q > D
C (WITH D = AREA OF DEFINITION OF FORMFAKTOR;
C D = (0, 15.08) FOR NRE = 0, ... ,13)
C
C
C-------------------------------------- U. WALTER 23/4/81 -------------
C
C***********************************************************************
C
c IMPLICIT REAL*8 (A-H,O-Z)
C
REAL*8 A(4,35)
REAL*8 MN,MK,LK
real x(98),y(98)
C --------------------
integer nre,info,n,m,i,k,k1,j,l
real*8 stn
real*8 r0,s0,q0,u0,r2,dk,q,pol,ex
real*8 pk,r1,s1,xs,ys,xk,dn
external exp_ ! see cf_fabi.for
real*8 exp_
C
include 'CF_SOURCES:FORMFACTOR.INC'
C
C
c call xuflow(0)
INFO = 0
IF(NRE .EQ.100) GO TO 999
IF(NRE .GE. 24) GO TO 999
IF(NRE .EQ. NNN) GO TO 251
C
C-------------------- INPUT FE3+ FORMFAKTOR ------------------------
C
N = 18
M = 17
IF(NRE .GT. 0) GO TO 101
N = 35
M = N - 1
do 50 i=1,n
x(i) = feq(i)
y(i) = fef(i)
50 continue
STN = (y(n)-y(n-1))/(x(n)-x(n-1))
GO TO 102
C
C------------------ CALCULATION OF SPLINE COEFFICIENTS -----------------
C
101 do 55 i=1,18
x(i) = req(i)
y(i) = ref(i+19*(nre-1))
55 continue
STN = ref(19*NRE)
102 R0 = X(2) - X(1)
S0 = Y(2) - Y(1)
Q0 = -0.5D0
MN = 1.D0
U0 = 3.D0*(S0/R0-ST1)/R0
R1 = 1.D0/(X(N)-X(M))
DN = (STN-(Y(N)-Y(M))*R1)*6.D0*R1
A(2,1) = Q0
A(3,1) = U0
K = 2
IF(N .EQ. 2) GO TO 199
DO 150 K1=3, N
R1 = X(K1) - X(K)
S1 = Y(K1) - Y(K)
R2 = R1 + R0
LK = R1/R2
DK = (S1/R1-S0/R0)*6.D0/R2
R0 = R1
S0 = S1
MK = 1.D0 - LK
PK = 1.D0/(MK*Q0+2.D0)
Q0 = -LK*PK
U0 = (DK-MK*U0)*PK
A(2,K) = Q0
A(3,K) = U0
150 K = K1
199 MN = 0.5D0*(DN-MN*U0)/(MN*Q0+2.D0)
DO 200 I=1, M
K1 = N - I
R1 = X(K) - X(K1)
MK = A(2,K1)*MN + A(3,K1)*0.5D0
A(3,K1) = MK
A(2,K1) = (Y(K)-Y(K1))/R1 - (MK*2.D0+MN)*R1/3.D0
A(4,K1) = (MN-MK)/R1/3.D0
A(1,K1) = Y(K1)
MN = MK
200 K = K1
NNN = NRE
C
C------------------ CALCULATE SQUARE OF FORMFACTOR ---------------------
C AT THE POINT XS=Q/4./PI
C
251 XS = Q*0.0795774715D0
IF(XS .GT. X(1)) GO TO 261
INFO = -1
YS = Y(1)*Y(1)
RETURN
261 IF(XS .LT. X(N)) GO TO 299
INFO = 1
YS = 0.D0
RETURN
299 K = 1
301 IF(XS .LE. X(K+1)) GO TO 302
K = K + 1
IF(K .LT. N) GO TO 301
K = M
302 XK = XS - X(K)
POL = A(4,K)
DO 400 J=1, 3
L = 4 - J
400 POL = A(L,K) + XK*POL
YS = POL*POL
RETURN
! 998 EX = -0.0672D0*Q*Q
! if(abs(ex).gt.74.0d0) ex=sign(74.d0,ex)
! YS = exp_(ex)
! RETURN
999 YS = 1.D0
RETURN
END
c***********************************************************************
subroutine initform
c***********************************************************************
implicit none
include 'CF_SOURCES:FORMFACTOR.INC'
nnn = -1
st1 = 0.000000000E+00
req( 1 ) = 0.000000000E+00
req( 2 ) = 0.500000007E-01
req( 3 ) = 0.100000024
req( 4 ) = 0.149999976
req( 5 ) = 0.199999988
req( 6 ) = 0.250000000
req( 7 ) = 0.300000012
req( 8 ) = 0.350000024
req( 9 ) = 0.399999976
req( 10 ) = 0.449999988
req( 11 ) = 0.500000000
req( 12 ) = 0.600000024
req( 13 ) = 0.699999988
req( 14 ) = 0.800000012
req( 15 ) = 0.899999976
req( 16 ) = 1.00000000
req( 17 ) = 1.10000038
req( 18 ) = 1.19999981
ref( 1 ) = 1.00000000
ref( 2 ) = 0.989099979
ref( 3 ) = 0.957000017
ref( 4 ) = 0.905900002
ref( 5 ) = 0.837400019
ref( 6 ) = 0.762499988
ref( 7 ) = 0.680299997
ref( 8 ) = 0.597700000
ref( 9 ) = 0.518400013
ref( 10 ) = 0.444700003
ref( 11 ) = 0.378199995
ref( 12 ) = 0.268100023
ref( 13 ) = 0.186900020
ref( 14 ) = 0.129299998
ref( 15 ) = 0.896999836E-01
ref( 16 ) = 0.630000234E-01
ref( 17 ) = 0.452999994E-01
ref( 18 ) = 0.337000005E-01
ref( 19 ) = -0.103799999
ref( 20 ) = 1.00000000
ref( 21 ) = 0.993499994
ref( 22 ) = 0.974200010
ref( 23 ) = 0.942200005
ref( 24 ) = 0.898699999
ref( 25 ) = 0.845499992
ref( 26 ) = 0.784500003
ref( 27 ) = 0.718999982
ref( 28 ) = 0.651400030
ref( 29 ) = 0.584200025
ref( 30 ) = 0.518999994
ref( 31 ) = 0.399500012
ref( 32 ) = 0.298699975
ref( 33 ) = 0.217299998
ref( 34 ) = 0.153699994
ref( 35 ) = 0.105300009
ref( 36 ) = 0.691999793E-01
ref( 37 ) = 0.428000018E-01
ref( 38 ) = -0.242799997
ref( 39 ) = 1.00000000
ref( 40 ) = 0.996200025
ref( 41 ) = 0.984499991
ref( 42 ) = 0.964200020
ref( 43 ) = 0.934800029
ref( 44 ) = 0.896799982
ref( 45 ) = 0.851400018
ref( 46 ) = 0.800499976
ref( 47 ) = 0.746100008
ref( 48 ) = 0.690100014
ref( 49 ) = 0.634299994
ref( 50 ) = 0.527800024
ref( 51 ) = 0.432799995
ref( 52 ) = 0.351599991
ref( 53 ) = 0.284200013
ref( 54 ) = 0.229099989
ref( 55 ) = 0.184599996
ref( 56 ) = 0.148999989
ref( 57 ) = -0.336000025
ref( 58 ) = 0.000000000E+00
ref( 59 ) = 0.000000000E+00
ref( 60 ) = 0.000000000E+00
ref( 61 ) = 0.000000000E+00
ref( 62 ) = 0.000000000E+00
ref( 63 ) = 0.000000000E+00
ref( 64 ) = 0.000000000E+00
ref( 65 ) = 0.000000000E+00
ref( 66 ) = 0.000000000E+00
ref( 67 ) = 0.000000000E+00
ref( 68 ) = 0.000000000E+00
ref( 69 ) = 0.000000000E+00
ref( 70 ) = 0.000000000E+00
ref( 71 ) = 0.000000000E+00
ref( 72 ) = 0.000000000E+00
ref( 73 ) = 0.000000000E+00
ref( 74 ) = 0.000000000E+00
ref( 75 ) = 0.000000000E+00
ref( 76 ) = 0.000000000E+00
ref( 77 ) = 1.00000000
ref( 78 ) = 1.01799965
ref( 79 ) = 1.06709957
ref( 80 ) = 1.13409996
ref( 81 ) = 1.20310020
ref( 82 ) = 1.26000023
ref( 83 ) = 1.29580021
ref( 84 ) = 1.30650043
ref( 85 ) = 1.29240036
ref( 86 ) = 1.25650024
ref( 87 ) = 1.20300007
ref( 88 ) = 1.06089973
ref( 89 ) = 0.898000002
ref( 90 ) = 0.736199975
ref( 91 ) = 0.588400006
ref( 92 ) = 0.460300028
ref( 93 ) = 0.353500009
ref( 94 ) = 0.266900003
ref( 95 ) = -0.819000006
ref( 96 ) = 1.00000000
ref( 97 ) = 0.982999980
ref( 98 ) = 0.934000015
ref( 99 ) = 0.861000001
ref( 100 ) = 0.772000015
ref( 101 ) = 0.675999999
ref( 102 ) = 0.578999996
ref( 103 ) = 0.486999989
ref( 104 ) = 0.402000010
ref( 105 ) = 0.325999975
ref( 106 ) = 0.259999990
ref( 107 ) = 0.154999971
ref( 108 ) = 0.820000172E-01
ref( 109 ) = 0.359999985E-01
ref( 110 ) = 0.800000131E-02
ref( 111 ) = -0.800000131E-02
ref( 112 ) = -0.159999989E-01
ref( 113 ) = -0.190000013E-01
ref( 114 ) = 0.000000000E+00
ref( 115 ) = 1.00000000
ref( 116 ) = 0.984099984
ref( 117 ) = 0.938399971
ref( 118 ) = 0.868799984
ref( 119 ) = 0.782899976
ref( 120 ) = 0.688700020
ref( 121 ) = 0.592899978
ref( 122 ) = 0.500699997
ref( 123 ) = 0.415400028
ref( 124 ) = 0.338699996
ref( 125 ) = 0.271499991
ref( 126 ) = 0.164799988
ref( 127 ) = 0.904999971E-01
ref( 128 ) = 0.414000005E-01
ref( 129 ) = 0.106000006E-01
ref( 130 ) = -0.730000064E-02
ref( 131 ) = -0.168000013E-01
ref( 132 ) = -0.207999982E-01
ref( 133 ) = -0.295999981E-01
ref( 134 ) = 1.00000000
ref( 135 ) = 0.987100005
ref( 136 ) = 0.949999988
ref( 137 ) = 0.892799973
ref( 138 ) = 0.820900023
ref( 139 ) = 0.740499973
ref( 140 ) = 0.656799972
ref( 141 ) = 0.574000001
ref( 142 ) = 0.495199978
ref( 143 ) = 0.422200024
ref( 144 ) = 0.356199980
ref( 145 ) = 0.245899975
ref( 146 ) = 0.162899971
ref( 147 ) = 0.102900028
ref( 148 ) = 0.608999990E-01
ref( 149 ) = 0.324000008E-01
ref( 150 ) = 0.137999989E-01
ref( 151 ) = 0.209999993E-02
ref( 152 ) = -0.102599978
ref( 153 ) = 1.00000000
ref( 154 ) = 0.989099979
ref( 155 ) = 0.957499981
ref( 156 ) = 0.908500016
ref( 157 ) = 0.846499979
ref( 158 ) = 0.776199996
ref( 159 ) = 0.702099979
ref( 160 ) = 0.627699971
ref( 161 ) = 0.555599988
ref( 162 ) = 0.487500012
ref( 163 ) = 0.424600005
ref( 164 ) = 0.315900028
ref( 165 ) = 0.229799986
ref( 166 ) = 0.163699985
ref( 167 ) = 0.114099979
ref( 168 ) = 0.776000023E-01
ref( 169 ) = 0.511000007E-01
ref( 170 ) = 0.320999995E-01
ref( 171 ) = -0.173200011
ref( 172 ) = 1.00000000
ref( 173 ) = 0.990199983
ref( 174 ) = 0.961600006
ref( 175 ) = 0.917200029
ref( 176 ) = 0.860700011
ref( 177 ) = 0.796400011
ref( 178 ) = 0.728100002
ref( 179 ) = 0.659099996
ref( 180 ) = 0.591799974
ref( 181 ) = 0.527899981
ref( 182 ) = 0.468299985
ref( 183 ) = 0.364300013
ref( 184 ) = 0.280499995
ref( 185 ) = 0.205999970
ref( 186 ) = 0.164600015
ref( 187 ) = 0.126500010
ref( 188 ) = 0.978000164E-01
ref( 189 ) = 0.763000250E-01
ref( 190 ) = -0.199199975
ref( 191 ) = 1.00000000
ref( 192 ) = 0.990499973
ref( 193 ) = 0.963000000
ref( 194 ) = 0.920000017
ref( 195 ) = 0.865100026
ref( 196 ) = 0.802100003
ref( 197 ) = 0.734700024
ref( 198 ) = 0.665700018
ref( 199 ) = 0.598299980
ref( 200 ) = 0.533299983
ref( 201 ) = 0.472100019
ref( 202 ) = 0.363699973
ref( 203 ) = 0.274600029
ref( 204 ) = 0.203599989
ref( 205 ) = 0.148299992
ref( 206 ) = 0.105899990
ref( 207 ) = 0.738999844E-01
ref( 208 ) = 0.500000007E-01
ref( 209 ) = -0.221199989
ref( 210 ) = 1.00000000
ref( 211 ) = 0.990300000
ref( 212 ) = 0.961899996
ref( 213 ) = 0.917699993
ref( 214 ) = 0.861500025
ref( 215 ) = 0.797200024
ref( 216 ) = 0.728900015
ref( 217 ) = 0.659699976
ref( 218 ) = 0.591899991
ref( 219 ) = 0.527400017
ref( 220 ) = 0.467199981
ref( 221 ) = 0.361699998
ref( 222 ) = 0.276499987
ref( 223 ) = 0.209699988
ref( 224 ) = 0.158599973
ref( 225 ) = 0.120000005
ref( 226 ) = 0.911999941E-01
ref( 227 ) = 0.698999763E-01
ref( 228 ) = -0.197000027
ref( 229 ) = 1.00000000
ref( 230 ) = 0.988799989
ref( 231 ) = 0.956300020
ref( 232 ) = 0.905399978
ref( 233 ) = 0.840399981
ref( 234 ) = 0.765799999
ref( 235 ) = 0.686200023
ref( 236 ) = 0.605099976
ref( 237 ) = 0.525500000
ref( 238 ) = 0.449500024
ref( 239 ) = 0.378400028
ref( 240 ) = 0.254000008
ref( 241 ) = 0.154200017
ref( 242 ) = 0.774000287E-01
ref( 243 ) = 0.205000006E-01
ref( 244 ) = -0.201000012E-01
ref( 245 ) = -0.480000004E-01
ref( 246 ) = -0.659000278E-01
ref( 247 ) = -0.158399999
ref( 248 ) = 0.000000000E+00
ref( 249 ) = 0.000000000E+00
ref( 250 ) = 0.000000000E+00
ref( 251 ) = 0.000000000E+00
ref( 252 ) = 0.000000000E+00
ref( 253 ) = 0.000000000E+00
ref( 254 ) = 0.000000000E+00
ref( 255 ) = 0.000000000E+00
ref( 256 ) = 0.000000000E+00
ref( 257 ) = 0.000000000E+00
ref( 258 ) = 0.000000000E+00
ref( 259 ) = 0.000000000E+00
ref( 260 ) = 0.000000000E+00
ref( 261 ) = 0.000000000E+00
ref( 262 ) = 0.000000000E+00
ref( 263 ) = 0.000000000E+00
ref( 264 ) = 0.000000000E+00
ref( 265 ) = 0.000000000E+00
ref( 266 ) = 0.000000000E+00
feq( 1 ) = 0.999999931E-03
feq( 2 ) = 0.188000016E-01
feq( 3 ) = 0.412999988E-01
feq( 4 ) = 0.623999983E-01
feq( 5 ) = 0.835000277E-01
feq( 6 ) = 0.107299984
feq( 7 ) = 0.125800014
feq( 8 ) = 0.154200017
feq( 9 ) = 0.173399985
feq( 10 ) = 0.194500029
feq( 11 ) = 0.209100008
feq( 12 ) = 0.229499996
feq( 13 ) = 0.249400020
feq( 14 ) = 0.275099993
feq( 15 ) = 0.292299986
feq( 16 ) = 0.311500013
feq( 17 ) = 0.325999975
feq( 18 ) = 0.343800008
feq( 19 ) = 0.362299979
feq( 20 ) = 0.385399997
feq( 21 ) = 0.411800027
feq( 22 ) = 0.442799985
feq( 23 ) = 0.466600001
feq( 24 ) = 0.491599977
feq( 25 ) = 0.516700029
feq( 26 ) = 0.541100025
feq( 27 ) = 0.572799981
feq( 28 ) = 0.595899999
feq( 29 ) = 0.619599998
feq( 30 ) = 0.645299971
feq( 31 ) = 0.671000004
feq( 32 ) = 0.696099997
feq( 33 ) = 0.725099981
feq( 34 ) = 0.750199974
feq( 35 ) = 0.778500021
fef( 1 ) = 1.00000000
fef( 2 ) = 0.987900019
fef( 3 ) = 0.962400019
fef( 4 ) = 0.930100024
fef( 5 ) = 0.888300002
fef( 6 ) = 0.843900025
fef( 7 ) = 0.802100003
fef( 8 ) = 0.727999985
fef( 9 ) = 0.679499984
fef( 10 ) = 0.618900001
fef( 11 ) = 0.582499981
fef( 12 ) = 0.531300008
fef( 13 ) = 0.478699982
fef( 14 ) = 0.420799971
fef( 15 ) = 0.381799996
fef( 16 ) = 0.350799978
fef( 17 ) = 0.326600015
fef( 18 ) = 0.294200003
fef( 19 ) = 0.265999973
fef( 20 ) = 0.235000014
fef( 21 ) = 0.202700019
fef( 22 ) = 0.170499980
fef( 23 ) = 0.147599995
fef( 24 ) = 0.124800026
fef( 25 ) = 0.106000006
fef( 26 ) = 0.899000168E-01
fef( 27 ) = 0.724999905E-01
fef( 28 ) = 0.590999983E-01
fef( 29 ) = 0.469999984E-01
fef( 30 ) = 0.350000001E-01
fef( 31 ) = 0.256999992E-01
fef( 32 ) = 0.163000003E-01
fef( 33 ) = 0.829999894E-02
fef( 34 ) = 0.710000098E-02
fef( 35 ) = 0.589999929E-02
C
return
end
c***********************************************************************
c End of file
c***********************************************************************