00001 SUBROUTINE CURR_BINP(MNUM,IMOD,P1,P2,P3,P4,HADCUR)
00002
00003
00004
00005
00006
00007
00008
00009 real p1(4),p2(4),p3(4),p4(4),pa(4)
00010 real*8 scalar ,ss2
00011 real ssqrt,ss
00012
00013 Complex*16 z_summ(4),z_vec(4),factor
00014 Complex HADCUR(4)
00015
00016 Logical atStart
00017 real*8 invMrho4
00018 real*8 AMass_Rho,Gamma_Rho
00019 common /zrho_pool/ AMass_Rho,Gamma_Rho
00020 data Gamma_Rho /0.1445D0/
00021 data AMass_Rho /0.7761D0/
00022 data atStart/.True./
00023
00024 if (atStart) then
00025 atStart = .False.
00026 invMrho4 = 1.d0/AMass_Rho**4
00027 endif
00028
00029 call LATA(1,p1,p2,p3,p4)
00030
00031 z_summ(1) = DCMPLX(0.D0,0.D0)
00032 z_summ(2) = DCMPLX(0.D0,0.D0)
00033 z_summ(3) = DCMPLX(0.D0,0.D0)
00034 z_summ(4) = DCMPLX(0.D0,0.D0)
00035
00036 do i=1,4
00037 pa(i)=p1(i)+p2(i)+p3(i)+p4(i)
00038 enddo
00039 ss2=scalar(pa,pa)
00040
00041 if(MNUM.eq.2) then
00042
00043 IMOD=-1
00044
00045
00046 call t1(p2,p3,p1,p4,z_vec)
00047 z_summ(1) = z_summ(1) + z_vec(1)
00048 z_summ(2) = z_summ(2) + z_vec(2)
00049 z_summ(3) = z_summ(3) + z_vec(3)
00050 z_summ(4) = z_summ(4) + z_vec(4)
00051
00052 call t1(p2,p4,p1,p3,z_vec)
00053 z_summ(1) = z_summ(1) + z_vec(1)
00054 z_summ(2) = z_summ(2) + z_vec(2)
00055 z_summ(3) = z_summ(3) + z_vec(3)
00056 z_summ(4) = z_summ(4) + z_vec(4)
00057
00058 call t1(p3,p2,p1,p4,z_vec)
00059 z_summ(1) = z_summ(1) + z_vec(1)
00060 z_summ(2) = z_summ(2) + z_vec(2)
00061 z_summ(3) = z_summ(3) + z_vec(3)
00062 z_summ(4) = z_summ(4) + z_vec(4)
00063
00064 call t1(p3,p4,p1,p2,z_vec)
00065 z_summ(1) = z_summ(1) + z_vec(1)
00066 z_summ(2) = z_summ(2) + z_vec(2)
00067 z_summ(3) = z_summ(3) + z_vec(3)
00068 z_summ(4) = z_summ(4) + z_vec(4)
00069
00070 call t1(p4,p2,p1,p3,z_vec)
00071 z_summ(1) = z_summ(1) + z_vec(1)
00072 z_summ(2) = z_summ(2) + z_vec(2)
00073 z_summ(3) = z_summ(3) + z_vec(3)
00074 z_summ(4) = z_summ(4) + z_vec(4)
00075
00076 call t1(p4,p3,p1,p2,z_vec)
00077 z_summ(1) = z_summ(1) + z_vec(1)
00078 z_summ(2) = z_summ(2) + z_vec(2)
00079 z_summ(3) = z_summ(3) + z_vec(3)
00080 z_summ(4) = z_summ(4) + z_vec(4)
00081
00082
00083
00084
00085
00086
00087 call t2(p2,p1,p3,p4,z_vec)
00088 z_summ(1) = z_summ(1) + z_vec(1)
00089 z_summ(2) = z_summ(2) + z_vec(2)
00090 z_summ(3) = z_summ(3) + z_vec(3)
00091 z_summ(4) = z_summ(4) + z_vec(4)
00092
00093 call t2(p3,p1,p2,p4,z_vec)
00094 z_summ(1) = z_summ(1) + z_vec(1)
00095 z_summ(2) = z_summ(2) + z_vec(2)
00096 z_summ(3) = z_summ(3) + z_vec(3)
00097 z_summ(4) = z_summ(4) + z_vec(4)
00098
00099 call t2(p4,p1,p3,p2,z_vec)
00100 z_summ(1) = z_summ(1) + z_vec(1)
00101 z_summ(2) = z_summ(2) + z_vec(2)
00102 z_summ(3) = z_summ(3) + z_vec(3)
00103 z_summ(4) = z_summ(4) + z_vec(4)
00104
00105 call t2(p1,p2,p3,p4,z_vec)
00106 z_summ(1) = z_summ(1) - z_vec(1)
00107 z_summ(2) = z_summ(2) - z_vec(2)
00108 z_summ(3) = z_summ(3) - z_vec(3)
00109 z_summ(4) = z_summ(4) - z_vec(4)
00110
00111 call t2(p1,p3,p2,p4,z_vec)
00112 z_summ(1) = z_summ(1) - z_vec(1)
00113 z_summ(2) = z_summ(2) - z_vec(2)
00114 z_summ(3) = z_summ(3) - z_vec(3)
00115 z_summ(4) = z_summ(4) - z_vec(4)
00116
00117 call t2(p1,p4,p3,p2,z_vec)
00118 z_summ(1) = z_summ(1) - z_vec(1)
00119 z_summ(2) = z_summ(2) - z_vec(2)
00120 z_summ(3) = z_summ(3) - z_vec(3)
00121 z_summ(4) = z_summ(4) - z_vec(4)
00122
00123 elseif(MNUM.eq.1) then
00124
00125
00126 IF (IMOD.EQ.1) THEN
00127 call t1(p1,p2,p3,p4,z_vec)
00128 z_summ(1) = z_summ(1) + z_vec(1)
00129 z_summ(2) = z_summ(2) + z_vec(2)
00130 z_summ(3) = z_summ(3) + z_vec(3)
00131 z_summ(4) = z_summ(4) + z_vec(4)
00132
00133 call t1(p3,p2,p1,p4,z_vec)
00134 z_summ(1) = z_summ(1) + z_vec(1)
00135 z_summ(2) = z_summ(2) + z_vec(2)
00136 z_summ(3) = z_summ(3) + z_vec(3)
00137 z_summ(4) = z_summ(4) + z_vec(4)
00138
00139 call t1(p1,p3,p2,p4,z_vec)
00140 z_summ(1) = z_summ(1) + z_vec(1)
00141 z_summ(2) = z_summ(2) + z_vec(2)
00142 z_summ(3) = z_summ(3) + z_vec(3)
00143 z_summ(4) = z_summ(4) + z_vec(4)
00144
00145 call t1(p3,p1,p2,p4,z_vec)
00146 z_summ(1) = z_summ(1) + z_vec(1)
00147 z_summ(2) = z_summ(2) + z_vec(2)
00148 z_summ(3) = z_summ(3) + z_vec(3)
00149 z_summ(4) = z_summ(4) + z_vec(4)
00150
00151 call t1(p4,p3,p1,p2,z_vec)
00152 z_summ(1) = z_summ(1) + z_vec(1)
00153 z_summ(2) = z_summ(2) + z_vec(2)
00154 z_summ(3) = z_summ(3) + z_vec(3)
00155 z_summ(4) = z_summ(4) + z_vec(4)
00156
00157 call t1(p4,p1,p3,p2,z_vec)
00158 z_summ(1) = z_summ(1) + z_vec(1)
00159 z_summ(2) = z_summ(2) + z_vec(2)
00160 z_summ(3) = z_summ(3) + z_vec(3)
00161 z_summ(4) = z_summ(4) + z_vec(4)
00162
00163
00164
00165
00166
00167
00168 call t2(p4,p3,p1,p2,z_vec)
00169 z_summ(1) = z_summ(1) + z_vec(1)
00170 z_summ(2) = z_summ(2) + z_vec(2)
00171 z_summ(3) = z_summ(3) + z_vec(3)
00172 z_summ(4) = z_summ(4) + z_vec(4)
00173
00174 call t2(p4,p1,p3,p2,z_vec)
00175 z_summ(1) = z_summ(1) + z_vec(1)
00176 z_summ(2) = z_summ(2) + z_vec(2)
00177 z_summ(3) = z_summ(3) + z_vec(3)
00178 z_summ(4) = z_summ(4) + z_vec(4)
00179
00180 call t2(p3,p4,p1,p2,z_vec)
00181 z_summ(1) = z_summ(1) - z_vec(1)
00182 z_summ(2) = z_summ(2) - z_vec(2)
00183 z_summ(3) = z_summ(3) - z_vec(3)
00184 z_summ(4) = z_summ(4) - z_vec(4)
00185
00186 call t2(p1,p4,p3,p2,z_vec)
00187 z_summ(1) = z_summ(1) - z_vec(1)
00188 z_summ(2) = z_summ(2) - z_vec(2)
00189 z_summ(3) = z_summ(3) - z_vec(3)
00190 z_summ(4) = z_summ(4) - z_vec(4)
00191
00192
00193
00194 ELSEIF (IMOD.EQ.7) THEN
00195
00196 call t3(p1,p2,p3,p4,z_vec)
00197 z_summ(1) = z_summ(1) + z_vec(1)
00198 z_summ(2) = z_summ(2) + z_vec(2)
00199 z_summ(3) = z_summ(3) + z_vec(3)
00200 z_summ(4) = z_summ(4) + z_vec(4)
00201
00202 call t3(p3,p2,p1,p4,z_vec)
00203 z_summ(1) = z_summ(1) + z_vec(1)
00204 z_summ(2) = z_summ(2) + z_vec(2)
00205 z_summ(3) = z_summ(3) + z_vec(3)
00206 z_summ(4) = z_summ(4) + z_vec(4)
00207
00208 call t3(p1,p3,p2,p4,z_vec)
00209 z_summ(1) = z_summ(1) - z_vec(1)
00210 z_summ(2) = z_summ(2) - z_vec(2)
00211 z_summ(3) = z_summ(3) - z_vec(3)
00212 z_summ(4) = z_summ(4) - z_vec(4)
00213
00214 call t3(p3,p1,p2,p4,z_vec)
00215 z_summ(1) = z_summ(1) - z_vec(1)
00216 z_summ(2) = z_summ(2) - z_vec(2)
00217 z_summ(3) = z_summ(3) - z_vec(3)
00218 z_summ(4) = z_summ(4) - z_vec(4)
00219
00220 call t3(p1,p4,p3,p2,z_vec)
00221 z_summ(1) = z_summ(1) - z_vec(1)
00222 z_summ(2) = z_summ(2) - z_vec(2)
00223 z_summ(3) = z_summ(3) - z_vec(3)
00224 z_summ(4) = z_summ(4) - z_vec(4)
00225
00226 call t3(p3,p4,p1,p2,z_vec)
00227 z_summ(1) = z_summ(1) - z_vec(1)
00228 z_summ(2) = z_summ(2) - z_vec(2)
00229 z_summ(3) = z_summ(3) - z_vec(3)
00230 z_summ(4) = z_summ(4) - z_vec(4)
00231
00232 ENDIF
00233
00234 else
00235 go to 910
00236 endif
00237 ssqrt=sqrt(ss2)
00238 ss=ss2
00239
00240 if (MNUM.eq.1) then
00241
00242 if(IMOD.eq.1) then
00243
00244
00245 factor= fit_a1_1(ssqrt) * 76.565033643843D0*
00246 $ sqrt(0.71709*ssqrt-0.27505)*invMrho4/ssqrt
00247 elseif(IMOD.eq.7) then
00248
00249
00250 factor= fit_om_1(ssqrt) * 886.837943974463D0 *
00251 $ sqrt(0.70983*ssqrt-0.26689)*invMrho4/ssqrt
00252 else
00253 write(*,*)' Wrong IMOD=',IMOD,' !'
00254 stop
00255 endif
00256
00257 elseif(MNUM.eq.2) then
00258
00259
00260 factor= fit_2(ssqrt) * 96.867161854922D0* ZFA1TAB(ss)*
00261 $ sqrt(0.70907*ssqrt-0.26413)*invMrho4/ssqrt
00262
00263 else
00264
00265 write(*,*)' WRONG MNUM ! MNUM=',MNUM
00266 stop
00267
00268 endif
00269 do i=1,4
00270 z_summ(i) = z_summ(i)*factor
00271 enddo
00272 DO I=1,4
00273 HADCUR(I)=Z_SUMM(I)
00274 ENDDO
00275 call LATA(-1,p1,p2,p3,p4)
00276 RETURN
00277 910 PRINT 9100
00278 9100 FORMAT(' ----- WRONG VALUE OF MNUM ')
00279 STOP
00280 END
00281
00282 subroutine t1(p1,p2,p3,p4,z_vec)
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292 IMPLICIT none
00293 INTEGER i,jnpi
00294
00295 real p1(4),p2(4),p3(4),p4(4),pa(4)
00296
00297 complex*16 z_vec(4),z_ee
00298 Complex*16 Z_a1,Z_rho
00299 Complex*16 Z_da1,Z_drho,fcom
00300
00301 real*8 AMass_Rho,Gamma_Rho
00302 common /zrho_pool/ AMass_Rho,Gamma_Rho
00303 real*8 AMass_A,Gamma_A,Scale_A
00304 Complex*16 DSigma_A
00305 common /za1p_pool/ AMass_A,Gamma_A,Scale_A,DSigma_A
00306
00307 real*8 sa,fs,scalar
00308 real*8 PPp1,p4Pp1,p3Pp1,p3P,p4P,p1p3,p1p4
00309
00310
00311 Z_rho = z_drho(p3,p4)
00312 Pa(1)=p1(1)+p2(1)+p3(1)+p4(1)
00313 Pa(2)=p1(2)+p2(2)+p3(2)+p4(2)
00314 Pa(3)=p1(3)+p2(3)+p3(3)+p4(3)
00315 Pa(4)=p1(4)+p2(4)+p3(4)+p4(4)
00316
00317 sa = (pa(1)-p1(1))**2 - (pa(2)-p1(2))**2 -
00318 $ (pa(3)-p1(3))**2 - (pa(4)-p1(4))**2
00319
00320 Z_a1 = z_da1(sa)
00321
00322 fs = ((1.D0+AMass_A**2/Scale_A)/(1.D0+sa/Scale_A))**2
00323
00324 fcom = fs/(Z_a1*Z_rho)
00325
00326 PPp1 = scalar(pa,pa) - scalar(pa,p1)
00327 p4Pp1 = scalar(p4,pa) - scalar(p4,p1)
00328 p3Pp1 = scalar(p3,pa) - scalar(p3,p1)
00329 p3P = scalar(p3,pa)
00330 p4P = scalar(p4,pa)
00331 p1p3 = scalar(p1,p3)
00332 p1p4 = scalar(p1,p4)
00333
00334 do i=1,4
00335 z_vec(i) = fcom*(PPp1*(p3(i)*p4Pp1 - p4(i)*p3Pp1) +
00336 $ (pa(i) - p1(i))*(p3P*p1p4-p4P*p1p3))
00337 enddo
00338
00339 z_ee=z_vec(1)
00340 do i=1,3
00341 z_vec(i) = z_vec(i+1)
00342 enddo
00343 z_vec(4)= z_ee
00344 end
00345
00346 subroutine t2(p1,p2,p3,p4,z_vec)
00347
00348
00349
00350
00351
00352
00353
00354
00355 IMPLICIT none
00356 INTEGER i
00357
00358 real p1(4),p2(4),p3(4),p4(4),pa(4)
00359
00360 complex*16 z_vec(4),z_ee
00361 Complex*16 Z_a1,Z_sgm,fcom
00362 Complex*16 Z_da1,Z_dsigma
00363
00364 real*8 AMass_Rho,Gamma_Rho
00365 common /zrho_pool/ AMass_Rho,Gamma_Rho
00366
00367 real*8 AMass_A,Gamma_A,Scale_A
00368 Complex*16 DSigma_A
00369 common /za1p_pool/ AMass_A,Gamma_A,Scale_A,DSigma_A
00370
00371 real*8 sa,fs,scalar
00372 real*8 PPp1,p2P
00373
00374 Z_sgm = z_dsigma(p3,p4)
00375
00376 Pa(1)=p1(1)+p2(1)+p3(1)+p4(1)
00377 Pa(2)=p1(2)+p2(2)+p3(2)+p4(2)
00378 Pa(3)=p1(3)+p2(3)+p3(3)+p4(3)
00379 Pa(4)=p1(4)+p2(4)+p3(4)+p4(4)
00380
00381 sa = (pa(1)-p1(1))**2 - (pa(2)-p1(2))**2 -
00382 $ (pa(3)-p1(3))**2 - (pa(4)-p1(4))**2
00383 Z_a1 = z_da1(sa)
00384
00385
00386
00387 fs = ((1.D0+AMass_A**2/Scale_A)/(1.D0+sa/Scale_A))**2
00388
00389 fcom = fs*DSigma_A/(Z_a1*Z_sgm)*sa
00390
00391 PPp1 = scalar(pa,pa) - scalar(pa,p1)
00392 p2P = scalar(p2,pa)
00393 do i = 1,4
00394 z_vec(i) = fcom*(p2(i)*PPp1 + (p1(i)-pa(i))*p2P)
00395 enddo
00396
00397 z_ee=z_vec(1)
00398 do i=1,3
00399 z_vec(i) = z_vec(i+1)
00400 enddo
00401 z_vec(4)= z_ee
00402 end
00403
00404 real*8 function scalar(a,b)
00405
00406 real a(4),b(4)
00407 scalar = a(1)*b(1)-a(2)*b(2)-a(3)*b(3)-a(4)*b(4)
00408 end
00409
00410
00411
00412
00413 complex*16 function z_da1(sa_q)
00414
00415
00416
00417
00418
00419
00420
00421 implicit none
00422
00423 real*8 AMass_A,Gamma_A,Scale_A
00424 Complex*16 DWave_A
00425 common /za1p_pool/ AMass_A,Gamma_A,Scale_A,DWave_A
00426
00427 integer ia1f
00428 real*8 ama1,gma1,gmv0
00429
00430 real*8 sa_q,pm,pm0
00431 real*8 gma1v
00432
00433 data ia1f/0/
00434 data Gamma_A /0.45D0/
00435 data AMass_A /1.23D0/
00436 data Scale_A /1.2D0/
00437 data DWave_A / (1.269D0,0.591D0) /
00438
00439
00440
00441 if(ia1f.eq.0) then
00442 ia1f = 1
00443
00444 ama1 = AMass_A**2
00445 gma1 = Gamma_A/AMass_A
00446 gmv0 = gma1v(ama1)
00447 endif
00448 pm0 = gmv0
00449 pm = gma1v(sa_q)
00450
00451
00452
00453 z_da1 = DCMPLX(sa_q/ama1-1.D0,gma1*pm/pm0)
00454 end
00455
00456 double precision function gma1v(X2)
00457
00458
00459 implicit none
00460
00461 real*8 AMass_A,Gamma_A,Scale_A
00462 Complex*16 Z
00463 common /za1p_pool/ AMass_A,Gamma_A,Scale_A,Z
00464
00465 real*8 fs
00466 REAL*8 X2,DELTA,GA1MY
00467 INTEGER I
00468 REAL*8 S(100),INTE(100),INT_ABS(100),INT_RE(100),INT_IM(100)
00469 DATA S/0.17531806E+00,0.20062977E+00,0.22594148E+00,0.25125318E+00,
00470 #0.27656489E+00,0.30187660E+00,0.32718830E+00,0.35250001E+00,0.37781172E+00,0.40312342E+00,
00471 #0.42843513E+00,0.45374684E+00,0.47905854E+00,0.50437025E+00,0.52968195E+00,0.55499366E+00,
00472 #0.58030537E+00,0.60561707E+00,0.63092878E+00,0.65624049E+00,0.68155219E+00,0.70686390E+00,
00473 #0.73217561E+00,0.75748731E+00,0.78279902E+00,0.80811073E+00,0.83342243E+00,0.85873414E+00,
00474 #0.88404585E+00,0.90935755E+00,0.93466926E+00,0.95998096E+00,0.98529267E+00,0.10106044E+01,
00475 #0.10359161E+01,0.10612278E+01,0.10865395E+01,0.11118512E+01,0.11371629E+01,0.11624746E+01,
00476 #0.11877863E+01,0.12130980E+01,0.12384097E+01,0.12637214E+01,0.12890331E+01,0.13143449E+01,
00477 #0.13396566E+01,0.13649683E+01,0.13902800E+01,0.14155917E+01,0.14409034E+01,0.14662151E+01,
00478 #0.14915268E+01,0.15168385E+01,0.15421502E+01,0.15674619E+01,0.15927736E+01,0.16180853E+01,
00479 #0.16433970E+01,0.16687087E+01,0.16940205E+01,0.17193322E+01,0.17446439E+01,0.17699556E+01,
00480 #0.17952673E+01,0.18205790E+01,0.18458907E+01,0.18712024E+01,0.18965141E+01,0.19218258E+01,
00481 #0.19471375E+01,0.19724492E+01,0.19977609E+01,0.20230726E+01,0.20483843E+01,0.20736960E+01,
00482 #0.20990078E+01,0.21243195E+01,0.21496312E+01,0.21749429E+01,0.22002546E+01,0.22255663E+01,
00483 #0.22508780E+01,0.22761897E+01,0.23015014E+01,0.23268131E+01,0.23521248E+01,0.23774365E+01,
00484 #0.24027482E+01,0.24280599E+01,0.24533716E+01,0.24786834E+01,0.25039951E+01,0.25293068E+01,
00485 #0.25546185E+01,0.25799302E+01,0.26052419E+01,0.26305536E+01,0.26558653E+01,0.26811770E+01/
00486 DATA INTE/0.00000000E+00,0.19835316E-09,0.17277872E-08,0.63260250E-08,
00487 #0.16228446E-07,0.34254199E-07,0.63924158E-07,0.10961715E-06,0.17677484E-06,0.27217027E-06,
00488 #0.40426145E-06,0.58366008E-06,0.82375764E-06,0.11415688E-05,0.15588754E-05,0.21037881E-05,
00489 #0.28128794E-05,0.37340827E-05,0.49305520E-05,0.64855462E-05,0.85079467E-05,0.11136565E-04,
00490 #0.14538578E-04,0.18892731E-04,0.24346357E-04,0.30949160E-04,0.38601580E-04,0.47069702E-04,
00491 #0.56065745E-04,0.65330521E-04,0.74672459E-04,0.83967396E-04,0.93142038E-04,0.10215726E-03,
00492 #0.11099490E-03,0.11964932E-03,0.12812206E-03,0.13641877E-03,0.14454677E-03,0.15251471E-03,
00493 #0.16033133E-03,0.16800535E-03,0.17554509E-03,0.18295843E-03,0.19025283E-03,0.19743618E-03,
00494 #0.20451223E-03,0.21148974E-03,0.21837340E-03,0.22516843E-03,0.23187967E-03,0.23851165E-03,
00495 #0.24506849E-03,0.25155433E-03,0.25797236E-03,0.26432627E-03,0.27061916E-03,0.27685378E-03,
00496 #0.28303336E-03,0.28916027E-03,0.29523695E-03,0.30126590E-03,0.30724868E-03,0.31318791E-03,
00497 #0.31908532E-03,0.32494289E-03,0.33076174E-03,0.33654407E-03,0.34229119E-03,0.34800456E-03,
00498 #0.35368553E-03,0.35933539E-03,0.36495540E-03,0.37054666E-03,0.37611031E-03,0.38164760E-03,
00499 #0.38715892E-03,0.39264583E-03,0.39810880E-03,0.40354939E-03,0.40896773E-03,0.41436490E-03,
00500 #0.41974145E-03,0.42509830E-03,0.43043607E-03,0.43575541E-03,0.44105696E-03,0.44634150E-03,
00501 #0.45160906E-03,0.45686072E-03,0.46209683E-03,0.46731790E-03,0.47252442E-03,0.47771686E-03,
00502 #0.48289566E-03,0.48806125E-03,0.49321407E-03,0.49835450E-03,0.50348292E-03,0.50859971E-03/
00503 DATA INT_ABS/0.00000000E+00,0.21066009E-09,0.16564992E-08,0.55359496E-08,
00504 #0.13052891E-07,0.25435346E-07,0.43943074E-07,0.69871482E-07,0.10455410E-06,0.14936437E-06,
00505 #0.20571712E-06,0.27506977E-06,0.35892330E-06,0.45882244E-06,0.57635873E-06,0.71316741E-06,
00506 #0.87092972E-06,0.10513722E-05,0.12562662E-05,0.14874272E-05,0.17467133E-05,0.20360241E-05,
00507 #0.23572986E-05,0.27125129E-05,0.31036774E-05,0.35328342E-05,0.40020531E-05,0.45134287E-05,
00508 #0.50690759E-05,0.56711263E-05,0.63217233E-05,0.70230186E-05,0.77771640E-05,0.85863202E-05,
00509 #0.94526337E-05,0.10378245E-04,0.11365281E-04,0.12415854E-04,0.13532054E-04,0.14715952E-04,
00510 #0.15969588E-04,0.17294974E-04,0.18694106E-04,0.20168926E-04,0.21721372E-04,0.23353312E-04,
00511 #0.25066665E-04,0.26863051E-04,0.28744432E-04,0.30712501E-04,0.32768956E-04,0.34915462E-04,
00512 #0.37153651E-04,0.39485116E-04,0.41911400E-04,0.44434054E-04,0.47054555E-04,0.49774355E-04,
00513 #0.52594877E-04,0.55517507E-04,0.58543603E-04,0.61674489E-04,0.64911460E-04,0.68255782E-04,
00514 #0.71708689E-04,0.75271391E-04,0.78945069E-04,0.82730875E-04,0.86629940E-04,0.90643366E-04,
00515 #0.94772202E-04,0.99017560E-04,0.10338045E-03,0.10786187E-03,0.11246282E-03,0.11718426E-03,
00516 #0.12204385E-03,0.12699238E-03,0.13208090E-03,0.13729358E-03,0.14263128E-03,0.14809487E-03,
00517 #0.15368518E-03,0.15940303E-03,0.16524921E-03,0.17122452E-03,0.17732972E-03,0.18356558E-03,
00518 #0.18993282E-03,0.19643219E-03,0.20306438E-03,0.20983011E-03,0.21673005E-03,0.22376489E-03,
00519 #0.23093528E-03,0.23824187E-03,0.24568530E-03,0.25326619E-03,0.26098517E-03,0.26884283E-03/
00520 DATA INT_RE/0.00000000E+00,-.38711044E-09,-.30791558E-08,-.10445232E-07,
00521 #-.25062489E-07,-.49803729E-07,-.87911341E-07,-.14307792E-06,-.21954305E-06,-.32221399E-06,
00522 #-.45681885E-06,-.63010309E-06,-.85008368E-06,-.11263793E-05,-.14706404E-05,-.18971082E-05,
00523 #-.24233327E-05,-.30710710E-05,-.38673463E-05,-.48455316E-05,-.60460375E-05,-.75155863E-05,
00524 #-.93030466E-05,-.11448885E-04,-.13966772E-04,-.16823546E-04,-.19934441E-04,-.23185919E-04,
00525 #-.26472191E-04,-.29719254E-04,-.32887419E-04,-.35962204E-04,-.38944230E-04,-.41841471E-04,
00526 #-.44665024E-04,-.47426566E-04,-.50137251E-04,-.52807218E-04,-.55445447E-04,-.58059837E-04,
00527 #-.60657047E-04,-.63242968E-04,-.65822615E-04,-.68400294E-04,-.70979704E-04,-.73564030E-04,
00528 #-.76155632E-04,-.78758044E-04,-.81372163E-04,-.84000166E-04,-.86643611E-04,-.89303861E-04,
00529 #-.91982105E-04,-.94679390E-04,-.97396632E-04,-.10013464E-03,-.10289412E-03,-.10567554E-03,
00530 #-.10847991E-03,-.11130726E-03,-.11415800E-03,-.11703298E-03,-.11993205E-03,-.12285565E-03,
00531 #-.12580402E-03,-.12877720E-03,-.13177591E-03,-.13479977E-03,-.13784908E-03,-.14092395E-03,
00532 #-.14402448E-03,-.14715072E-03,-.15030274E-03,-.15348058E-03,-.15668426E-03,-.15991379E-03,
00533 #-.16316917E-03,-.16645040E-03,-.16975745E-03,-.17309031E-03,-.17644893E-03,-.17983303E-03,
00534 #-.18324331E-03,-.18667896E-03,-.19014018E-03,-.19362689E-03,-.19713905E-03,-.20067656E-03,
00535 #-.20423936E-03,-.20782708E-03,-.21144049E-03,-.21507866E-03,-.21874178E-03,-.22242976E-03,
00536 #-.22614252E-03,-.22987995E-03,-.23364196E-03,-.23742846E-03,-.24123935E-03,-.24507452E-03/
00537 DATA INT_IM/0.00000000E+00,0.12002091E-09,0.12850209E-08,0.51141443E-08,
00538 #0.13632230E-07,0.29227933E-07,0.54655557E-07,0.93051069E-07,0.14795445E-06,0.22333412E-06,
00539 #0.32360920E-06,0.45366352E-06,0.61884173E-06,0.82491108E-06,0.10779615E-05,0.13841975E-05,
00540 #0.17495437E-05,0.21789224E-05,0.26750078E-05,0.32360835E-05,0.38525487E-05,0.45015863E-05,
00541 #0.51400771E-05,0.56980360E-05,0.60787180E-05,0.61747611E-05,0.59005563E-05,0.52216022E-05,
00542 #0.41575455E-05,0.27611998E-05,0.10942719E-05,-.78733816E-06,-.28386020E-05,-.50252585E-05,
00543 #-.73219124E-05,-.97098783E-05,-.12175421E-04,-.14708367E-04,-.17301124E-04,-.19947904E-04,
00544 #-.22644299E-04,-.25386852E-04,-.28172810E-04,-.30999930E-04,-.33866347E-04,-.36770471E-04,
00545 #-.39710918E-04,-.42686461E-04,-.45695990E-04,-.48738489E-04,-.51813066E-04,-.54918732E-04,
00546 #-.58054706E-04,-.61220193E-04,-.64414436E-04,-.67636711E-04,-.70886320E-04,-.74162594E-04,
00547 #-.77464884E-04,-.80792567E-04,-.84145039E-04,-.87521715E-04,-.90922031E-04,-.94345438E-04,
00548 #-.97791406E-04,-.10125942E-03,-.10474898E-03,-.10825960E-03,-.11179082E-03,-.11534217E-03,
00549 #-.11891322E-03,-.12250352E-03,-.12611268E-03,-.12974120E-03,-.13338592E-03,-.13704922E-03,
00550 #-.14072981E-03,-.14442733E-03,-.14814143E-03,-.15187176E-03,-.15561799E-03,-.15937980E-03,
00551 #-.16315687E-03,-.16694889E-03,-.17075556E-03,-.17457660E-03,-.17841171E-03,-.18226185E-03,
00552 #-.18612432E-03,-.19000007E-03,-.19388755E-03,-.19778906E-03,-.20170309E-03,-.20562942E-03,
00553 #-.20956779E-03,-.21351800E-03,-.21747982E-03,-.22145304E-03,-.22543745E-03,-.22943284E-03/
00554
00555 DELTA = S(2)-S(1)
00556 I = INT((X2-S(1))/DELTA) + 1
00557
00558 GA1MY = INTE(I) + (INTE(I+1)-INTE(I))/DELTA*(X2-S(I))
00559 GA1MY = GA1MY + ABS(Z)**2 * (INT_ABS(I) + (INT_ABS(I+1)-INT_ABS(I))/DELTA*(X2-S(I)))
00560 GA1MY = GA1MY + DBLE(Z)* (INT_RE(I) + (INT_RE(I+1)-INT_RE(I))/DELTA*(X2-S(I)))
00561 GA1MY = GA1MY + DIMAG(Z)*(INT_IM(I) + (INT_IM(I+1)-INT_IM(I))/DELTA*(X2-S(I)))
00562
00563 fs = ((1.D0+AMass_A**2/Scale_A)/(1.D0+X2/Scale_A))**2
00564 gma1v=fs*GA1MY
00565 end
00566
00567 complex*16 function z_dsigma(p1,p2)
00568
00569
00570
00571
00572
00573 implicit none
00574
00575 real*8 AMass_S,Gamma_S
00576
00577 real p1(4),p2(4)
00578 real*8 ps1,ps2,am2_1,am2_2,as,d1,d2,dsq,pm,pm0,dd,am12
00579 real*8 am1,am2
00580
00581 data Gamma_S /0.8D0/
00582 data AMass_S /0.8D0/
00583
00584 ps1 = p1(2)**2+p1(3)**2+p1(4)**2
00585 ps2 = p2(2)**2+p2(3)**2+p2(4)**2
00586
00587 am2_1 = p1(1)**2-ps1
00588 am2_2 = p2(1)**2-ps2
00589
00590 am12 = p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3)-p1(4)*p2(4)
00591 as = am2_1+am2_2+2.D0*am12
00592
00593 am1 = sqrt(am2_1)
00594 am2 = sqrt(am2_2)
00595 d1 = 1.D0-(am1+am2)**2/as
00596 d2 = 1.D0-(am1-am2)**2/as
00597 dd = max(d1*d2,1.D-16)
00598
00599 dsq = sqrt(dd)
00600 pm = dsq
00601
00602 d1 = 1.D0-(am1+am2)**2/AMass_S**2
00603 d2 = 1.D0-(am1-am2)**2/AMass_S**2
00604 dd = d1*d2
00605 dsq = sqrt(dd)
00606 pm0 = dsq
00607
00608 z_dsigma = DCMPLX(as/AMass_S**2-1.D0,Gamma_S/AMass_S*pm/pm0)
00609 end
00610
00611 complex*16 function z_drho(p1,p2)
00612
00613
00614
00615
00616 implicit none
00617 real p1(4),p2(4)
00618
00619 real*8 AMass_Rho,Gamma_Rho,ampi,s,g,GamMas,dm
00620 common /zrho_pool/ AMass_Rho,Gamma_Rho
00621
00622 Parameter (ampi=.13957D0)
00623
00624 g(s) = sqrt(MAX((s-4.*ampi**2)**3/s,0.d0))
00625
00626 s = (p1(1)+p2(1))**2 -(p1(2)+p2(2))**2-(p1(3)+p2(3))**2-
00627 # (p1(4)+p2(4))**2
00628
00629 GamMas = Gamma_Rho*AMass_Rho
00630 z_drho = COMPLEX(s-AMass_Rho**2-dm(s)*GamMas,GamMas*g(s)/g(AMass_Rho**2))
00631 z_drho = z_drho / AMass_Rho**2
00632 z_drho = z_drho /(1.+ Gamma_Rho/AMass_Rho*dm(0.d0))
00633 end
00634
00635 real*8 function dm(s)
00636
00637 implicit none
00638 real*8 s,m2,gm2,hrho,dhrho
00639 real*8 ampi,pi
00640 real*8 AMass_Rho,Gamma_Rho
00641 common /zrho_pool/ AMass_Rho,Gamma_Rho
00642 Parameter (ampi=.13957D0)
00643 Parameter (pi=3.1415926D0)
00644
00645 m2 = AMass_Rho**2
00646 gm2=m2*(sqrt(1.D0-(2.D0*ampi)**2/m2))**3
00647 dm = (hrho(s)-hrho(m2)-(s-m2)*dhrho(m2))/gm2
00648 end
00649 real*8 function hrho(s)
00650
00651 implicit none
00652 real*8 s,pi,ampi,y,w
00653 Parameter (ampi=.13957D0)
00654 Parameter (pi=3.1415926D0)
00655
00656 if (s.eq.0.d0) then
00657 hrho = -2.d0*4.d0*ampi**2/pi
00658 else
00659 y=1.d0-4.d0*ampi**2/s
00660 y = sqrt(max(0.d0,y))
00661 w = y*log((1.d0+y)/(1.d0-y))
00662 hrho = w*(s-4.d0*ampi**2)/pi
00663 endif
00664 end
00665 real*8 function dhrho(s)
00666
00667
00668 implicit none
00669 real*8 s,pi,ampi,y,a,w,dy
00670 Parameter (ampi=.13957D0)
00671 Parameter (pi=3.1415926D0)
00672
00673 y=1.d0-4.d0*ampi**2/s
00674 y = sqrt(max(0.d0,y))
00675 a = log((1.d0+y)/(1.d0-y))
00676 w = y*a
00677 dy= 4.d0*ampi**2/2.d0/s/y
00678 dhrho = (w + (dy*a+1.d0)*y**2)/pi
00679 end
00680
00681 subroutine LATA(key,p1,p2,p3,p4)
00682
00683 real ee1,ee2,ee3,ee4,p1(4),p2(4),p3(4),p4(4)
00684 integer key
00685 if (key.eq.1) then
00686
00687 ee1=p1(4)
00688 ee2=p2(4)
00689 ee3=p3(4)
00690 ee4=p4(4)
00691 do i=3,1,-1
00692 p1(i+1)=p1(i)
00693 p2(i+1)=p2(i)
00694 p3(i+1)=p3(i)
00695 p4(i+1)=p4(i)
00696 enddo
00697 p1(1)=ee1
00698 p2(1)=ee2
00699 p3(1)=ee3
00700 p4(1)=ee4
00701 else
00702 ee1=p1(1)
00703 ee2=p2(1)
00704 ee3=p3(1)
00705 ee4=p4(1)
00706 do i=1,3
00707 p1(i)=p1(i+1)
00708 p2(i)=p2(i+1)
00709 p3(i)=p3(i+1)
00710 p4(i)=p4(i+1)
00711 enddo
00712 p1(4)=ee1
00713 p2(4)=ee2
00714 p3(4)=ee3
00715 p4(4)=ee4
00716 endif
00717 end
00718 subroutine t3(p1,p2,p3,p4,z_vec)
00719
00720
00721
00722
00723
00724
00725
00726 IMPLICIT none
00727
00728 INTEGER i
00729 real p1(4),p2(4),p3(4),p4(4),PA(4)
00730
00731 real*8 scalar,Pp2,Pp3,Pp4,p1p2,p1p3,p1p4
00732 complex*16 z_vec(4),z_ee
00733 Complex*16 Z_a1,Z_rho
00734 Complex*16 Z_domega,Z_drho,fcom,zmix
00735
00736 real*8 AMass_Rho,Gamma_Rho
00737 common /zrho_pool/ AMass_Rho,Gamma_Rho
00738 real*8 som,fs
00739
00740 zmix=DCMPLX(1.D0,0.D0)
00741
00742 Z_rho = z_drho(p3,p4)
00743 Pa(1)=p1(1)+p2(1)+p3(1)+p4(1)
00744 Pa(2)=p1(2)+p2(2)+p3(2)+p4(2)
00745 Pa(3)=p1(3)+p2(3)+p3(3)+p4(3)
00746 Pa(4)=p1(4)+p2(4)+p3(4)+p4(4)
00747
00748 som = (pa(1)-p1(1))**2 - (pa(2)-p1(2))**2 -
00749 $ (pa(3)-p1(3))**2 - (pa(4)-p1(4))**2
00750
00751 fs = 1.0D0
00752 Z_a1 = z_domega(som)
00753
00754 fcom = fs/(Z_a1*Z_rho)
00755 Pp2 = scalar(pa,p2)
00756 Pp3 = scalar(pa,p3)
00757 Pp4 = scalar(pa,p4)
00758 p1p2= scalar(p1,p2)
00759 p1p3= scalar(p1,p3)
00760 p1p4= scalar(p1,p4)
00761 do i=1,4
00762 z_vec(i)=fcom*(p2(i)*(Pp3*p1p4-Pp4*p1p3)-Pp2*(p3(i)*p1p4-
00763 $ p4(i)*p1p3) + p1p2*(p3(i)*Pp4-p4(i)*Pp3)) * zmix
00764 enddo
00765
00766 z_ee=z_vec(1)
00767 do i=1,3
00768 z_vec(i) = z_vec(i+1)
00769 enddo
00770 z_vec(4)= z_ee
00771 end
00772
00773 complex*16 function z_domega(som)
00774
00775
00776
00777
00778
00779
00780 implicit none
00781 real*8 AMass_O,Gamma_O
00782 real*8 som,gom,gomega
00783 common /omega/AMass_O
00784
00785 data Gamma_O /0.00841D0/
00786 data AMass_O /0.782D0/
00787
00788 gom = gomega(sqrt(som))
00789 z_domega = DCMPLX(som/(AMass_O**2)-1.D0,Gamma_O/AMass_O*gom)
00790 end
00791 real*8 function gomega(x)
00792
00793 implicit none
00794 real*8 x
00795 real*8 AMass_O,PAR(10)
00796 common /omega/AMass_O
00797 data par/17.5598888d0,141.110153d0,894.884460d0,4977.35107d0,
00798 #7610.65625d0,-42524.4062d0,-1333.26282d0,4860.18799d0,
00799 #-6000.80908d0,2504.97461d0/
00800 if (x.le.1.) then
00801 gomega = 1. + par(1)*(x-0.782)+par(2)*(x-0.782)**2
00802 # +par(3)*(x-0.782)**3+par(4)*(x-0.782)**4+par(5)*(x-0.782)**5
00803 # +par(6)*(x-0.782)**6
00804 else
00805 gomega = par(7)+par(8)*x+par(9)*x**2+par(10)*x**3
00806 endif
00807 gomega = max(0.d0,gomega)
00808 end
00809
00810 REAL FUNCTION ZFA1TAB(Q2)
00811
00812
00813
00814 IMPLICIT NONE
00815 INTEGER I
00816 REAL*8 DELTA
00817 REAL Q2
00818 REAL S(100),VAL(100)
00819 SAVE S,VAL
00820 DATA S/ 0.2916000,0.3206586,0.3497172,0.3787757,
00821 # 0.4078344,0.4368929,0.4659515,0.4950101,0.5240687,0.5531273,
00822 # 0.5821859,0.6112444,0.6403030,0.6693616,0.6984202,0.7274788,
00823 # 0.7565374,0.7855960,0.8146545,0.8437131,0.8727717,0.9018303,
00824 # 0.9308889,0.9599475,0.9890060,1.0180646,1.0471232,1.0761818,
00825 # 1.1052403,1.1342990,1.1633576,1.1924162,1.2214748,1.2505333,
00826 # 1.2795919,1.3086505,1.3377091,1.3667676,1.3958262,1.4248848,
00827 # 1.4539435,1.4830021,1.5120606,1.5411192,1.5701778,1.5992364,
00828 # 1.6282949,1.6573535,1.6864121,1.7154707,1.7445292,1.7735878,
00829 # 1.8026465,1.8317051,1.8607637,1.8898222,1.9188808,1.9479394,
00830 # 1.9769980,2.0060565,2.0351152,2.0641737,2.0932324,2.1222908,
00831 # 2.1513495,2.1804080,2.2094667,2.2385252,2.2675838,2.2966425,
00832 # 2.3257010,2.3547597,2.3838181,2.4128768,2.4419353,2.4709940,
00833 # 2.5000525,2.5291111,2.5581696,2.5872283,2.6162868,2.6453454,
00834 # 2.6744041,2.7034626,2.7325213,2.7615798,2.7906384,2.8196969,
00835 # 2.8487556,2.8778141,2.9068727,2.9359312,2.9649899,2.9940486,
00836 # 3.0231071,3.0521657,3.0812242,3.1102829,3.1393414,3.1684000/
00837 DATA VAL/ 2.0261996,2.2349865,2.4839740,2.7840748,
00838 # 3.1488798,3.5936222,4.1301847,4.7517977,5.3984838,5.9147439,
00839 # 6.0864558,5.8283591,5.2841811,4.6615186,4.0839195,3.5914702,
00840 # 3.1841860,2.8494759,2.5732665,2.3434010,2.1502059,1.9862038,
00841 # 1.8456544,1.7241427,1.6182493,1.5253036,1.4432002,1.3702650,
00842 # 1.3051554,1.2467849,1.1942677,1.1468738,1.1039963,1.0651271,
00843 # 1.0298390,0.9977714,0.9686196,0.9421255,0.9180685,0.8962603,
00844 # 0.8765374,0.8587573,0.8427927,0.8285285,0.8158574,0.8046767,
00845 # 0.7948853,0.7863811,0.7790571,0.7728010,0.7674922,0.7630011,
00846 # 0.7591889,0.7559078,0.7530031,0.7503147,0.7476809,0.7449428,
00847 # 0.7419487,0.7385587,0.7346500,0.7301207,0.7248930,0.7189151,
00848 # 0.7121620,0.7046344,0.6963565,0.6873729,0.6777444,0.6675445,
00849 # 0.6568548,0.6457604,0.6343476,0.6227004,0.6108983,0.5990148,
00850 # 0.5871165,0.5752623,0.5635037,0.5518846,0.5404415,0.5292045,
00851 # 0.5181981,0.5074410,0.4969472,0.4867267,0.4767860,0.4671288,
00852 # 0.4577557,0.4486661,0.4398569,0.4313242,0.4230627,0.4150662,
00853 # 0.4073282,0.3998415,0.3925985,0.3855914,0.3788125,0.3722538/
00854
00855
00856 DELTA = (S(100)-S(1))/99.D0
00857 I = INT((Q2-S(1))/DELTA) + 1
00858
00859 ZFA1TAB = VAL(I) + (VAL(I+1)-VAL(I))/(S(I+1)-S(I))*(Q2-S(I))
00860 END
00861
00862 REAL FUNCTION fit_a1_1(E)
00863
00864
00865
00866 IMPLICIT NONE
00867 INTEGER I
00868 REAL E,FIT
00869 REAL ARG(98),VAL(98)
00870 SAVE ARG,VAL
00871 DATA ARG/ 0.6000000,0.6131313,0.6262626,0.6393939,
00872 # 0.6525252,0.6656566,0.6787879,0.6919192,0.7050505,0.7181818,
00873 # 0.7313131,0.7444444,0.7575758,0.7707071,0.7838384,0.7969697,
00874 # 0.8101010,0.8232324,0.8363636,0.8494949,0.8626263,0.8757576,
00875 # 0.8888889,0.9020202,0.9151515,0.9282829,0.9414141,0.9545454,
00876 # 0.9676768,0.9808081,0.9939394,1.0070707,1.0202020,1.0333333,
00877 # 1.0464647,1.0595959,1.0727273,1.0858586,1.0989898,1.1121212,
00878 # 1.1252525,1.1383839,1.1515151,1.1646465,1.1777778,1.1909091,
00879 # 1.2040404,1.2171717,1.2303030,1.2434343,1.2565657,1.2696970,
00880 # 1.2828283,1.2959596,1.3090909,1.3222222,1.3353535,1.3484849,
00881 # 1.3616161,1.3747475,1.3878788,1.4010102,1.4141414,1.4272727,
00882 # 1.4404041,1.4535353,1.4666667,1.4797980,1.4929293,1.5060606,
00883 # 1.5191919,1.5323232,1.5454545,1.5585859,1.5717171,1.5848485,
00884 # 1.5979798,1.6111112,1.6242424,1.6373737,1.6505051,1.6636363,
00885 # 1.6767677,1.6898990,1.7030303,1.7161616,1.7292930,1.7424242,
00886 # 1.7555555,1.7686869,1.7818182,1.7949495,1.8080808,1.8212122,
00887 # 1.8343434,1.8474747,1.8606061,1.8737373/
00888 DATA VAL/ 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00889 # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00890 # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,13.1664906,
00891 #10.7234087, 8.8219614,10.7989664, 9.1883001, 7.8526378, 7.7481031,
00892 # 8.2633696, 5.5042820, 4.9029269, 4.4794345, 3.9654009, 4.5254011,
00893 # 3.6509495, 3.5005512, 3.2274280, 3.1808922, 2.9925177, 2.6886659,
00894 # 2.5195024, 2.4678771, 2.3540580, 2.2123868, 2.1103525, 2.0106986,
00895 # 1.8792295, 1.8250662, 1.7068460, 1.6442842, 1.5503920, 1.4814349,
00896 # 1.4225838, 1.3627135, 1.3205355, 1.2784383, 1.2387408, 1.1975995,
00897 # 1.1633024, 1.1318133, 1.1114354, 1.0951439, 1.0691465, 1.0602311,
00898 # 1.0392803, 1.0220672, 1.0154786, 1.0010130, 0.9908018, 0.9710845,
00899 # 0.9602382, 0.9488459, 0.9316537, 0.9118049, 0.8920435, 0.8719332,
00900 # 0.8520256, 0.8280582, 0.8064085, 0.7767881, 0.7570597, 0.7382626,
00901 # 0.7100251, 0.6846500, 0.6666913, 0.6372250, 0.6162248, 0.6007728,
00902 # 0.5799103, 0.5674670, 0.5446148, 0.5352115, 0.5128809, 0.4932536,
00903 # 0.5310397, 0.8566489, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00904 # 0.0000000, 0.0000000, 0.0000000, 0.0000000/
00905
00906 if (E.lt.0.6) then
00907 fit=0.
00908 elseif(E.lt.1.777) then
00909 do i=98,1,-1
00910 if (arg(i).le.E) goto 100
00911 enddo
00912 100 fit=val(i)+(val(i+1)-val(i))/(arg(i+1)-arg(i))*(E-arg(i))
00913 else
00914 fit=0.
00915 endif
00916 fit_a1_1=fit
00917 END
00918 REAL FUNCTION fit_om_1(E)
00919
00920
00921
00922 IMPLICIT NONE
00923 INTEGER I
00924 REAL E,FIT
00925 REAL ARG(98),VAL(98)
00926 SAVE ARG,VAL
00927 DATA ARG/ 0.6000000,0.6131313,0.6262626,0.6393939,
00928 # 0.6525252,0.6656566,0.6787879,0.6919192,0.7050505,0.7181818,
00929 # 0.7313131,0.7444444,0.7575758,0.7707071,0.7838384,0.7969697,
00930 # 0.8101010,0.8232324,0.8363636,0.8494949,0.8626263,0.8757576,
00931 # 0.8888889,0.9020202,0.9151515,0.9282829,0.9414141,0.9545454,
00932 # 0.9676768,0.9808081,0.9939394,1.0070707,1.0202020,1.0333333,
00933 # 1.0464647,1.0595959,1.0727273,1.0858586,1.0989898,1.1121212,
00934 # 1.1252525,1.1383839,1.1515151,1.1646465,1.1777778,1.1909091,
00935 # 1.2040404,1.2171717,1.2303030,1.2434343,1.2565657,1.2696970,
00936 # 1.2828283,1.2959596,1.3090909,1.3222222,1.3353535,1.3484849,
00937 # 1.3616161,1.3747475,1.3878788,1.4010102,1.4141414,1.4272727,
00938 # 1.4404041,1.4535353,1.4666667,1.4797980,1.4929293,1.5060606,
00939 # 1.5191919,1.5323232,1.5454545,1.5585859,1.5717171,1.5848485,
00940 # 1.5979798,1.6111112,1.6242424,1.6373737,1.6505051,1.6636363,
00941 # 1.6767677,1.6898990,1.7030303,1.7161616,1.7292930,1.7424242,
00942 # 1.7555555,1.7686869,1.7818182,1.7949495,1.8080808,1.8212122,
00943 # 1.8343434,1.8474747,1.8606061,1.8737373/
00944 DATA VAL/ 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00945 # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00946 # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00947 # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00948 # 0.0000000, 0.0000000, 2.2867811, 2.9710648, 2.9344304, 2.6913538,
00949 # 2.5471206, 2.3557470, 2.2448280, 2.1074708, 2.0504866, 1.9270257,
00950 # 1.8669430, 1.7907301, 1.7184515, 1.6535717, 1.6039416, 1.5535343,
00951 # 1.5065620, 1.4608675, 1.4215596, 1.3849826, 1.3480113, 1.3147917,
00952 # 1.2793381, 1.2487282, 1.2184237, 1.1952927, 1.1683835, 1.1458827,
00953 # 1.1145806, 1.0935820, 1.0608720, 1.0390474, 1.0164336, 0.9908721,
00954 # 0.9585276, 0.9307971, 0.9017274, 0.8731154, 0.8452763, 0.8145532,
00955 # 0.7817339, 0.7493086, 0.7199919, 0.6887290, 0.6568120, 0.6255773,
00956 # 0.5944664, 0.5661956, 0.5391204, 0.5102391, 0.4786543, 0.4546428,
00957 # 0.4316779, 0.4063754, 0.3769831, 0.3561141, 0.3333555, 0.3139160,
00958 # 0.2949214, 0.2814728, 0.2602444, 0.2349602, 0.2269845, 0.2192318,
00959 # 0.2286938, 0.2839763, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
00960 # 0.0000000, 0.0000000, 0.0000000, 0.0000000/
00961
00962 if (E.lt.0.6) then
00963 fit=0.
00964 elseif(E.lt.1.777) then
00965 do i=98,1,-1
00966 if (arg(i).le.E) goto 100
00967 enddo
00968 100 fit=val(i)+(val(i+1)-val(i))/(arg(i+1)-arg(i))*(E-arg(i))
00969 else
00970 fit=0.
00971 endif
00972 fit_om_1=fit
00973 END
00974 REAL FUNCTION fit_2(E)
00975
00976
00977 IMPLICIT NONE
00978 INTEGER I
00979 REAL E,FIT
00980 REAL ARG(98),VAL(98)
00981 SAVE ARG,VAL
00982 DATA ARG/ 0.6000000,0.6131313,0.6262626,0.6393939,
00983 # 0.6525252,0.6656566,0.6787879,0.6919192,0.7050505,0.7181818,
00984 # 0.7313131,0.7444444,0.7575758,0.7707071,0.7838384,0.7969697,
00985 # 0.8101010,0.8232324,0.8363636,0.8494949,0.8626263,0.8757576,
00986 # 0.8888889,0.9020202,0.9151515,0.9282829,0.9414141,0.9545454,
00987 # 0.9676768,0.9808081,0.9939394,1.0070707,1.0202020,1.0333333,
00988 # 1.0464647,1.0595959,1.0727273,1.0858586,1.0989898,1.1121212,
00989 # 1.1252525,1.1383839,1.1515151,1.1646465,1.1777778,1.1909091,
00990 # 1.2040404,1.2171717,1.2303030,1.2434343,1.2565657,1.2696970,
00991 # 1.2828283,1.2959596,1.3090909,1.3222222,1.3353535,1.3484849,
00992 # 1.3616161,1.3747475,1.3878788,1.4010102,1.4141414,1.4272727,
00993 # 1.4404041,1.4535353,1.4666667,1.4797980,1.4929293,1.5060606,
00994 # 1.5191919,1.5323232,1.5454545,1.5585859,1.5717171,1.5848485,
00995 # 1.5979798,1.6111112,1.6242424,1.6373737,1.6505051,1.6636363,
00996 # 1.6767677,1.6898990,1.7030303,1.7161616,1.7292930,1.7424242,
00997 # 1.7555555,1.7686869,1.7818182,1.7949495,1.8080808,1.8212122,
00998 # 1.8343434,1.8474747,1.8606061,1.8737373/
00999 DATA VAL/ 0.0000000, 0.0000000, 0.0000000, 0.0000000,
01000 # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
01001 # 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, 1.4819183,
01002 # 1.7086354, 1.6958492, 1.6172935, 1.6301320, 1.5719706, 1.5459771,
01003 # 1.5377471, 1.5008864, 1.4924121, 1.4720882, 1.4371741, 1.3990080,
01004 # 1.3879193, 1.4030601, 1.3768673, 1.3493533, 1.3547127, 1.3275831,
01005 # 1.3167892, 1.3035913, 1.2968298, 1.2801558, 1.2650299, 1.2557997,
01006 # 1.2325822, 1.2210644, 1.1935984, 1.1746194, 1.1510350, 1.1358515,
01007 # 1.1205584, 1.1010553, 1.0903869, 1.0731295, 1.0578678, 1.0438409,
01008 # 1.0377911, 1.0253277, 1.0103551, 1.0042409, 0.9937978, 0.9858117,
01009 # 0.9770346, 0.9724492, 0.9656686, 0.9606671, 0.9525813, 0.9488522,
01010 # 0.9417335, 0.9399430, 0.9323438, 0.9281269, 0.9244171, 0.9237418,
01011 # 0.9174354, 0.9177181, 0.9120840, 0.9047825, 0.9065579, 0.9034142,
01012 # 0.8992961, 0.9011586, 0.9036470, 0.8954964, 0.8898208, 0.8911991,
01013 # 0.8854824, 0.8888282, 0.8868449, 0.9004632, 0.8981572, 0.9096183,
01014 # 0.9046990, 1.7454215, 0.0000000, 0.0000000, 0.0000000, 0.0000000,
01015 # 0.0000000, 0.0000000, 0.0000000, 0.0000000/
01016
01017 if (E.lt.0.6) then
01018 fit=0.
01019 elseif(E.lt.1.777) then
01020 do i=98,1,-1
01021 if (arg(i).le.E) goto 100
01022 enddo
01023 100 fit=val(i)+(val(i+1)-val(i))/(arg(i+1)-arg(i))*(E-arg(i))
01024 else
01025 fit=0.
01026 endif
01027 fit_2=fit
01028 END