-
- SUBROUTINE FSIPN !(WEIF)
-C calculating particle-nucleus Coulomb Wave functions FFij
- IMPLICIT REAL*8 (A-H,O-Z)
- COMMON/FSI_POC/AMN,AM1,AM2,CN,C1,C2,AC1,AC2
- COMMON/FSI_MOM/P1X,P1Y,P1Z,E1,P1, !part. momenta in NRF
- 1 P2X,P2Y,P2Z,E2,P2
- COMMON/FSI_COOR/X1,Y1,Z1,T1,R1, ! 4-coord. of emis. points in NRF
- 1 X2,Y2,Z2,T2,R2
- COMMON/FSI_NS/LL,NS,ICH,ISI,IQS,I3C,I3S
- COMMON/FSI_ACH/HPR,AC,ACH,ACHR,ISPIN,MSPIN
- COMMON/FSI_ICH1/ICH1
- COMMON/FSI_ETA/ETA
- COMMON/LEDWEIGHT/WEIF,WEI,WEIN,ITEST,IRANPOS
- COMMON/FSI_FFPN/FF12,FF21
- COMPLEX*16 FF1,FF12,FF21
- FF12=DCMPLX(1.D0,0.D0)
- FF21=DCMPLX(1.D0,0.D0)
- IF(I3C.EQ.0)RETURN
- ICH1=IDINT(C1)
- IF(ICH1.EQ.0)GOTO 11
- XH=AC1*P1
- ACH=ACP(XH)
- ACHR=DSQRT(ACH)
- ETA=0.D0
- IF(XH.NE.0.D0)ETA=1/XH
- RHOS=P1*R1
- HS=X1*P1X+Y1*P1Y+Z1*P1Z
- FF12=FF12*FF1(RHOS,HS)
- IF(IQS.EQ.0)GOTO 11
- RHOS=P1*R2
- HS=X2*P1X+Y2*P1Y+Z2*P1Z
- FF21=FF21*FF1(RHOS,HS)
- 11 ICH1=IDINT(C2)
- IF(ICH1.EQ.0)GOTO 10
- XH=AC2*P2
- ACH=ACP(XH)
- ACHR=DSQRT(ACH)
- ETA=0.D0
- IF(XH.NE.0.D0)ETA=1/XH
- RHOS=P2*R2
- HS=X2*P2X+Y2*P2Y+Z2*P2Z
- FF12=FF12*FF1(RHOS,HS)
-CW WRITE(6,41)'AC2 ',AC2,'ACH ',ACH,'ETA ',ETA,'RHOS ',RHOS,'HS ',HS
-41 FORMAT(5(A5,E11.4))
-CW WRITE(6,40)'FF12 ',DREAL(FF12),DIMAG(FF12)
- IF(IQS.EQ.0)GOTO 10
- RHOS=P2*R1
- HS=X1*P2X+Y1*P2Y+Z1*P2Z
- FF21=FF21*FF1(RHOS,HS)
-CW WRITE(6,41)'AC1 ',AC1,'ACH ',ACH,'ETA ',ETA,'RHOS ',RHOS,'HS ',HS
-CW WRITE(6,40)'FF21 ',DREAL(FF21),DIMAG(FF21)
-40 FORMAT(A7,2E12.4)
- 10 CONTINUE
-
-C WEIF = the weight due to the Coulomb particle-nucleus interaction
- WEIF=DREAL(FF12)**2+DIMAG(FF12)**2
- IF(IQS.EQ.1)WEIF=0.5D0*(WEIF+DREAL(FF21)**2+DIMAG(FF21)**2)
- RETURN
- END
-
-C=======================================================
-C
- SUBROUTINE FSIWF !(WEI)
-C==> Prepares necessary quantities and call VZ(WEI) to calculate
-C the weight due to FSI
- IMPLICIT REAL*8 (A-H,O-Z)
- COMMON/FSI_CVK/V,CVK
- COMMON/FSI_MOM/P1X,P1Y,P1Z,E1,P1, !part. momenta in NRF
- 1 P2X,P2Y,P2Z,E2,P2
- COMMON/FSI_PRF/PPX,PPY,PPZ,AK,AKS,
- 1 X,Y,Z,T,RP,RPS
- COMMON/FSI_COOR/X1,Y1,Z1,T1,R1, ! 4-coord. of emis. points in NRF
- 1 X2,Y2,Z2,T2,R2
- COMMON/FSI_POC/AMN,AM1,AM2,CN,C1,C2,AC1,AC2
- COMMON/FSI_SPIN/RHO(10)
- COMMON/FSI_BP/B,P
- COMMON/FSI_ETA/ETA
- COMMON/FSI_ACH/HPR,AC,ACH,ACHR,ISPIN,MSPIN
- COMMON/FSI_SW/RB(10),EB(10),BK(10),CDK(10),SDK(10),
- 1 SBKRB(10),SDKK(10)
- COMMON/FSI_NS/LL,NS,ICH,ISI,IQS,I3C,I3S
- COMMON/FSI_RR/F(10)
- COMMON/FSI_FD/FD(10),RD(10)
- COMMON/FSI_C/C(10),AM,AMS,DM
- COMPLEX*16 C,F
- COMMON/FSI_AA/AA
- COMMON/FSI_SHH/SH,CHH
- COMMON/FSI_AAPI/AAPI(20,2)/FSI_AAND/AAND(20,4)
- COMMON/FSI_AAPIN/AAPIN(20,2)
- COMMON/FSI_P12/P12X,P12Y,P12Z,E12,P12,AM12,EPM
- COMMON/LEDWEIGHT/WEIF,WEI,WEIN,ITEST,IRANPOS
-
-
-cmlv
- IF(IRANPOS.EQ.0)THEN
-C==>calculating relative 4-coordinates of the particles in PRF
-C- {T,X,Y,Z} from the relative coordinates {TS,XS,YS,ZS} in NRF
- XS=X1-X2
- YS=Y1-Y2
- ZS=Z1-Z2
- TS=T1-T2
- RS12=XS*P12X+YS*P12Y+ZS*P12Z
- H1=(RS12/EPM-TS)/AM12
- X=XS+P12X*H1
- Y=YS+P12Y*H1
- Z=ZS+P12Z*H1
- T=(E12*TS-RS12)/AM12
- RPS=X*X+Y*Y+Z*Z
- RP=DSQRT(RPS)
-c WRITE(6,38)'RP ',RP,'X ',X,Y,Z,T
-c FORMAT(A7,E11.4,A7,4E11.4)
- ENDIF
-
- CVK=(P12X*PPX+P12Y*PPY+P12Z*PPZ)/(P12*AK)
- V=P12/E12
-
- IF(ICH.EQ.0)GOTO 21
- XH=AC*AK
- ACH=ACP(XH)
- ACHR=DSQRT(ACH)
- ETA=0.D0
- IF(XH.NE.0.D0)ETA=1/XH
-C---HCP, HPR needed (e.g. in GST) if ICH=1
- HCP=HC(XH)
- HPR=HCP+.1544313298D0
- 21 CONTINUE
- MSP=MSPIN
- DO 30 JJ=1,MSP
- ISPIN=JJ
- IF(NS.NE.1)GOTO22
-C---Calc. quantities for the square well potential;
-C-- for LL > 5 the square well potential is not possible or available
- IF(LL.EQ.4)GOTO 22
- BK(JJ)=DSQRT(EB(JJ)**2+AKS)
- XRA=2*RB(JJ)/AC
- HRA=BK(JJ)*RB(JJ)
- CALL SEQ(XRA,HRA)
- SBKRB(JJ)=HRA*B
- HRA=AK*RB(JJ)
- CALL GST(XRA,HRA)
- SDK(JJ)=SH
- CDK(JJ)=CHH
- SDKK(JJ)=RB(JJ)
- IF(AK.NE.0.D0)SDKK(JJ)=SH/AK
- IF(ICH.EQ.1)SDK(JJ)=ACH*SDK(JJ)
- 22 CONTINUE
-C-----------------------------------------------------------------------
-C---Calc. the strong s-wave scattering amplitude = C(JJ)
-C-- divided by Coulomb penetration factor squared (if ICH=1)
- IF(NS.NE.1)GOTO 230
- IF(LL.NE.4)GOTO 230 ! SW scat. amplitude used for alfa-alfa only
- GAK=G(AK)
- AKACH=AK
- IF(ICH.EQ.1)AKACH=AK*ACH
- C(JJ)=1/DCMPLX(GAK,-AKACH) ! amplitude for the SW-potential
- GOTO 30
- 230 IF(LL.EQ.5.OR.LL.EQ.6.OR.LL.EQ.7)GOTO20 ! pipi
- IF(LL.EQ.12.OR.LL.EQ.13)GOTO20 ! piN
- IF(LL.EQ.8.OR.LL.EQ.9.OR.LL.EQ.18)GOTO20 ! Nd, dd
- IF(LL.EQ.14.OR.LL.EQ.17.OR.LL.EQ.23)GOTO27 ! K+K-, K-p, K0K0-b
- A1=RD(JJ)*FD(JJ)*AKS
- A2=1+.5D0*A1
- IF(ICH.EQ.1)A2=A2-2*HCP*FD(JJ)/AC
- AKF=AK*FD(JJ)
- IF(ICH.EQ.1)AKF=AKF*ACH
- C(JJ)=FD(JJ)/DCMPLX(A2,-AKF)
- GOTO30
- 20 CONTINUE
-C---Calc. scatt. ampl. C(JJ) for pipi, piN and Nd, dd
- JH=LL-7+2*JJ-2
- IF(LL.EQ.8.OR.LL.EQ.9)GPI2=GND(AKS,JH)
- IF(LL.EQ.18)GPI2=GDD(AKS,JJ)
- IF(LL.EQ.5.OR.LL.EQ.6.OR.LL.EQ.7)GPI2=GPIPI(AKS,2)
- IF(LL.EQ.12.OR.LL.EQ.13)GPI2=GPIN(AKS,2)
- C(JJ)=1.D0/DCMPLX(GPI2,-AK) !pi+pi+, nd, pd, pi+p, dd
- IF(LL.NE.5.AND.LL.NE.6.AND.LL.NE.13)GOTO27
- IF(LL.EQ.5.OR.LL.EQ.6)GPI1=GPIPI(AKS,1)
- IF(LL.EQ.13)GPI1=GPIN(AKS,1)
- IF(LL.EQ.5.OR.LL.EQ.13)
- c C(JJ)=.6667D0/DCMPLX(GPI1,-AK)+.3333D0*C(JJ) !pi+pi-,pi-p
- IF(LL.EQ.6)C(JJ)=.3333D0/DCMPLX(GPI1,-AK)+.6667D0*C(JJ) !pi0pi0
- 27 CONTINUE
-C---Calc. K+K-, K0K0-b or K-p s-wave scatt. ampl.
- IF(LL.EQ.14.OR.LL.EQ.23)CALL CKKB
- IF(LL.EQ.17)C(JJ)=DCMPLX(3.29D0,3.55D0)
-C---Calc. pi+pi-, pi+pi+, pd, pi+p, pi-p, K+K- or K-p s-wave scatt. ampl.
-C-- divided by Coulomb penetration factor squared (if ICH=1)
- IF(ICH.EQ.0)GOTO 30
- AAK=ACH*AK
- HCP2=2*HCP/AC
- C(JJ)=1/(1/C(JJ)-HCP2+DCMPLX(0.D0,AK-AAK))
-c write(*,*)'c(jj)',c(jj)
- 30 CONTINUE
-C***********************************************************************
-c write(*,*)'before call vz in fsiwf wei',wei
- CALL VZ !(WEI)
- RETURN
- END