00001
00002 subroutine testresu
00003
00004
00005
00006
00007
00008
00009 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00010 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00011 * ,AMK,AMKZ,AMKST,GAMKST
00012
00013 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00014 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00015 * ,AMK,AMKZ,AMKST,GAMKST
00016
00017 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00018 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00019
00020 XLAM(X,Y,Z)=SQRT(ABS((X-Y-Z)**2-4.0*Y*Z))
00021 DATA PI /3.141592653589793238462643/
00022 AMOM=.782
00023 GAMOM= 0.0085
00024 ama2=1.260
00025 gama2=0.001
00026
00027
00028 CARB=3000
00029 Gropp=6
00030 FOMEGA=0.07
00031 wyni= 1.0D0/4.0D0/AMTAU**2*(1-ama2**2/AMTAU**2)**2
00032 wyni=wyni*(1+2*ama2**2/AMTAU**2)*CARB**2*AMA2**4/AMA2/GAMA2*PI
00033 dwpynd=XLAM(ama2**2,amro**2,amom**2)/ama2
00034 eff=dwpynd/ama2*(0.5*dwpynd**2*(1d0/amro**2+1d0/amom**2)+6)
00035 wyni=wyni*eff
00036 GAM3PI= 1D0/3.0D0/128D0/(2*PI)**3*AMOM**7*
00037 $ (fomega*gropp/amro**2)**2/120D0
00038 GAM2PI= gropp**2/48D0/PI*AMRO
00039 wyni=wyni* GAM3pi/GAMOM
00040 wyni=wyni* GAM2pi/GAMRO
00041 wyni=wyni*ccabib**2
00042 write(*,*) 'testresu=',wyni
00043 end
00044
00045 SUBROUTINE CURR5(MNUM,PIM1,PIM2,PIM3,PIM4,PIM5,HADCUR)
00046 REAL PIM1(4),PIM2(4),PIM3(4),PIM4(4),PIM5(4)
00047 COMPLEX HADCUR(4), HADCU(4)
00048 IF (MNUM.EQ.24) THEN
00049 CALL CURR5X(MNUM,PIM1,PIM2,PIM3,PIM4,PIM5,HADCU)
00050 DO K=1,4
00051 HADCUR(K)=HADCU(K)
00052 ENDDO
00053 ELSEIF (MNUM.EQ.26) THEN
00054 CALL CURR5X(MNUM,PIM2,PIM3,PIM1,PIM4,PIM5,HADCU)
00055 DO K=1,4
00056 HADCUR(K)=HADCU(K)
00057 ENDDO
00058 CALL CURR5X(MNUM,PIM4,PIM5,PIM2,PIM3,PIM1,HADCU)
00059 DO K=1,4
00060 HADCUR(K)=HADCUR(K)+HADCU(K)
00061 ENDDO
00062 CALL CURR5X(MNUM,PIM4,PIM5,PIM3,PIM2,PIM1,HADCU)
00063 DO K=1,4
00064 HADCUR(K)=HADCUR(K)+HADCU(K)
00065 ENDDO
00066
00067 CALL CURR5X(24,PIM2,PIM3,PIM1,PIM4,PIM5,HADCU)
00068 DO K=1,4
00069 HADCUR(K)=HADCU(K) +HADCUR(K)
00070 ENDDO
00071 CALL CURR5X(24,PIM2,PIM3,PIM1,PIM5,PIM4,HADCU)
00072 DO K=1,4
00073 HADCUR(K)=HADCUR(K)+HADCU(K)
00074 ENDDO
00075 CALL CURR5X(24,PIM3,PIM2,PIM1,PIM4,PIM5,HADCU)
00076 DO K=1,4
00077 HADCUR(K)=HADCUR(K)+HADCU(K)
00078 ENDDO
00079 CALL CURR5X(24,PIM3,PIM2,PIM1,PIM5,PIM4,HADCU)
00080 DO K=1,4
00081 HADCUR(K)=HADCUR(K)+HADCU(K)
00082 ENDDO
00083
00084 DO K=1,4
00085 HADCUR(K)=HADCUR(K)*SQRT(0.25)
00086 ENDDO
00087 ELSEIF (MNUM.EQ.27) THEN
00088 CALL CURR5X(MNUM,PIM2,PIM3,PIM1,PIM4,PIM5,HADCU)
00089 DO K=1,4
00090 HADCUR(K)=HADCU(K)
00091 ENDDO
00092 CALL CURR5X(MNUM,PIM2,PIM4,PIM1,PIM3,PIM5,HADCU)
00093 DO K=1,4
00094 HADCUR(K)=HADCUR(K)+HADCU(K)
00095 ENDDO
00096 CALL CURR5X(MNUM,PIM2,PIM5,PIM1,PIM3,PIM4,HADCU)
00097 DO K=1,4
00098 HADCUR(K)=HADCUR(K)+HADCU(K)
00099 ENDDO
00100 CALL CURR5X(MNUM,PIM4,PIM3,PIM1,PIM2,PIM5,HADCU)
00101 DO K=1,4
00102 HADCUR(K)=HADCUR(K)+HADCU(K)
00103 ENDDO
00104 CALL CURR5X(MNUM,PIM5,PIM3,PIM1,PIM4,PIM2,HADCU)
00105 DO K=1,4
00106 HADCUR(K)=HADCUR(K)+HADCU(K)
00107 ENDDO
00108 CALL CURR5X(MNUM,PIM5,PIM4,PIM1,PIM3,PIM2,HADCU)
00109 DO K=1,4
00110 HADCUR(K)=HADCUR(K)+HADCU(K)
00111 ENDDO
00112 DO K=1,4
00113 HADCUR(K)=HADCUR(K)*SQRT(1.0/24.0)
00114 ENDDO
00115 ELSEIF (MNUM.EQ.28) THEN
00116 CALL CURR5X(MNUM,PIM4,PIM5,PIM2,PIM3,PIM1,HADCU)
00117 DO K=1,4
00118 HADCUR(K)=HADCU(K)
00119 ENDDO
00120 CALL CURR5X(MNUM,PIM1,PIM5,PIM2,PIM3,PIM4,HADCU)
00121 DO K=1,4
00122 HADCUR(K)=HADCUR(K)+HADCU(K)
00123 ENDDO
00124 CALL CURR5X(MNUM,PIM1,PIM4,PIM2,PIM3,PIM5,HADCU)
00125 DO K=1,4
00126 HADCUR(K)=HADCUR(K)+HADCU(K)
00127 ENDDO
00128 CALL CURR5X(MNUM,PIM4,PIM5,PIM3,PIM2,PIM1,HADCU)
00129 DO K=1,4
00130 HADCUR(K)=HADCUR(K)+HADCU(K)
00131 ENDDO
00132 CALL CURR5X(MNUM,PIM1,PIM5,PIM3,PIM2,PIM4,HADCU)
00133 DO K=1,4
00134 HADCUR(K)=HADCUR(K)+HADCU(K)
00135 ENDDO
00136 CALL CURR5X(MNUM,PIM1,PIM4,PIM3,PIM2,PIM5,HADCU)
00137 DO K=1,4
00138 HADCUR(K)=HADCUR(K)+HADCU(K)
00139 ENDDO
00140 DO K=1,4
00141 HADCUR(K)=HADCUR(K)*SQRT(1.0/12.0)
00142 ENDDO
00143
00144 ELSE
00145 CALL CURR5X(MNUM,PIM1,PIM2,PIM3,PIM4,PIM5,HADCU)
00146 DO K=1,4
00147 HADCUR(K)=HADCU(K)
00148 ENDDO
00149 ENDIF
00150 END
00151
00152 SUBROUTINE CURR5X(MNUM,PIM1,PIM2,PIM3,PIM4,PIM5,HADCUR)
00153
00154
00155
00156
00157 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00158 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00159 * ,AMK,AMKZ,AMKST,GAMKST
00160
00161 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00162 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00163 * ,AMK,AMKZ,AMKST,GAMKST
00164
00165 REAL PIM1(4),PIM2(4),PIM3(4),PIM4(4),PIM5(4)
00166 COMPLEX HADCUR(4)
00167
00168 INTEGER K,L,MNUM,K1,K2,IRO,I,J,KK
00169 REAL PA(4),PB(4),PAA(4),PC(4),PD(4)
00170 REAL AA(4,4),PP(4,4)
00171 REAL A,XM,XG,G1,G2,G,AMRO2,GAMRO2,AMRO3,GAMRO3,AMOM,GAMOM
00172 REAL FRO,COEF1,FPI,COEF2,QQ,SK,DENOM,SIG,QQA,SS23,SS24,SS34,QP1P2
00173 REAL QP1P3,QP1P4,P1P2,P1P3,P1P4,SIGN
00174 REAL PKORB,AMPA
00175 COMPLEX ALF0,ALF1,ALF2,ALF3
00176 COMPLEX LAM0,LAM1,LAM2,LAM3
00177 COMPLEX BET1,BET2,BET3
00178 COMPLEX FORM1,FORM2,FORM3,FORM4,FORM2PI
00179 COMPLEX BWIGM,WIGFOR,FPIKM,FPIKMD
00180 COMPLEX AMPL(7),AMPR
00181 COMPLEX BWIGN
00182
00183 DATA PI /3.141592653589793238462643/
00184 BWIGN(A,XM,XG)=XM**2/CMPLX(A-XM**2,XM*XG)
00185
00186 sa1=(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)+PIM5(4))**2
00187 $ -(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)+PIM5(3))**2
00188 $ -(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)+PIM5(2))**2
00189 $ -(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)+PIM5(1))**2
00190
00191
00192 IF (MNUM.EQ.24) THEN
00193
00194
00195 somega=(PIM2(4)+PIM3(4)+PIM4(4))**2-(PIM2(3)+PIM3(3)+PIM4(3))**2
00196 $ -(PIM2(2)+PIM3(2)+PIM4(2))**2-(PIM2(1)+PIM3(1)+PIM4(1))**2
00197 sp= (PIM2(4)+PIM4(4))**2-(PIM2(3)+PIM4(3))**2
00198 $ -(PIM2(2)+PIM4(2))**2-(PIM2(1)+PIM4(1))**2
00199 sm= (PIM3(4)+PIM4(4))**2-(PIM3(3)+PIM4(3))**2
00200 $ -(PIM3(2)+PIM4(2))**2-(PIM3(1)+PIM4(1))**2
00201 s0= (PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2
00202 $ -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2
00203
00204
00205
00206 srho=(PIM1(4)+PIM5(4))**2-(PIM1(3)+PIM5(3))**2
00207 $ -(PIM1(2)+PIM5(2))**2-(PIM1(1)+PIM5(1))**2
00208
00209 DO K=1,4
00210 HADCUR(K)=CMPLX(0.0)
00211 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)+PIM5(K)
00212 PA(K) =PIM2(K)+PIM3(K)+PIM4(K)
00213 PB(K)=PIM1(K)-PIM5(K)
00214 ENDDO
00215 CALL LEVICI(PC,PIM2,PIM3,PIM4)
00216 CALL LEVICI(PD,PB,PC,PAA)
00217
00218
00219 AMOM=.782
00220 GAMOM= 0.0085
00221 ama2=1.260
00222 gama2=0.400
00223
00224
00225 CARB=3000
00226 Gropp=6
00227 FOMEGA=0.07
00228 COEF1=CARB/amro**2/amom**2* Gropp* (fomega*Gropp/AMRO**2)
00229 DO K=1,4
00230 HADCUR(K)=COEF1*PD(K)
00231 HADCUR(K)=HADCUR(K)*BWIGN(SOMEGA,AMOM,GAMOM)
00232 $ *BWIGN(SRHO,AMRO,GAMRO)*BWIGN(SA1,AMA2,GAMA2)
00233
00234
00235 ENDDO
00236 ELSEIF (MNUM.EQ.26.OR.MNUM.EQ.27.OR.MNUM.EQ.28) THEN
00237
00238
00239 DO K=1,4
00240 HADCUR(K)=CMPLX(0.0)
00241 ENDDO
00242
00243 sa2=(PIM2(4)+PIM3(4)+PIM1(4))**2-(PIM2(3)+PIM3(3)+PIM1(3))**2
00244 $ -(PIM2(2)+PIM3(2)+PIM1(2))**2-(PIM2(1)+PIM3(1)+PIM1(1))**2
00245 s2= (PIM1(4)+PIM3(4))**2-(PIM1(3)+PIM3(3))**2
00246 $ -(PIM1(2)+PIM3(2))**2-(PIM1(1)+PIM3(1))**2
00247 s1= (PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2
00248 $ -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2
00249 s2x13=PIM2(4)*(PIM1(4)-PIM3(4))-PIM2(3)*(PIM1(3)-PIM3(3))
00250 $ -PIM2(2)*(PIM1(2)-PIM3(2))-PIM2(1)*(PIM1(1)-PIM3(1))
00251 s1x23=PIM1(4)*(PIM2(4)-PIM3(4))-PIM1(3)*(PIM2(3)-PIM3(3))
00252 $ -PIM1(2)*(PIM2(2)-PIM3(2))-PIM1(1)*(PIM2(1)-PIM3(1))
00253
00254
00255
00256 sf=(PIM4(4)+PIM5(4))**2-(PIM4(3)+PIM5(3))**2
00257 $ -(PIM4(2)+PIM5(2))**2-(PIM4(1)+PIM5(1))**2
00258
00259 DO K=1,4
00260 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)+PIM5(K)
00261 PA(K) =PIM1(K)+PIM2(K)+PIM3(K)
00262 PB(K)=PA(K)*s2x13/sa2-(PIM1(K)-PIM3(K))
00263 PC(K)=PA(K)*s1x23/sa2-(PIM2(K)-PIM3(K))
00264 ENDDO
00265 PAPB=PAA(4)*PB(4)-PAA(3)*PB(3)-PAA(2)*PB(2)-PAA(1)*PB(1)
00266 PAPC=PAA(4)*PC(4)-PAA(3)*PC(3)-PAA(2)*PC(2)-PAA(1)*PC(1)
00267 DO K=1,4
00268 HADCUR(K)=HADCUR(K)+(PAA(K)*PAPB/sa1-PB(K))*BWIGN(s2,amro,gamro)
00269 HADCUR(K)=HADCUR(K)+(PAA(K)*PAPC/sa1-PC(K))*BWIGN(s1,amro,gamro)
00270 ENDDO
00271
00272
00273 AMf2=.800
00274 GAMF2=.600
00275 ama2=1.260
00276 gama2=.400
00277
00278
00279 CARB=4.
00280 faaf=4.
00281 fpp=5.
00282 Grorop=6.
00283 Gropp=6.
00284 COEF1=CARB/ama2**4/amf2**2/amro**2*faaf*fpp* Grorop* Gropp
00285 DO K=1,4
00286 HADCUR(K)=COEF1*HADCUR(K)
00287 HADCUR(K)=HADCUR(K)*BWIGN(SF,AMF2,GAMF2)
00288 $ *BWIGN(SA2,AMA2,GAMA2)*BWIGN(SA1,AMA2,GAMA2)
00289 ENDDO
00290
00291 ELSE
00292
00293
00294 FPI=93.3E-3
00295 COEF1=2*2.0*SQRT(3.0)/FPI**3
00296 COEF1= 1D0/AMTAU**3 *(4*3*2*1)* (4*pi)**3* SQRT(20.0D0)
00297
00298
00299
00300
00301 DO K=1,4
00302 HADCUR(K)=CMPLX(0.0)
00303 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)+PIM5(K)
00304 HADCUR(K)=COEF1*PAA(K)
00305 ENDDO
00306 ENDIF
00307 END
00308 SUBROUTINE LEVICI(P,A,B,C)
00309 REAL P(4),A(4),B(4),C(4)
00310
00311 P(1)=A(2)*B(3)*C(4)+A(3)*B(4)*C(2)+A(4)*B(2)*C(3)
00312 $ -A(2)*B(4)*C(3)-A(4)*B(3)*C(2)-A(3)*B(2)*C(4)
00313
00314 P(2)=A(1)*B(4)*C(3)+A(3)*B(1)*C(4)+A(4)*B(3)*C(1)
00315 $ -A(1)*B(3)*C(4)-A(4)*B(1)*C(3)-A(3)*B(4)*C(1)
00316
00317 P(3)=A(1)*B(2)*C(4)+A(4)*B(1)*C(2)+A(2)*B(4)*C(1)
00318 $ -A(1)*B(4)*C(2)-A(2)*B(1)*C(4)-A(4)*B(2)*C(1)
00319
00320 P(4)=A(1)*B(3)*C(2)+A(2)*B(1)*C(3)+A(3)*B(2)*C(1)
00321 $ -A(1)*B(2)*C(3)-A(3)*B(1)*C(2)-A(2)*B(3)*C(1)
00322
00323 P(1)=-P(1)
00324 P(2)=-P(2)
00325 P(3)=-P(3)
00326 END
00327
00328
00329 SUBROUTINE CURR_CLEO(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00341 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00342 * ,AMK,AMKZ,AMKST,GAMKST
00343
00344 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00345 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00346 * ,AMK,AMKZ,AMKST,GAMKST
00347
00348 REAL PIM1(4),PIM2(4),PIM3(4),PIM4(4)
00349 COMPLEX HADCUR(4)
00350
00351 INTEGER K,L,MNUM,K1,K2,IRO,I,J,KK
00352 REAL PA(4),PB(4),PAA(4)
00353 REAL AA(4,4),PP(4,4)
00354 REAL A,XM,XG,G1,G2,G,AMRO2,GAMRO2,AMRO3,GAMRO3,AMOM,GAMOM
00355 REAL FRO,COEF1,FPI,COEF2,QQ,SK,DENOM,SIG,QQA,SS23,SS24,SS34,QP1P2
00356 REAL QP1P3,QP1P4,P1P2,P1P3,P1P4,SIGN
00357 REAL PKORB,AMPA
00358 COMPLEX ALF0,ALF1,ALF2,ALF3
00359 COMPLEX LAM0,LAM1,LAM2,LAM3
00360 COMPLEX BET1,BET2,BET3
00361 COMPLEX FORM1,FORM2,FORM3,FORM4,FORM2PI
00362 COMPLEX BWIGM,WIGFOR,FPIKM,FPIKMD
00363 COMPLEX AMPL(7),AMPR
00364 COMPLEX BWIGN
00365
00366 BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG)
00367
00368
00369
00370 IF (G1.NE.12.924) THEN
00371 G1=12.924
00372 G2=1475.98
00373 FPI=93.3E-3
00374 G =G1*G2
00375 FRO=0.266*AMRO**2
00376 COEF1=2.0*SQRT(3.0)/FPI**2
00377 COEF2=FRO*G
00378 COEF2= COEF2*0.56
00379
00380
00381 AMRO2 = 1.465
00382 GAMRO2= 0.310
00383 AMRO3=1.700
00384 GAMRO3=0.235
00385
00386 AMOM = PKORB(1,14)
00387 GAMOM = PKORB(2,14)
00388 AMRO2 = PKORB(1,21)
00389 GAMRO2= PKORB(2,21)
00390 AMRO3 = PKORB(1,22)
00391 GAMRO3= PKORB(2,22)
00392
00393
00394 AMPL(1) = CMPLX(PKORB(3,31)*COEF1,0.)
00395 AMPL(2) = CMPLX(PKORB(3,32)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,42)))
00396 AMPL(3) = CMPLX(PKORB(3,33)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,43)))
00397 AMPL(4) = CMPLX(PKORB(3,34)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,44)))
00398 AMPL(5) = CMPLX(PKORB(3,35)*COEF2,0.)*CEXP(CMPLX(0.,PKORB(3,45)))
00399
00400 AMPL(6) = CMPLX(PKORB(3,36)*COEF1)
00401 AMPL(7) = CMPLX(PKORB(3,37)*COEF1)
00402
00403
00404 ALF0 = CMPLX(PKORB(3,51),0.0)
00405 ALF1 = CMPLX(PKORB(3,52)*AMRO**2,0.0)
00406 ALF2 = CMPLX(PKORB(3,53)*AMRO2**2,0.0)
00407 ALF3 = CMPLX(PKORB(3,54)*AMRO3**2,0.0)
00408
00409 LAM0 = CMPLX(PKORB(3,55),0.0)
00410 LAM1 = CMPLX(PKORB(3,56)*AMRO**2,0.0)
00411 LAM2 = CMPLX(PKORB(3,57)*AMRO2**2,0.0)
00412 LAM3 = CMPLX(PKORB(3,58)*AMRO3**2,0.0)
00413
00414 BET1 = CMPLX(PKORB(3,59)*AMRO**2,0.0)
00415 BET2 = CMPLX(PKORB(3,60)*AMRO2**2,0.0)
00416 BET3 = CMPLX(PKORB(3,61)*AMRO3**2,0.0)
00417
00418 END IF
00419
00420
00421
00422 DO 7 K=1,4
00423 DO 8 L=1,4
00424 8 AA(K,L)=0.0
00425 HADCUR(K)=CMPLX(0.0)
00426 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)
00427 PP(1,K)=PIM1(K)
00428 PP(2,K)=PIM2(K)
00429 PP(3,K)=PIM3(K)
00430 7 PP(4,K)=PIM4(K)
00431
00432
00433
00434 IF (MNUM.EQ.1) THEN
00435
00436
00437
00438 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00439
00440
00441 FORM4= LAM0+LAM1*BWIGN(QQ,AMRO,GAMRO)
00442 * +LAM2*BWIGN(QQ,AMRO2,GAMRO2)
00443 * +LAM3*BWIGN(QQ,AMRO3,GAMRO3)
00444
00445
00446 DO 201 K1=1,3
00447 DO 201 K2=3,4
00448
00449 IF (K2.EQ.K1) THEN
00450 GOTO 201
00451 ELSEIF (K2.EQ.3) THEN
00452
00453 AMPR = AMPL(3)
00454 AMPA = AMPIZ
00455 ELSEIF (K1.EQ.3) THEN
00456
00457 AMPR = AMPL(4)
00458 AMPA = AMPIZ
00459 ELSE
00460
00461 AMPR = AMPL(2)
00462 AMPA = AMPI
00463 END IF
00464
00465 SK=(PP(K1,4)+PP(K2,4))**2-(PP(K1,3)+PP(K2,3))**2
00466 $ -(PP(K1,2)+PP(K2,2))**2-(PP(K1,1)+PP(K2,1))**2
00467
00468
00469
00470 DO 202 I=1,4
00471 DO 203 J=1,4
00472 203 AA(I,J)=0.0
00473 202 AA(I,I)=1.0
00474
00475 DO 204 L=1,4
00476 IF (L.NE.K1.AND.L.NE.K2) THEN
00477 DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00478 $ -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00479 DO 205 I=1,4
00480 DO 205 J=1,4
00481 SIG= 1.0
00482 IF(J.NE.4) SIG=-SIG
00483 AA(I,J)=AA(I,J)
00484 $ -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00485 205 CONTINUE
00486 ENDIF
00487 204 CONTINUE
00488
00489
00490
00491
00492
00493 FORM2PI= BET1*BWIGM(SK,AMRO,GAMRO,AMPA,AMPI)
00494 1 +BET2*BWIGM(SK,AMRO2,GAMRO2,AMPA,AMPI)
00495 2 +BET3*BWIGM(SK,AMRO3,GAMRO3,AMPA,AMPI)
00496 FORM1= AMPL(1)+AMPR*FORM2PI
00497
00498 DO 206 I=1,4
00499 DO 206 J=1,4
00500 HADCUR(I)=HADCUR(I)+FORM1*FORM4*AA(I,J)*(PP(K1,J)-PP(K2,J))
00501 206 CONTINUE
00502
00503 201 CONTINUE
00504
00505
00506
00507
00508 IF (AMPL(5).EQ.CMPLX(0.,0.)) GOTO 311
00509
00510
00511
00512
00513 FORM2=AMPL(5)*(ALF0+ALF1*BWIGN(QQ,AMRO,GAMRO)
00514 * +ALF2*BWIGN(QQ,AMRO2,GAMRO2)
00515 * +ALF3*BWIGN(QQ,AMRO3,GAMRO3))
00516
00517
00518
00519 DO 301 KK=1,2
00520 DO 302 I=1,4
00521 PA(I)=PP(KK,I)
00522 PB(I)=PP(3-KK,I)
00523 302 CONTINUE
00524
00525 QQA=0.0
00526 SS23=0.0
00527 SS24=0.0
00528 SS34=0.0
00529 QP1P2=0.0
00530 QP1P3=0.0
00531 QP1P4=0.0
00532 P1P2 =0.0
00533 P1P3 =0.0
00534 P1P4 =0.0
00535 DO 303 K=1,4
00536 SIGN=-1.0
00537 IF (K.EQ.4) SIGN= 1.0
00538 QQA=QQA+SIGN*(PAA(K)-PA(K))**2
00539 SS23=SS23+SIGN*(PB(K) +PIM3(K))**2
00540 SS24=SS24+SIGN*(PB(K) +PIM4(K))**2
00541 SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2
00542 QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K)
00543 QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K)
00544 QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K)
00545 P1P2=P1P2+SIGN*PA(K)*PB(K)
00546 P1P3=P1P3+SIGN*PA(K)*PIM3(K)
00547 P1P4=P1P4+SIGN*PA(K)*PIM4(K)
00548 303 CONTINUE
00549
00550
00551
00552
00553
00554 FORM3=BWIGN(QQA,AMOM,GAMOM)
00555
00556 DO 304 K=1,4
00557 HADCUR(K)=HADCUR(K)+FORM2*FORM3*(
00558 $ PB (K)*(QP1P3*P1P4-QP1P4*P1P3)
00559 $ +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4)
00560 $ +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) )
00561 304 CONTINUE
00562 301 CONTINUE
00563 311 CONTINUE
00564
00565 ELSE
00566
00567
00568
00569
00570 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00571
00572
00573 DO 101 K=1,3
00574 SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2
00575 $ -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2
00576
00577
00578
00579 DO 102 I=1,4
00580 DO 103 J=1,4
00581 103 AA(I,J)=0.0
00582 102 AA(I,I)=1.0
00583
00584
00585 DO 104 L=1,3
00586 IF (L.NE.K) THEN
00587 DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00588 $ -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00589 DO 105 I=1,4
00590 DO 105 J=1,4
00591 SIG=1.0
00592 IF(J.NE.4) SIG=-SIG
00593 AA(I,J)=AA(I,J)
00594 $ -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00595 105 CONTINUE
00596 ENDIF
00597 104 CONTINUE
00598
00599
00600
00601
00602
00603 FORM1 = AMPL(6)+AMPL(7)*FPIKM(SQRT(SK),AMPI,AMPI)
00604
00605 DO 106 I=1,4
00606 DO 106 J=1,4
00607 HADCUR(I)=HADCUR(I)+FORM1*AA(I,J)*(PP(K,J)-PP(4,J))
00608 106 CONTINUE
00609
00610 101 CONTINUE
00611
00612 ENDIF
00613 END
00614
00615
00616