00001
00002
00003
00004 COMPLEX FUNCTION F3PI(IFORM,QQ,SA,SB)
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034 INTEGER IFORM
00035 REAL QQ,SA,SB
00036
00037
00038 REAL PKORB
00039 COMPLEX BWIGML
00040
00041
00042
00043
00044 CHARACTER*(*) CRNAME
00045 PARAMETER( CRNAME = 'F3PI' )
00046
00047 INTEGER IFIRST,IDK
00048 REAL MRO,GRO,MRP,GRP,MF2,GF2,MF0,GF0,MSG,GSG
00049 REAL M1,M2,M3,M1SQ,M2SQ,M3SQ,MPIZ,MPIC
00050 REAL S1,S2,S3,R,PI
00051 REAL F134,F150,F15A,F15B,F167
00052 REAL F34A,F34B,F35,F35A,F35B,F36A,F36B
00053 COMPLEX BT1,BT2,BT3,BT4,BT5,BT6,BT7
00054 COMPLEX FRO1,FRO2,FRP1,FRP2
00055 COMPLEX FF21,FF22,FF23,FSG1,FSG2,FSG3,FF01,FF02,FF03
00056 COMPLEX FA1A1P,FORMA1
00057
00058
00059
00060
00061
00062 DATA IFIRST/0/
00063
00064
00065
00066 IF (IFIRST.EQ.0) THEN
00067 IFIRST = 1
00068
00069 MRO = 0.7743
00070 GRO = 0.1491
00071 MRP = 1.370
00072 GRP = 0.386
00073 MF2 = 1.275
00074 GF2 = 0.185
00075 MF0 = 1.186
00076 GF0 = 0.350
00077 MSG = 0.860
00078 GSG = 0.880
00079 MPIZ = PKORB(1,7)
00080 MPIC = PKORB(1,8)
00081
00082
00083 PI = 3.14159
00084 BT1 = CMPLX(1.,0.)
00085 BT2 = CMPLX(0.12,0.)*CEXP(CMPLX(0., 0.99*PI))
00086 BT3 = CMPLX(0.37,0.)*CEXP(CMPLX(0.,-0.15*PI))
00087 BT4 = CMPLX(0.87,0.)*CEXP(CMPLX(0., 0.53*PI))
00088 BT5 = CMPLX(0.71,0.)*CEXP(CMPLX(0., 0.56*PI))
00089 BT6 = CMPLX(2.10,0.)*CEXP(CMPLX(0., 0.23*PI))
00090 BT7 = CMPLX(0.77,0.)*CEXP(CMPLX(0.,-0.54*PI))
00091
00092 PRINT *,' In F3pi: add (rho-pi S-wave) + (rhop-pi S-wave) +'
00093 PRINT *,' (rho-pi D-wave) + (rhop-pi D-wave) +'
00094 PRINT *,' (f2 pi D-wave) + (sigmapi S-wave) + (f0pi S-wave)'
00095 END IF
00096
00097
00098 F3PI = CMPLX(0.,0.)
00099
00100
00101
00102
00103 R = PKORB(4,11)
00104 IF (R.EQ.0.) THEN
00105
00106 IDK = 1
00107 M1 = MPIZ
00108 M2 = MPIZ
00109 M3 = MPIC
00110 ELSE
00111
00112 IDK = 2
00113 M1 = MPIC
00114 M2 = MPIC
00115 M3 = MPIC
00116 END IF
00117 M1SQ = M1*M1
00118 M2SQ = M2*M2
00119 M3SQ = M3*M3
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133 IF (IFORM.EQ.1.OR.IFORM.EQ.2) THEN
00134 S1 = SA
00135 S2 = SB
00136 S3 = QQ-SA-SB+M1SQ+M2SQ+M3SQ
00137 IF (S3.LE.0..OR.S2.LE.0.) RETURN
00138
00139 IF (IDK.EQ.1) THEN
00140
00141
00142 F134 = -(1./3.)*((S3-M3SQ)-(S1-M1SQ))
00143 F150 = (1./18.)*(QQ-M3SQ+S3)*(2.*M1SQ+2.*M2SQ-S3)/S3
00144 F167 = (2./3.)
00145
00146
00147 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1)
00148 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1)
00149 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1)
00150 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1)
00151 FF23 = BWIGML(S3,MF2,GF2,M1,M2,2)
00152 FSG3 = BWIGML(S3,MSG,GSG,M1,M2,0)
00153 FF03 = BWIGML(S3,MF0,GF0,M1,M2,0)
00154
00155 F3PI = BT1*FRO1+BT2*FRP1+
00156 1 BT3*CMPLX(F134,0.)*FRO2+BT4*CMPLX(F134,0.)*FRP2+
00157 1 BT5*CMPLX(F150,0.)*FF23+
00158 1 BT6*CMPLX(F167,0.)*FSG3+BT7*CMPLX(F167,0.)*FF03
00159
00160
00161 ELSEIF (IDK.EQ.2) THEN
00162
00163
00164 F134 = -(1./3.)*((S3-M3SQ)-(S1-M1SQ))
00165 F15A = -(1./2.)*((S2-M2SQ)-(S3-M3SQ))
00166 F15B = -(1./18.)*(QQ-M2SQ+S2)*(2.*M1SQ+2.*M3SQ-S2)/S2
00167 F167 = -(2./3.)
00168
00169
00170 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1)
00171 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1)
00172 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1)
00173 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1)
00174 FF21 = BWIGML(S1,MF2,GF2,M2,M3,2)
00175 FF22 = BWIGML(S2,MF2,GF2,M3,M1,2)
00176 FSG2 = BWIGML(S2,MSG,GSG,M3,M1,0)
00177 FF02 = BWIGML(S2,MF0,GF0,M3,M1,0)
00178
00179 F3PI = BT1*FRO1+BT2*FRP1+
00180 1 BT3*CMPLX(F134,0.)*FRO2+BT4*CMPLX(F134,0.)*FRP2
00181 1 -BT5*CMPLX(F15A,0.)*FF21-BT5*CMPLX(F15B,0.)*FF22
00182 1 -BT6*CMPLX(F167,0.)*FSG2-BT7*CMPLX(F167,0.)*FF02
00183
00184
00185 END IF
00186
00187 ELSE IF (IFORM.EQ.3) THEN
00188 S3 = SA
00189 S1 = SB
00190 S2 = QQ-SA-SB+M1SQ+M2SQ+M3SQ
00191 IF (S1.LE.0..OR.S2.LE.0.) RETURN
00192
00193 IF (IDK.EQ.1) THEN
00194
00195
00196 F34A = (1./3.)*((S2-M2SQ)-(S3-M3SQ))
00197 F34B = (1./3.)*((S3-M3SQ)-(S1-M1SQ))
00198 F35 =-(1./2.)*((S1-M1SQ)-(S2-M2SQ))
00199
00200
00201 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1)
00202 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1)
00203 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1)
00204 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1)
00205 FF23 = BWIGML(S3,MF2,GF2,M1,M2,2)
00206
00207 F3PI =
00208 1 BT3*(CMPLX(F34A,0.)*FRO1+CMPLX(F34B,0.)*FRO2)+
00209 1 BT4*(CMPLX(F34A,0.)*FRP1+CMPLX(F34B,0.)*FRP2)+
00210 1 BT5*CMPLX(F35,0.)*FF23
00211
00212
00213 ELSEIF (IDK.EQ.2) THEN
00214
00215
00216 F34A = (1./3.)*((S2-M2SQ)-(S3-M3SQ))
00217 F34B = (1./3.)*((S3-M3SQ)-(S1-M1SQ))
00218 F35A = -(1./18.)*(QQ-M1SQ+S1)*(2.*M2SQ+2.*M3SQ-S1)/S1
00219 F35B = (1./18.)*(QQ-M2SQ+S2)*(2.*M3SQ+2.*M1SQ-S2)/S2
00220 F36A = -(2./3.)
00221 F36B = (2./3.)
00222
00223
00224 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1)
00225 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1)
00226 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1)
00227 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1)
00228 FF21 = BWIGML(S1,MF2,GF2,M2,M3,2)
00229 FF22 = BWIGML(S2,MF2,GF2,M3,M1,2)
00230 FSG1 = BWIGML(S1,MSG,GSG,M2,M3,0)
00231 FSG2 = BWIGML(S2,MSG,GSG,M3,M1,0)
00232 FF01 = BWIGML(S1,MF0,GF0,M2,M3,0)
00233 FF02 = BWIGML(S2,MF0,GF0,M3,M1,0)
00234
00235 F3PI =
00236 1 BT3*(CMPLX(F34A,0.)*FRO1+CMPLX(F34B,0.)*FRO2)+
00237 1 BT4*(CMPLX(F34A,0.)*FRP1+CMPLX(F34B,0.)*FRP2)
00238 1 -BT5*(CMPLX(F35A,0.)*FF21+CMPLX(F35B,0.)*FF22)
00239 1 -BT6*(CMPLX(F36A,0.)*FSG1+CMPLX(F36B,0.)*FSG2)
00240 1 -BT7*(CMPLX(F36A,0.)*FF01+CMPLX(F36B,0.)*FF02)
00241
00242
00243 END IF
00244 END IF
00245
00246
00247 FORMA1 = FA1A1P(QQ)
00248 F3PI = F3PI*FORMA1
00249
00250 RETURN
00251 END
00252
00253 COMPLEX FUNCTION BWIGML(S,M,G,M1,M2,L)
00254
00255
00256
00257 REAL S,M,G,M1,M2
00258 INTEGER L,IPOW
00259 REAL MSQ,W,WGS,MP,MM,QS,QM
00260
00261 MP = (M1+M2)**2
00262 MM = (M1-M2)**2
00263 MSQ = M*M
00264 W = SQRT(S)
00265 WGS = 0.0
00266 IF (W.GT.(M1+M2)) THEN
00267 QS=SQRT(ABS((S -MP)*(S -MM)))/W
00268 QM=SQRT(ABS((MSQ -MP)*(MSQ -MM)))/M
00269 IPOW = 2*L+1
00270 WGS=G*(MSQ/W)*(QS/QM)**IPOW
00271 ENDIF
00272
00273 BWIGML=CMPLX(MSQ,0.)/CMPLX(MSQ-S,-WGS)
00274
00275 RETURN
00276 END
00277
00278 COMPLEX FUNCTION FA1A1P(XMSQ)
00279
00280
00281
00282
00283 REAL XMSQ
00284 REAL PKORB,WGA1
00285 REAL XM1,XG1,XM2,XG2,XM1SQ,XM2SQ,GG1,GG2,GF,FG1,FG2
00286 COMPLEX BET,F1,F2
00287 INTEGER IFIRST/0/
00288
00289 IF (IFIRST.EQ.0) THEN
00290 IFIRST = 1
00291
00292
00293 XM1 = PKORB(1,10)
00294 XG1 = PKORB(2,10)
00295 XM2 = PKORB(1,17)
00296 XG2 = PKORB(2,17)
00297 BET = CMPLX(PKORB(3,17),0.)
00298
00299 GG1 = XM1*XG1/(1.3281*0.806)
00300 GG2 = XM2*XG2/(1.3281*0.806)
00301
00302 XM1SQ = XM1*XM1
00303 XM2SQ = XM2*XM2
00304 END IF
00305
00306 GF = WGA1(XMSQ)
00307 FG1 = GG1*GF
00308 FG2 = GG2*GF
00309 F1 = CMPLX(-XM1SQ,0.0)/CMPLX(XMSQ-XM1SQ,FG1)
00310 F2 = CMPLX(-XM2SQ,0.0)/CMPLX(XMSQ-XM2SQ,FG2)
00311 FA1A1P = F1+BET*F2
00312
00313 RETURN
00314 END
00315
00316 FUNCTION WGA1(QQ)
00317
00318
00319
00320
00321
00322
00323 REAL QQ,WGA1
00324 DOUBLE PRECISION MKST,MK,MK1SQ,MK2SQ,C3PI,CKST
00325 DOUBLE PRECISION S,WGA1C,WGA1N,WG3PIC,WG3PIN,GKST
00326 INTEGER IFIRST
00327
00328
00329 IF (IFIRST.NE.987) THEN
00330 IFIRST = 987
00331
00332
00333 MKST = 0.894D0
00334 MK = 0.496D0
00335 MK1SQ = (MKST+MK)**2
00336 MK2SQ = (MKST-MK)**2
00337
00338 C3PI = 0.2384D0**2
00339 CKST = 4.7621D0**2*C3PI
00340 END IF
00341
00342
00343
00344
00345 S = DBLE(QQ)
00346 WG3PIC = WGA1C(S)
00347 WG3PIN = WGA1N(S)
00348
00349
00350 GKST = 0.D0
00351 IF (S.GT.MK1SQ) GKST = SQRT((S-MK1SQ)*(S-MK2SQ))/(2.*S)
00352
00353 WGA1 = SNGL(C3PI*(WG3PIC+WG3PIN)+CKST*GKST)
00354
00355 RETURN
00356 END
00357
00358 DOUBLE PRECISION FUNCTION WGA1C(S)
00359
00360
00361
00362 DOUBLE PRECISION S,STH,Q0,Q1,Q2,P0,P1,P2,P3,P4,G1_IM
00363
00364 PARAMETER(Q0 = 5.80900D0,Q1 = -3.00980D0,Q2 = 4.57920D0,
00365 1 P0 = -13.91400D0,P1 = 27.67900D0,P2 = -13.39300D0,
00366 2 P3 = 3.19240D0,P4 = -0.10487D0)
00367
00368 PARAMETER (STH = 0.1753D0)
00369
00370
00371 IF(S.LT.STH) THEN
00372 G1_IM = 0.D0
00373 ELSEIF((S.GT.STH).AND.(S.LT.0.823D0)) THEN
00374 G1_IM = Q0*(S-STH)**3*(1. + Q1*(S-STH) + Q2*(S-STH)**2)
00375 ELSE
00376 G1_IM = P0 + P1*S + P2*S**2+ P3*S**3 + P4*S**4
00377 ENDIF
00378
00379 WGA1C = G1_IM
00380 RETURN
00381 END
00382
00383 DOUBLE PRECISION FUNCTION WGA1N(S)
00384
00385
00386
00387 DOUBLE PRECISION S,STH,Q0,Q1,Q2,P0,P1,P2,P3,P4,G1_IM
00388
00389 PARAMETER(Q0 = 6.28450D0,Q1 = -2.95950D0,Q2 = 4.33550D0,
00390 1 P0 = -15.41100D0,P1 = 32.08800D0,P2 = -17.66600D0,
00391 2 P3 = 4.93550D0,P4 = -0.37498D0)
00392
00393 PARAMETER (STH = 0.1676D0)
00394
00395
00396 IF(S.LT.STH) THEN
00397 G1_IM = 0.D0
00398 ELSEIF((S.GT.STH).AND.(S.LT.0.823D0)) THEN
00399 G1_IM = Q0*(S-STH)**3*(1. + Q1*(S-STH) + Q2*(S-STH)**2)
00400 ELSE
00401 G1_IM = P0 + P1*S + P2*S**2+ P3*S**3 + P4*S**4
00402 ENDIF
00403
00404 WGA1N = G1_IM
00405 RETURN
00406 END