00001 FUNCTION FORMOM(XMAA,XMOM)
00002
00003
00004
00005
00006 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00007 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00008 * ,AMK,AMKZ,AMKST,GAMKST
00009
00010 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00011 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00012 * ,AMK,AMKZ,AMKST,GAMKST
00013 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00014 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00015 COMMON /TESTA1/ KEYA1
00016 COMPLEX BWIGN,FORMOM
00017 DATA ICONT /1/
00018
00019 BWIGN(XM,AM,GAMMA)=1./CMPLX(XM**2-AM**2,GAMMA*AM)
00020
00021 FRO =0.266*AMRO**2
00022 ELPHA=- 0.1
00023 AMROP = 1.7
00024 GAMROP= 0.26
00025 AMOM =0.782
00026 GAMOM =0.0085
00027 AROMEG= 1.0
00028 GCOUP=12.924
00029 GCOUP=GCOUP*AROMEG
00030 FQED =SQRT(4.0*3.1415926535/137.03604)
00031 FORMOM=FQED*FRO**2/SQRT(2.0)*GCOUP**2*BWIGN(XMOM,AMOM,GAMOM)
00032 $ *(BWIGN(XMAA,AMRO,GAMRO)+ELPHA*BWIGN(XMAA,AMROP,GAMROP))
00033 $ *(BWIGN( 0.0,AMRO,GAMRO)+ELPHA*BWIGN( 0.0,AMROP,GAMROP))
00034 END
00035
00036
00037 COMPLEX FUNCTION FK1AB(XMSQ,INDX)
00038
00039
00040
00041
00042 COMPLEX F1,F2,AMPA,AMPB
00043 INTEGER IFIRST,INDX
00044 DATA IFIRST/0/
00045
00046 IF (IFIRST.EQ.0) THEN
00047 IFIRST = 1
00048 XM1 = PKORB(1,19)
00049 XG1 = PKORB(2,19)
00050 XM2 = PKORB(1,20)
00051 XG2 = PKORB(2,20)
00052
00053 XM1SQ = XM1*XM1
00054 GF1 = GFUN(XM1SQ)
00055 GG1 = XM1*XG1/GF1
00056 XM2SQ = XM2*XM2
00057 GF2 = GFUN(XM2SQ)
00058 GG2 = XM2*XG2/GF2
00059 END IF
00060
00061 IF (INDX.EQ.1) THEN
00062 AMPA = CMPLX(PKORB(3,81),0.)
00063 AMPB = CMPLX(PKORB(3,82),0.)
00064 ELSE IF (INDX.EQ.2) THEN
00065 AMPA = CMPLX(PKORB(3,83),0.)
00066 AMPB = CMPLX(PKORB(3,84),0.)
00067 ELSEIF (INDX.EQ.3) THEN
00068 AMPA = CMPLX(PKORB(3,85),0.)
00069 AMPB = CMPLX(PKORB(3,86),0.)
00070 ELSEIF (INDX.EQ.4) THEN
00071 AMPA = CMPLX(PKORB(3,87),0.)
00072 AMPB = CMPLX(PKORB(3,88),0.)
00073 END IF
00074
00075 GF = GFUN(XMSQ)
00076 FG1 = GG1*GF
00077 FG2 = GG2*GF
00078 F1 = CMPLX(-XM1SQ,0.0)/CMPLX(XMSQ-XM1SQ,FG1)
00079 F2 = CMPLX(-XM2SQ,0.0)/CMPLX(XMSQ-XM2SQ,FG2)
00080 FK1AB = AMPA*F1+AMPB*F2
00081
00082 RETURN
00083 END
00084
00085 FUNCTION FORM1(MNUM,QQ,S1,SDWA)
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095 COMPLEX FORM1,WIGNER,WIGFOR,FPIKM,BWIGM
00096 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00097 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00098 * ,AMK,AMKZ,AMKST,GAMKST
00099
00100 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00101 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00102 * ,AMK,AMKZ,AMKST,GAMKST
00103
00104 COMPLEX FORMA1,FORMK1,FORMRO,FORMKS
00105 COMPLEX FA1A1P,FK1AB,F3PI
00106
00107 IF (MNUM.EQ.0) THEN
00108
00109
00110
00111
00112
00113 FORM1 = F3PI(1,QQ,S1,SDWA)
00114
00115
00116 ELSEIF (MNUM.EQ.1) THEN
00117
00118 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00119 FORMA1 = FA1A1P(QQ)
00120 FORM1 = FORMA1*FORMKS
00121
00122 ELSEIF (MNUM.EQ.2) THEN
00123
00124 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00125 FORMA1 = FA1A1P(QQ)
00126 FORM1 = FORMA1*FORMKS
00127
00128 ELSEIF (MNUM.EQ.3) THEN
00129
00130 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00131 FORMA1 = FA1A1P(QQ)
00132 FORM1 = FORMA1*FORMKS
00133
00134 ELSEIF (MNUM.EQ.4) THEN
00135
00136 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00137 FORMK1 = FK1AB(QQ,3)
00138 FORM1 = FORMK1*FORMKS
00139
00140 ELSEIF (MNUM.EQ.5) THEN
00141
00142 FORMK1 = FK1AB(QQ,4)
00143 FORMRO = FPIKM(SQRT(S1),AMPI,AMPI)
00144 FORM1 = FORMK1*FORMRO
00145
00146 ELSEIF (MNUM.EQ.6) THEN
00147
00148 FORMK1 = FK1AB(QQ,1)
00149 FORMKS = BWIGM(S1,AMKST,GAMKST,AMK,AMPI)
00150 FORM1 = FORMK1*FORMKS
00151
00152 ELSEIF (MNUM.EQ.7) THEN
00153
00154 FORM1=0.0
00155 ELSEIF (MNUM.EQ.9) THEN
00156
00157
00158
00159
00160
00161 FORM1 = F3PI(1,QQ,S1,SDWA)
00162
00163 ELSEIF (MNUM.gt.9.and.MNUM.lt.20 ) THEN
00164
00165
00166
00167
00168
00169
00170 FORM1 = F3PI(1,QQ,S1,SDWA)
00171
00172 ENDIF
00173
00174 END
00175 FUNCTION FORM2(MNUM,QQ,S1,SDWA)
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185 COMPLEX FORM2,WIGNER,WIGFOR,FPIKM,BWIGM
00186 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00187 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00188 * ,AMK,AMKZ,AMKST,GAMKST
00189
00190 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00191 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00192 * ,AMK,AMKZ,AMKST,GAMKST
00193
00194 COMPLEX FORMA1,FORMK1,FORMRO,FORMKS
00195 COMPLEX FA1A1P,FK1AB,F3PI
00196
00197 IF (MNUM.EQ.0) THEN
00198
00199
00200
00201
00202
00203 FORM2 = F3PI(2,QQ,S1,SDWA)
00204 ELSEIF (MNUM.EQ.1) THEN
00205
00206 FORMRO = FPIKM(SQRT(S1),AMK,AMK)
00207 FORMA1 = FA1A1P(QQ)
00208 FORM2 = FORMA1*FORMRO
00209
00210 ELSEIF (MNUM.EQ.2) THEN
00211
00212 FORMRO = FPIKM(SQRT(S1),AMK,AMK)
00213 FORMA1 = FA1A1P(QQ)
00214 FORM2 = FORMA1*FORMRO
00215
00216 ELSEIF (MNUM.EQ.3) THEN
00217
00218 FORMRO = FPIKM(SQRT(S1),AMK,AMK)
00219 FORMA1 = FA1A1P(QQ)
00220 FORM2 = FORMA1*FORMRO
00221
00222 ELSEIF (MNUM.EQ.4) THEN
00223
00224 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00225 FORMK1 = FK1AB(QQ,3)
00226 FORM2 = FORMK1*FORMKS
00227
00228 ELSEIF (MNUM.EQ.5) THEN
00229
00230 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00231 FORMK1 = FK1AB(QQ,1)
00232 FORM2 = FORMK1*FORMKS
00233
00234 ELSEIF (MNUM.EQ.6) THEN
00235
00236 FORMRO = FPIKM(SQRT(S1),AMPI,AMPI)
00237 FORMK1 = FK1AB(QQ,2)
00238 FORM2 = FORMK1*FORMRO
00239
00240 ELSEIF (MNUM.EQ.7) THEN
00241
00242 FORM2=0.0
00243 ELSEIF (MNUM.EQ.9) THEN
00244
00245
00246
00247
00248
00249 FORM2 = F3PI(2,QQ,S1,SDWA)
00250 ELSEIF (MNUM.gt.9.and.MNUM.lt.20 ) THEN
00251
00252
00253
00254
00255
00256 FORM2 = F3PI(2,QQ,S1,SDWA)
00257
00258 ENDIF
00259
00260
00261 END
00262 COMPLEX FUNCTION BWIGM(S,M,G,XM1,XM2)
00263
00264
00265
00266 REAL S,M,G,XM1,XM2
00267 REAL PI,QS,QM,W,GS
00268 DATA INIT /0/
00269
00270 IF (INIT.EQ.0) THEN
00271 INIT=1
00272 PI=3.141592654
00273
00274 ENDIF
00275 IF (S.GT.(XM1+XM2)**2) THEN
00276 QS=SQRT(ABS((S -(XM1+XM2)**2)*(S -(XM1-XM2)**2)))/SQRT(S)
00277 QM=SQRT(ABS((M**2-(XM1+XM2)**2)*(M**2-(XM1-XM2)**2)))/M
00278 W=SQRT(S)
00279 GS=G*(M/W)**2*(QS/QM)**3
00280 ELSE
00281 GS=0.0
00282 ENDIF
00283 BWIGM=M**2/CMPLX(M**2-S,-SQRT(S)*GS)
00284 RETURN
00285 END
00286 COMPLEX FUNCTION FPIKM(W,XM1,XM2)
00287
00288
00289
00290 COMPLEX BWIGM
00291 REAL ROM,ROG,ROM1,ROG1,BETA1,PI,PIM,S,W
00292 EXTERNAL BWIG
00293 DATA INIT /0/
00294
00295
00296 IF (INIT.EQ.0 ) THEN
00297 INIT=1
00298 PI=3.141592654
00299 PIM=.140
00300 ROM=0.773
00301 ROG=0.145
00302 ROM1=1.370
00303 ROG1=0.510
00304 BETA1=-0.145
00305 ENDIF
00306
00307 S=W**2
00308 FPIKM=(BWIGM(S,ROM,ROG,XM1,XM2)+BETA1*BWIGM(S,ROM1,ROG1,XM1,XM2))
00309 & /(1+BETA1)
00310 RETURN
00311 END
00312 COMPLEX FUNCTION FPIKMD(W,XM1,XM2)
00313
00314
00315
00316 COMPLEX BWIGM
00317 REAL ROM,ROG,ROM1,ROG1,PI,PIM,S,W
00318 EXTERNAL BWIG
00319 DATA INIT /0/
00320
00321
00322 IF (INIT.EQ.0 ) THEN
00323 INIT=1
00324 PI=3.141592654
00325 PIM=.140
00326 ROM=0.773
00327 ROG=0.145
00328 ROM1=1.500
00329 ROG1=0.220
00330 ROM2=1.750
00331 ROG2=0.120
00332 BETA=6.5
00333 DELTA=-26.0
00334 ENDIF
00335
00336 S=W**2
00337 FPIKMD=(DELTA*BWIGM(S,ROM,ROG,XM1,XM2)
00338 $ +BETA*BWIGM(S,ROM1,ROG1,XM1,XM2)
00339 $ + BWIGM(S,ROM2,ROG2,XM1,XM2))
00340 & /(1+BETA+DELTA)
00341 RETURN
00342 END
00343
00344 FUNCTION FORM3(MNUM,QQ,S1,SDWA)
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00355 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00356 * ,AMK,AMKZ,AMKST,GAMKST
00357
00358 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00359 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00360 * ,AMK,AMKZ,AMKST,GAMKST
00361
00362 COMPLEX FORM3,BWIGM
00363 COMPLEX FORMA1,FORMK1,FORMRO,FORMKS
00364 COMPLEX FA1A1P,FK1AB,F3PI
00365
00366 IF (MNUM.EQ.0) THEN
00367
00368
00369
00370
00371
00372 FORM3 = F3PI(3,QQ,S1,SDWA)
00373 ELSEIF (MNUM.EQ.3) THEN
00374
00375 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPIZ,AMK)
00376 FORMA1 = FA1A1P(QQ)
00377 FORM3 = FORMA1*FORMKS
00378
00379 ELSEIF (MNUM.EQ.6) THEN
00380
00381 FORMKS = BWIGM(S1,AMKST,GAMKST,AMK,AMPI)
00382 FORMK1 = FK1AB(QQ,3)
00383 FORM3 = FORMK1*FORMKS
00384 ELSEIF (MNUM.EQ.9) THEN
00385
00386
00387
00388
00389
00390 FORM3 = F3PI(3,QQ,S1,SDWA)
00391 ELSEIF (MNUM.gt.9.and.MNUM.lt.20 ) THEN
00392
00393
00394
00395
00396
00397 FORM3 = F3PI(3,QQ,S1,SDWA)
00398
00399
00400 ELSE
00401 FORM3=CMPLX(0.,0.)
00402 ENDIF
00403
00404 END
00405 FUNCTION FORM4(MNUM,QQ,S1,S2,S3)
00406
00407
00408
00409
00410
00411
00412
00413 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00414 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00415 * ,AMK,AMKZ,AMKST,GAMKST
00416
00417 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00418 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00419 * ,AMK,AMKZ,AMKST,GAMKST
00420 COMPLEX FORM4,WIGNER,FPIKM
00421 REAL*4 M
00422
00423
00424
00425
00426 FORM4=CMPLX(0.0,0.0)
00427
00428 END
00429 FUNCTION FORM5(MNUM,QQ,S1,S2)
00430
00431
00432
00433
00434
00435
00436
00437
00438 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00439 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00440 * ,AMK,AMKZ,AMKST,GAMKST
00441
00442 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00443 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00444 * ,AMK,AMKZ,AMKST,GAMKST
00445 COMPLEX FORM5,WIGNER,FPIKM,FPIKMD,BWIGM
00446
00447 IF (MNUM.EQ.0) THEN
00448
00449 FORM5=0.0
00450 ELSEIF (MNUM.EQ.1) THEN
00451
00452 ELPHA=-0.2
00453 FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)/(1+ELPHA)
00454 $ *( FPIKM(SQRT(S2),AMPI,AMPI)
00455 $ +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK))
00456 ELSEIF (MNUM.EQ.2) THEN
00457
00458 ELPHA=-0.2
00459 FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)/(1+ELPHA)
00460 $ *( FPIKM(SQRT(S2),AMPI,AMPI)
00461 $ +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK))
00462 ELSEIF (MNUM.EQ.3) THEN
00463
00464 FORM5=0.0
00465 ELSEIF (MNUM.EQ.4) THEN
00466
00467 FORM5=0.0
00468 ELSEIF (MNUM.EQ.5) THEN
00469
00470 ELPHA=-0.2
00471 FORM5=BWIGM(QQ,AMKST,GAMKST,AMPI,AMK)/(1+ELPHA)
00472 $ *( FPIKM(SQRT(S1),AMPI,AMPI)
00473 $ +ELPHA*BWIGM(S2,AMKST,GAMKST,AMPI,AMK))
00474 ELSEIF (MNUM.EQ.6) THEN
00475
00476 ELPHA=-0.2
00477 FORM5=BWIGM(QQ,AMKST,GAMKST,AMPI,AMKZ)/(1+ELPHA)
00478 $ *( FPIKM(SQRT(S2),AMPI,AMPI)
00479 $ +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK))
00480 ELSEIF (MNUM.EQ.7) THEN
00481
00482 FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)*FPIKM(SQRT(S1),AMPI,AMPI)
00483 ELSEIF (MNUM.EQ.9) THEN
00484
00485 FORM5=0.0
00486 ELSEIF (MNUM.gt.9.and.MNUM.lt.20 ) THEN
00487
00488 FORM5=0.0
00489 ENDIF
00490
00491 END
00492
00493 SUBROUTINE CURRX(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
00494
00495
00496
00497
00498
00499
00500
00501
00502 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00503 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00504 * ,AMK,AMKZ,AMKST,GAMKST
00505
00506 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00507 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00508 * ,AMK,AMKZ,AMKST,GAMKST
00509 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00510 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00511
00512
00513 COMMON /ARBIT/ ARFLAT,AROMEG
00514
00515 REAL PIM1(4),PIM2(4),PIM3(4),PIM4(4),PAA(4)
00516
00517 COMPLEX HADCUR(4),FORM1,FORM2,FORM3,FPIKM
00518
00519 COMPLEX BWIGN
00520 REAL PA(4),PB(4)
00521 REAL AA(4,4),PP(4,4)
00522 DATA PI /3.141592653589793238462643/
00523 DATA FPI /93.3E-3/
00524 BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG)
00525
00526
00527
00528 G1=12.924
00529 G2=1475.98
00530 G =G1*G2
00531
00532 ELPHA=-.1
00533 AMROP=1.7
00534 GAMROP=0.26
00535
00536 AMOM=.782
00537 GAMOM=0.0085
00538
00539 ARFLAT=1.0
00540 AROMEG=1.0
00541
00542
00543 FRO=0.266*AMRO**2
00544 COEF1=2.0*SQRT(3.0)/FPI**2*ARFLAT
00545 COEF2=FRO*G*AROMEG
00546
00547 DO 7 K=1,4
00548 DO 8 L=1,4
00549 8 AA(K,L)=0.0
00550 HADCUR(K)=CMPLX(0.0)
00551 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)
00552 PP(1,K)=PIM1(K)
00553 PP(2,K)=PIM2(K)
00554 PP(3,K)=PIM3(K)
00555 7 PP(4,K)=PIM4(K)
00556
00557 IF (MNUM.EQ.1) THEN
00558
00559
00560
00561 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00562
00563 DO 201 K=1,3
00564 SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2
00565 $ -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2
00566
00567
00568 DO 202 I=1,4
00569 DO 203 J=1,4
00570 203 AA(I,J)=0.0
00571 202 AA(I,I)=1.0
00572
00573 DO 204 L=1,3
00574 IF (L.NE.K) THEN
00575 DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00576 $ -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00577 DO 205 I=1,4
00578 DO 205 J=1,4
00579 SIG= 1.0
00580 IF(J.NE.4) SIG=-SIG
00581 AA(I,J)=AA(I,J)
00582 $ -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00583 205 CONTINUE
00584 ENDIF
00585 204 CONTINUE
00586
00587
00588 FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
00589
00590
00591
00592
00593 FIX=1.0
00594 IF (K.EQ.3) FIX=-2.0
00595 DO 206 I=1,4
00596 DO 206 J=1,4
00597 HADCUR(I)=
00598 $ HADCUR(I)+CMPLX(FIX*COEF1)*FORM1*AA(I,J)*(PP(K,J)-PP(4,J))
00599 206 CONTINUE
00600
00601 201 CONTINUE
00602
00603
00604
00605
00606 DO 301 KK=1,2
00607 DO 302 I=1,4
00608 PA(I)=PP(KK,I)
00609 PB(I)=PP(3-KK,I)
00610 302 CONTINUE
00611
00612 QQA=0.0
00613 SS23=0.0
00614 SS24=0.0
00615 SS34=0.0
00616 QP1P2=0.0
00617 QP1P3=0.0
00618 QP1P4=0.0
00619 P1P2 =0.0
00620 P1P3 =0.0
00621 P1P4 =0.0
00622 DO 303 K=1,4
00623 SIGN=-1.0
00624 IF (K.EQ.4) SIGN= 1.0
00625 QQA=QQA+SIGN*(PAA(K)-PA(K))**2
00626 SS23=SS23+SIGN*(PB(K) +PIM3(K))**2
00627 SS24=SS24+SIGN*(PB(K) +PIM4(K))**2
00628 SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2
00629 QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K)
00630 QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K)
00631 QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K)
00632 P1P2=P1P2+SIGN*PA(K)*PB(K)
00633 P1P3=P1P3+SIGN*PA(K)*PIM3(K)
00634 P1P4=P1P4+SIGN*PA(K)*PIM4(K)
00635 303 CONTINUE
00636
00637 FORM2=COEF2*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP))
00638
00639
00640 FORM3=BWIGN(QQA,AMOM,GAMOM)
00641
00642 DO 304 K=1,4
00643 HADCUR(K)=HADCUR(K)+FORM2*FORM3*(
00644 $ PB (K)*(QP1P3*P1P4-QP1P4*P1P3)
00645 $ +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4)
00646 $ +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) )
00647 304 CONTINUE
00648 301 CONTINUE
00649
00650 ELSE
00651
00652
00653
00654 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00655 DO 101 K=1,3
00656
00657 SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2
00658 $ -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2
00659
00660
00661 DO 102 I=1,4
00662 DO 103 J=1,4
00663 103 AA(I,J)=0.0
00664 102 AA(I,I)=1.0
00665
00666
00667 DO 104 L=1,3
00668 IF (L.NE.K) THEN
00669 DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00670 $ -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00671 DO 105 I=1,4
00672 DO 105 J=1,4
00673 SIG=1.0
00674 IF(J.NE.4) SIG=-SIG
00675 AA(I,J)=AA(I,J)
00676 $ -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00677 105 CONTINUE
00678 ENDIF
00679 104 CONTINUE
00680
00681
00682 FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
00683
00684
00685
00686 DO 106 I=1,4
00687 DO 106 J=1,4
00688 HADCUR(I)=
00689 $ HADCUR(I)+CMPLX(COEF1)*FORM1*AA(I,J)*(PP(K,J)-PP(4,J))
00690 106 CONTINUE
00691
00692 101 CONTINUE
00693 ENDIF
00694 END
00695 FUNCTION WIGFOR(S,XM,XGAM)
00696 COMPLEX WIGFOR,WIGNOR
00697 WIGNOR=CMPLX(-XM**2,XM*XGAM)
00698 WIGFOR=WIGNOR/CMPLX(S-XM**2,XM*XGAM)
00699 END
00700
00701 SUBROUTINE CURINF
00702
00703
00704 COMMON /INOUT/ INUT, IOUT
00705 WRITE (UNIT = IOUT,FMT = 99)
00706 WRITE (UNIT = IOUT,FMT = 98)
00707
00708 99 FORMAT(
00709 . /, ' *************************************************** ',
00710 . /, ' YOU ARE USING THE 4 PION DECAY MODE FORM FACTORS ',
00711 . /, ' WHICH HAVE BEEN DESCRIBED IN:',
00712 . /, ' R. DECKER, M. FINKEMEIER, P. HEILIGER AND H.H. JONSSON',
00713 . /, ' "TAU DECAYS INTO FOUR PIONS" ',
00714 . /, ' UNIVERSITAET KARLSRUHE PREPRINT TTP 94-13 (1994);',
00715 . /, ' LNF-94/066(IR); HEP-PH/9410260 ',
00716 . /, ' ',
00717 . /, ' PLEASE NOTE THAT THIS ROUTINE IS USING PARAMETERS',
00718 . /, ' RELATED TO THE 3 PION DECAY MODE (A1 MODE), SUCH AS',
00719 . /, ' THE A1 MASS AND WIDTH (TAKEN FROM THE COMMON /PARMAS/)',
00720 . /, ' AND THE 2 PION VECTOR RESONANCE FORM FACTOR (BY USING',
00721 . /, ' THE ROUTINE FPIKM)' ,
00722 . /, ' THUS IF YOU DECIDE TO CHANGE ANY OF THESE, YOU WILL' ,
00723 . /, ' HAVE TO REFIT THE 4 PION PARAMETERS IN THE COMMON' )
00724 98 FORMAT(
00725 . ' BLOCK /TAU4PI/, OR YOU MIGHT GET A BAD DISCRIPTION' ,
00726 . /, ' OF TAU -> 4 PIONS' ,
00727 . /, ' for these formfactors set in routine CHOICE for',
00728 . /, ' mnum.eq.102 -- AMRX=1.42 and GAMRX=.21',
00729 . /, ' mnum.eq.101 -- AMRX=1.3 and GAMRX=.46 PROB1,PROB2=0.2',
00730 . /, ' to optimize phase space parametrization',
00731 . /, ' *************************************************** ',
00732 . /, ' coded by M. Finkemeier and P. Heiliger, 29. sept. 1994',
00733 . /, ' incorporated to TAUOLA by Z. Was 17. jan. 1995',
00734
00735
00736 . /, ' changed by: Z. Was on 17.01.95',
00737 . /, ' changes by: M. Finkemeier on 30.01.95' )
00738 END
00739
00740 SUBROUTINE CURINI
00741 COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00742 . ROM2,ROG2,BETA2
00743 REAL*4 GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00744 . ROM2,ROG2,BETA2
00745 GOMEGA = 1.4
00746 GAMMA1 = 0.38
00747 GAMMA2 = 0.38
00748 ROM1 = 1.35
00749 ROG1 = 0.3
00750 BETA1 = 0.08
00751 ROM2 = 1.70
00752 ROG2 = 0.235
00753 BETA2 = -0.0075
00754 END
00755 COMPLEX FUNCTION BWIGA1(QA)
00756
00757
00758
00759 COMPLEX WIGNER
00760 COMMON / PARMAS/ AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU,
00761 % AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1,
00762 % AMK,AMKZ,AMKST,GAMKST
00763
00764
00765 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU,
00766 % AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1,
00767 % AMK,AMKZ,AMKST,GAMKST
00768
00769 WIGNER(A,B,C)=CMPLX(1.0,0.0)/CMPLX(A-B**2,B*C)
00770 GAMAX=GAMA1*GFUN(QA)/GFUN(AMA1**2)
00771 BWIGA1=-AMA1**2*WIGNER(QA,AMA1,GAMAX)
00772 RETURN
00773 END
00774 COMPLEX FUNCTION BWIGEPS(QEPS)
00775
00776
00777
00778 REAL QEPS,MEPS,GEPS
00779 MEPS=1.300
00780 GEPS=.600
00781 BWIGEPS=CMPLX(MEPS**2,-MEPS*GEPS)/
00782 % CMPLX(MEPS**2-QEPS,-MEPS*GEPS)
00783 RETURN
00784 END
00785 COMPLEX FUNCTION FRHO4(W,XM1,XM2)
00786
00787
00788
00789
00790 COMPLEX BWIGM
00791 COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00792 . ROM2,ROG2,BETA2
00793 REAL*4 GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00794 . ROM2,ROG2,BETA2
00795 REAL ROM,ROG,PI,PIM,S,W
00796 EXTERNAL BWIG
00797 DATA INIT /0/
00798
00799
00800 IF (INIT.EQ.0 ) THEN
00801 INIT=1
00802 PI=3.141592654
00803 PIM=.140
00804 ROM=0.773
00805 ROG=0.145
00806 ENDIF
00807
00808 S=W**2
00809
00810 FRHO4=(BWIGM(S,ROM,ROG,XM1,XM2)+BETA1*BWIGM(S,ROM1,ROG1,XM1,XM2)
00811 & +BETA2*BWIGM(S,ROM2,ROG2,XM1,XM2))
00812 & /(1+BETA1+BETA2)
00813 RETURN
00814 END
00815 SUBROUTINE CURR(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
00816
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826 COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00827 . ROM2,ROG2,BETA2
00828 REAL*4 GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00829 . ROM2,ROG2,BETA2
00830 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00831 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00832 * ,AMK,AMKZ,AMKST,GAMKST
00833
00834 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00835 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00836 * ,AMK,AMKZ,AMKST,GAMKST
00837 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00838 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00839 REAL PIM1(4),PIM2(4),PIM3(4),PIM4(4),PAA(4)
00840 COMPLEX HADCUR(4),FORM1,FORM2,FORM3,FPIKM
00841 COMPLEX BWIGN,FRHO4
00842 COMPLEX BWIGEPS,BWIGA1
00843 COMPLEX HCOMP1(4),HCOMP2(4),HCOMP3(4),HCOMP4(4)
00844
00845 COMPLEX T243,T213,T143,T123,T341,T342
00846 COMPLEX T124,T134,T214,T234,T314,T324
00847 COMPLEX S2413,S2314,S1423,S1324,S34
00848 COMPLEX S2431,S3421
00849 COMPLEX BRACK1,BRACK2,BRACK3,BRACK4A,BRACK4B,BRACK4
00850
00851 REAL QMP1,QMP2,QMP3,QMP4
00852 REAL PS43,PS41,PS42,PS34,PS14,PS13,PS24,PS23
00853 REAL PS21,PS31
00854
00855 REAL PD243,PD241,PD213,PD143,PD142
00856 REAL PD123,PD341,PD342,PD413,PD423
00857 REAL PD124,PD134,PD214,PD234,PD314,PD324
00858 REAL QP1,QP2,QP3,QP4
00859
00860 REAL PA(4),PB(4)
00861 REAL AA(4,4),PP(4,4)
00862 DATA PI /3.141592653589793238462643/
00863 DATA FPI /93.3E-3/
00864 DATA INIT /0/
00865 BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG)
00866
00867 IF (INIT.EQ.0) THEN
00868 CALL CURINI
00869 CALL CURINF
00870 INIT = 1
00871 ENDIF
00872
00873
00874 G1=12.924
00875 G2=1475.98 * GOMEGA
00876 G =G1*G2
00877 ELPHA=-.1
00878 AMROP=1.7
00879 GAMROP=0.26
00880 AMOM=.782
00881 GAMOM=0.0085
00882 ARFLAT=1.0
00883 AROMEG=1.0
00884
00885 FRO=0.266*AMRO**2
00886 COEF1=2.0*SQRT(3.0)/FPI**2*ARFLAT
00887 COEF2=FRO*G*AROMEG
00888
00889 DO 7 K=1,4
00890 DO 8 L=1,4
00891 8 AA(K,L)=0.0
00892 HADCUR(K)=CMPLX(0.0)
00893 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)
00894 PP(1,K)=PIM1(K)
00895 PP(2,K)=PIM2(K)
00896 PP(3,K)=PIM3(K)
00897 7 PP(4,K)=PIM4(K)
00898
00899 IF (MNUM.EQ.1) THEN
00900
00901
00902
00903 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00904
00905
00906
00907
00908
00909 QMP1=(PIM2(4)+PIM3(4)+PIM4(4))**2-(PIM2(3)+PIM3(3)+PIM4(3))**2
00910 % -(PIM2(2)+PIM3(2)+PIM4(2))**2-(PIM2(1)+PIM3(1)+PIM4(1))**2
00911
00912 QMP2=(PIM1(4)+PIM3(4)+PIM4(4))**2-(PIM1(3)+PIM3(3)+PIM4(3))**2
00913 % -(PIM1(2)+PIM3(2)+PIM4(2))**2-(PIM1(1)+PIM3(1)+PIM4(1))**2
00914
00915 QMP3=(PIM1(4)+PIM2(4)+PIM4(4))**2-(PIM1(3)+PIM2(3)+PIM4(3))**2
00916 % -(PIM1(2)+PIM2(2)+PIM4(2))**2-(PIM1(1)+PIM2(1)+PIM4(1))**2
00917
00918 QMP4=(PIM1(4)+PIM2(4)+PIM3(4))**2-(PIM1(3)+PIM2(3)+PIM3(3))**2
00919 % -(PIM1(2)+PIM2(2)+PIM3(2))**2-(PIM1(1)+PIM2(1)+PIM3(1))**2
00920
00921
00922
00923
00924 PS43=(PIM4(4)+PIM3(4))**2-(PIM4(3)+PIM3(3))**2
00925 % -(PIM4(2)+PIM3(2))**2-(PIM4(1)+PIM3(1))**2
00926
00927 PS41=(PIM4(4)+PIM1(4))**2-(PIM4(3)+PIM1(3))**2
00928 % -(PIM4(2)+PIM1(2))**2-(PIM4(1)+PIM1(1))**2
00929
00930 PS42=(PIM4(4)+PIM2(4))**2-(PIM4(3)+PIM2(3))**2
00931 % -(PIM4(2)+PIM2(2))**2-(PIM4(1)+PIM2(1))**2
00932
00933 PS34=PS43
00934
00935 PS14=PS41
00936
00937 PS13=(PIM1(4)+PIM3(4))**2-(PIM1(3)+PIM3(3))**2
00938 % -(PIM1(2)+PIM3(2))**2-(PIM1(1)+PIM3(1))**2
00939
00940 PS24=PS42
00941
00942 PS23=(PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2
00943 % -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2
00944
00945 PD243=PIM2(4)*(PIM4(4)-PIM3(4))-PIM2(3)*(PIM4(3)-PIM3(3))
00946 % -PIM2(2)*(PIM4(2)-PIM3(2))-PIM2(1)*(PIM4(1)-PIM3(1))
00947
00948 PD241=PIM2(4)*(PIM4(4)-PIM1(4))-PIM2(3)*(PIM4(3)-PIM1(3))
00949 % -PIM2(2)*(PIM4(2)-PIM1(2))-PIM2(1)*(PIM4(1)-PIM1(1))
00950
00951 PD213=PIM2(4)*(PIM1(4)-PIM3(4))-PIM2(3)*(PIM1(3)-PIM3(3))
00952 % -PIM2(2)*(PIM1(2)-PIM3(2))-PIM2(1)*(PIM1(1)-PIM3(1))
00953
00954 PD143=PIM1(4)*(PIM4(4)-PIM3(4))-PIM1(3)*(PIM4(3)-PIM3(3))
00955 % -PIM1(2)*(PIM4(2)-PIM3(2))-PIM1(1)*(PIM4(1)-PIM3(1))
00956
00957 PD142=PIM1(4)*(PIM4(4)-PIM2(4))-PIM1(3)*(PIM4(3)-PIM2(3))
00958 % -PIM1(2)*(PIM4(2)-PIM2(2))-PIM1(1)*(PIM4(1)-PIM2(1))
00959
00960 PD123=PIM1(4)*(PIM2(4)-PIM3(4))-PIM1(3)*(PIM2(3)-PIM3(3))
00961 % -PIM1(2)*(PIM2(2)-PIM3(2))-PIM1(1)*(PIM2(1)-PIM3(1))
00962
00963 PD341=PIM3(4)*(PIM4(4)-PIM1(4))-PIM3(3)*(PIM4(3)-PIM1(3))
00964 % -PIM3(2)*(PIM4(2)-PIM1(2))-PIM3(1)*(PIM4(1)-PIM1(1))
00965
00966 PD342=PIM3(4)*(PIM4(4)-PIM2(4))-PIM3(3)*(PIM4(3)-PIM2(3))
00967 % -PIM3(2)*(PIM4(2)-PIM2(2))-PIM3(1)*(PIM4(1)-PIM2(1))
00968
00969 PD413=PIM4(4)*(PIM1(4)-PIM3(4))-PIM4(3)*(PIM1(3)-PIM3(3))
00970 % -PIM4(2)*(PIM1(2)-PIM3(2))-PIM4(1)*(PIM1(1)-PIM3(1))
00971
00972 PD423=PIM4(4)*(PIM2(4)-PIM3(4))-PIM4(3)*(PIM2(3)-PIM3(3))
00973 % -PIM4(2)*(PIM2(2)-PIM3(2))-PIM4(1)*(PIM2(1)-PIM3(1))
00974
00975
00976
00977 QP1=PIM1(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00978 % -PIM1(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00979 % -PIM1(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00980 % -PIM1(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00981
00982 QP2=PIM2(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00983 % -PIM2(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00984 % -PIM2(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00985 % -PIM2(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00986
00987 QP3=PIM3(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00988 % -PIM3(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00989 % -PIM3(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00990 % -PIM3(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00991
00992 QP4=PIM4(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00993 % -PIM4(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00994 % -PIM4(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00995 % -PIM4(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00996
00997
00998
00999
01000
01001 T243=BWIGA1(QMP2)*FPIKM(SQRT(PS43),AMPI,AMPI)*GAMMA1
01002 T213=BWIGA1(QMP2)*FPIKM(SQRT(PS13),AMPI,AMPI)*GAMMA1
01003 T143=BWIGA1(QMP1)*FPIKM(SQRT(PS43),AMPI,AMPI)*GAMMA1
01004 T123=BWIGA1(QMP1)*FPIKM(SQRT(PS23),AMPI,AMPI)*GAMMA1
01005 T341=BWIGA1(QMP3)*FPIKM(SQRT(PS41),AMPI,AMPI)*GAMMA1
01006 T342=BWIGA1(QMP3)*FPIKM(SQRT(PS42),AMPI,AMPI)*GAMMA1
01007
01008
01009
01010 S2413=FRHO4(SQRT(PS24),AMPI,AMPI)*GAMMA2
01011 S2314=FRHO4(SQRT(PS23),AMPI,AMPI)*BWIGEPS(PS14)*GAMMA2
01012 S1423=FRHO4(SQRT(PS14),AMPI,AMPI)*GAMMA2
01013 S1324=FRHO4(SQRT(PS13),AMPI,AMPI)*BWIGEPS(PS24)*GAMMA2
01014 S34=FRHO4(SQRT(PS34),AMPI,AMPI)*GAMMA2
01015
01016
01017
01018 BRACK1=2.*T143+2.*T243+T123+T213
01019 % +T341*(PD241/QMP3-1.)+T342*(PD142/QMP3-1.)
01020 % +3./4.*(S1423+S2413-S2314-S1324)-3.*S34
01021
01022 BRACK2=2.*T143*PD243/QMP1+3.*T213
01023 % +T123*(2.*PD423/QMP1+1.)+T341*(PD241/QMP3+3.)
01024 % +T342*(PD142/QMP3+1.)
01025 % -3./4.*(S2314+3.*S1324+3.*S1423+S2413)
01026
01027 BRACK3=2.*T243*PD143/QMP2+3.*T123
01028 % +T213*(2.*PD413/QMP2+1.)+T341*(PD241/QMP3+1.)
01029 % +T342*(PD142/QMP3+3.)
01030 % -3./4.*(3.*S2314+S1324+S1423+3.*S2413)
01031
01032 BRACK4A=2.*T143*(PD243/QQ*(QP1/QMP1+1.)+PD143/QQ)
01033 % +2.*T243*(PD143/QQ*(QP2/QMP2+1.)+PD243/QQ)
01034 % +T123+T213
01035 % +2.*T123*(PD423/QQ*(QP1/QMP1+1.)+PD123/QQ)
01036 % +2.*T213*(PD413/QQ*(QP2/QMP2+1.)+PD213/QQ)
01037 % +T341*(PD241/QMP3+1.-2.*PD241/QQ*(QP3/QMP3+1.)
01038 % -2.*PD341/QQ)
01039 % +T342*(PD142/QMP3+1.-2.*PD142/QQ*(QP3/QMP3+1.)
01040 % -2.*PD342/QQ)
01041
01042 BRACK4B=-3./4.*(S2314*(2.*(QP2-QP3)/QQ+1.)
01043 % +S1324*(2.*(QP1-QP3)/QQ+1.)
01044 % +S1423*(2.*(QP1-QP4)/QQ+1.)
01045 % +S2413*(2.*(QP2-QP4)/QQ+1.)
01046 % +4.*S34*(QP4-QP3)/QQ)
01047
01048 BRACK4=BRACK4A+BRACK4B
01049
01050 DO 208 K=1,4
01051
01052 HCOMP1(K)=(PIM3(K)-PIM4(K))*BRACK1
01053 HCOMP2(K)=PIM1(K)*BRACK2
01054 HCOMP3(K)=PIM2(K)*BRACK3
01055 HCOMP4(K)=(PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K))*BRACK4
01056
01057 208 CONTINUE
01058
01059 DO 209 I=1,4
01060
01061 HADCUR(I)=HCOMP1(I)-HCOMP2(I)-HCOMP3(I)+HCOMP4(I)
01062 HADCUR(I)=-COEF1*FRHO4(SQRT(QQ),AMPI,AMPI)*HADCUR(I)
01063
01064 209 CONTINUE
01065
01066
01067
01068 201 CONTINUE
01069
01070
01071
01072
01073 DO 301 KK=1,2
01074 DO 302 I=1,4
01075 PA(I)=PP(KK,I)
01076 PB(I)=PP(3-KK,I)
01077 302 CONTINUE
01078
01079 QQA=0.0
01080 SS23=0.0
01081 SS24=0.0
01082 SS34=0.0
01083 QP1P2=0.0
01084 QP1P3=0.0
01085 QP1P4=0.0
01086 P1P2 =0.0
01087 P1P3 =0.0
01088 P1P4 =0.0
01089 DO 303 K=1,4
01090 SIGN=-1.0
01091 IF (K.EQ.4) SIGN= 1.0
01092 QQA=QQA+SIGN*(PAA(K)-PA(K))**2
01093 SS23=SS23+SIGN*(PB(K) +PIM3(K))**2
01094 SS24=SS24+SIGN*(PB(K) +PIM4(K))**2
01095 SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2
01096 QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K)
01097 QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K)
01098 QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K)
01099 P1P2=P1P2+SIGN*PA(K)*PB(K)
01100 P1P3=P1P3+SIGN*PA(K)*PIM3(K)
01101 P1P4=P1P4+SIGN*PA(K)*PIM4(K)
01102 303 CONTINUE
01103
01104 FORM2=COEF2*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP))
01105
01106
01107 FORM3=BWIGN(QQA,AMOM,GAMOM)
01108
01109 DO 304 K=1,4
01110 HADCUR(K)=HADCUR(K)+FORM2*FORM3*(
01111 $ PB (K)*(QP1P3*P1P4-QP1P4*P1P3)
01112 $ +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4)
01113 $ +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) )
01114 304 CONTINUE
01115 301 CONTINUE
01116
01117 ELSE
01118
01119
01120
01121 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
01122
01123
01124
01125
01126
01127
01128 QMP1=(PIM2(4)+PIM3(4)+PIM4(4))**2-(PIM2(3)+PIM3(3)+PIM4(3))**2
01129 % -(PIM2(2)+PIM3(2)+PIM4(2))**2-(PIM2(1)+PIM3(1)+PIM4(1))**2
01130
01131 QMP2=(PIM1(4)+PIM3(4)+PIM4(4))**2-(PIM1(3)+PIM3(3)+PIM4(3))**2
01132 % -(PIM1(2)+PIM3(2)+PIM4(2))**2-(PIM1(1)+PIM3(1)+PIM4(1))**2
01133
01134 QMP3=(PIM1(4)+PIM2(4)+PIM4(4))**2-(PIM1(3)+PIM2(3)+PIM4(3))**2
01135 % -(PIM1(2)+PIM2(2)+PIM4(2))**2-(PIM1(1)+PIM2(1)+PIM4(1))**2
01136
01137 QMP4=(PIM1(4)+PIM2(4)+PIM3(4))**2-(PIM1(3)+PIM2(3)+PIM3(3))**2
01138 % -(PIM1(2)+PIM2(2)+PIM3(2))**2-(PIM1(1)+PIM2(1)+PIM3(1))**2
01139
01140
01141
01142
01143 PS14=(PIM1(4)+PIM4(4))**2-(PIM1(3)+PIM4(3))**2
01144 % -(PIM1(2)+PIM4(2))**2-(PIM1(1)+PIM4(1))**2
01145
01146 PS21=(PIM2(4)+PIM1(4))**2-(PIM2(3)+PIM1(3))**2
01147 % -(PIM2(2)+PIM1(2))**2-(PIM2(1)+PIM1(1))**2
01148
01149 PS23=(PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2
01150 % -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2
01151
01152 PS24=(PIM2(4)+PIM4(4))**2-(PIM2(3)+PIM4(3))**2
01153 % -(PIM2(2)+PIM4(2))**2-(PIM2(1)+PIM4(1))**2
01154
01155 PS31=(PIM3(4)+PIM1(4))**2-(PIM3(3)+PIM1(3))**2
01156 % -(PIM3(2)+PIM1(2))**2-(PIM3(1)+PIM1(1))**2
01157
01158 PS34=(PIM3(4)+PIM4(4))**2-(PIM3(3)+PIM4(3))**2
01159 % -(PIM3(2)+PIM4(2))**2-(PIM3(1)+PIM4(1))**2
01160
01161
01162
01163 PD324=PIM3(4)*(PIM2(4)-PIM4(4))-PIM3(3)*(PIM2(3)-PIM4(3))
01164 % -PIM3(2)*(PIM2(2)-PIM4(2))-PIM3(1)*(PIM2(1)-PIM4(1))
01165
01166 PD314=PIM3(4)*(PIM1(4)-PIM4(4))-PIM3(3)*(PIM1(3)-PIM4(3))
01167 % -PIM3(2)*(PIM1(2)-PIM4(2))-PIM3(1)*(PIM1(1)-PIM4(1))
01168
01169 PD234=PIM2(4)*(PIM3(4)-PIM4(4))-PIM2(3)*(PIM3(3)-PIM4(3))
01170 % -PIM2(2)*(PIM3(2)-PIM4(2))-PIM2(1)*(PIM3(1)-PIM4(1))
01171
01172 PD214=PIM2(4)*(PIM1(4)-PIM4(4))-PIM2(3)*(PIM1(3)-PIM4(3))
01173 % -PIM2(2)*(PIM1(2)-PIM4(2))-PIM2(1)*(PIM1(1)-PIM4(1))
01174
01175 PD134=PIM1(4)*(PIM3(4)-PIM4(4))-PIM1(3)*(PIM3(3)-PIM4(3))
01176 % -PIM1(2)*(PIM3(2)-PIM4(2))-PIM1(1)*(PIM3(1)-PIM4(1))
01177
01178 PD124=PIM1(4)*(PIM2(4)-PIM4(4))-PIM1(3)*(PIM2(3)-PIM4(3))
01179 % -PIM1(2)*(PIM2(2)-PIM4(2))-PIM1(1)*(PIM2(1)-PIM4(1))
01180
01181
01182
01183 QP1=PIM1(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01184 % -PIM1(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01185 % -PIM1(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01186 % -PIM1(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01187
01188 QP2=PIM2(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01189 % -PIM2(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01190 % -PIM2(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01191 % -PIM2(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01192
01193 QP3=PIM3(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01194 % -PIM3(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01195 % -PIM3(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01196 % -PIM3(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01197
01198 QP4=PIM4(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01199 % -PIM4(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01200 % -PIM4(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01201 % -PIM4(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01202
01203
01204
01205
01206 T324=BWIGA1(QMP3)*FPIKM(SQRT(PS24),AMPI,AMPI)*GAMMA1
01207 T314=BWIGA1(QMP3)*FPIKM(SQRT(PS14),AMPI,AMPI)*GAMMA1
01208 T234=BWIGA1(QMP2)*FPIKM(SQRT(PS34),AMPI,AMPI)*GAMMA1
01209 T214=BWIGA1(QMP2)*FPIKM(SQRT(PS14),AMPI,AMPI)*GAMMA1
01210 T134=BWIGA1(QMP1)*FPIKM(SQRT(PS34),AMPI,AMPI)*GAMMA1
01211 T124=BWIGA1(QMP1)*FPIKM(SQRT(PS24),AMPI,AMPI)*GAMMA1
01212
01213
01214
01215 S1423=FRHO4(SQRT(PS14),AMPI,AMPI)*BWIGEPS(PS23)*GAMMA2
01216 S2431=FRHO4(SQRT(PS24),AMPI,AMPI)*BWIGEPS(PS31)*GAMMA2
01217 S3421=FRHO4(SQRT(PS34),AMPI,AMPI)*BWIGEPS(PS21)*GAMMA2
01218
01219
01220
01221
01222 BRACK1=T234+T324+2.*T314+T134+2.*T214+T124
01223 % +T134*PD234/QMP1+T124*PD324/QMP1
01224 % -3./2.*(S3421+S2431+2.*S1423)
01225
01226
01227 BRACK2=T234*(1.+2.*PD134/QMP2)+3.*T324+3.*T124
01228 % +T134*(1.-PD234/QMP1)+2.*T214*PD314/QMP2
01229 % -T124*PD324/QMP1
01230 % -3./2.*(S3421+3.*S2431)
01231
01232 BRACK3=T324*(1.+2.*PD124/QMP3)+3.*T234+3.*T134
01233 % +T124*(1.-PD324/QMP1)+2.*T314*PD214/QMP3
01234 % -T134*PD234/QMP1
01235 % -3./2.*(3.*S3421+S2431)
01236
01237 BRACK4A=2.*T234*(1./2.+PD134/QQ*(QP2/QMP2+1.)+PD234/QQ)
01238 % +2.*T324*(1./2.+PD124/QQ*(QP3/QMP3+1.)+PD324/QQ)
01239 % +2.*T134*(1./2.+PD234/QQ*(QP1/QMP1+1.)
01240 % -1./2.*PD234/QMP1+PD134/QQ)
01241 % +2.*T124*(1./2.+PD324/QQ*(QP1/QMP1+1.)
01242 % -1./2.*PD324/QMP1+PD124/QQ)
01243 % +2.*T214*(PD314/QQ*(QP2/QMP2+1.)+PD214/QQ)
01244 % +2.*T314*(PD214/QQ*(QP3/QMP3+1.)+PD314/QQ)
01245
01246 BRACK4B=-3./2.*(S3421*(2.*(QP3-QP4)/QQ+1.)
01247 % +S2431*(2.*(QP2-QP4)/QQ+1.)
01248 % +S1423*2.*(QP1-QP4)/QQ)
01249
01250
01251 BRACK4=BRACK4A+BRACK4B
01252
01253 DO 308 K=1,4
01254
01255 HCOMP1(K)=(PIM1(K)-PIM4(K))*BRACK1
01256 HCOMP2(K)=PIM2(K)*BRACK2
01257 HCOMP3(K)=PIM3(K)*BRACK3
01258 HCOMP4(K)=(PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K))*BRACK4
01259
01260 308 CONTINUE
01261
01262 DO 309 I=1,4
01263
01264 HADCUR(I)=HCOMP1(I)+HCOMP2(I)+HCOMP3(I)-HCOMP4(I)
01265 HADCUR(I)=COEF1*FRHO4(SQRT(QQ),AMPI,AMPI)*HADCUR(I)
01266
01267 309 CONTINUE
01268
01269 101 CONTINUE
01270 ENDIF
01271
01272 END
01273