65 lines
1.7 KiB
Fortran
65 lines
1.7 KiB
Fortran
|
|
c***********************************************************************
|
|
SUBROUTINE FNLOC5(U,V,W,PNLOC,FK2,FK,ETA,RC,DR,KT)
|
|
c
|
|
c Non-locality correction factor for the distorted waves
|
|
c
|
|
c***********************************************************************
|
|
c
|
|
IMPLICIT REAL*8(A-H,O-Z)
|
|
DIMENSION U(800),V(800),W(800)
|
|
FACP=PNLOC**2/8.0
|
|
IF(FACP.EQ.0.0) GO TO 410
|
|
C
|
|
WRITE(6,9900)PNLOC
|
|
IF(PNLOC.GT.0.0) THEN
|
|
R=0.0
|
|
ETAK=2.0*ETA*FK
|
|
ELSE
|
|
R1=DR*FLOAT(KT+1)
|
|
ENDIF
|
|
CTEMP1=0.0
|
|
CTEMP2=0.0
|
|
T1=0.0
|
|
T2=0.0
|
|
C
|
|
DO 400 M=1,KT
|
|
IF(PNLOC.GT.0.0) THEN
|
|
C PNLOC POSITIVE GIVES USUAL NON-LOCAL FACTOR WITH GAUSSIAN SHAPE
|
|
MK=M+M-1
|
|
R=R+DR
|
|
IF(R.GT.RC) THEN
|
|
VCOUL=ETAK/R
|
|
ELSE
|
|
VCOUL=0.5*ETAK*(3.0-(R/RC)**2)/RC
|
|
ENDIF
|
|
CTEMP1=-FACP*U(MK )+FACP*(FK2-VCOUL)
|
|
CTEMP2=-FACP*U(MK+1)
|
|
T1=U(MK )
|
|
T2=U(MK+1)
|
|
ELSE
|
|
C PNLOC NEGATIVE GIVES DIRAC TYPE DARWIN FACTOR BASED ON SPIN ORBI
|
|
MK=KT+KT-M-M+1
|
|
R2=R1
|
|
R1=R1-DR
|
|
CTEMP1=CTEMP1+PNLOC*(R2*T1+R1*V(MK ))*(DR*0.125)
|
|
CTEMP2=CTEMP2+PNLOC*(R2*T2+R1*V(MK+1))*(DR*0.125)
|
|
T1=V(MK )
|
|
T2=V(MK+1)
|
|
ENDIF
|
|
C
|
|
FACT=EXP(CTEMP1)
|
|
UT1=FACT*COS(CTEMP2)
|
|
UT2=FACT*SIN(CTEMP2)
|
|
UF1 =UT1*W(MK )-UT2*W(MK+1)
|
|
UF2 =UT1*W(MK+1)+UT2*W(MK )
|
|
W(MK )=UF1
|
|
W(MK+1)=UF2
|
|
c WRITE(20,7777)R1,T1,T2,UT1,UT2
|
|
c 7777 FORMAT(' R =',F6.2,' POT =',1P2E12.4,' FACTOR =',1P2E12.4)
|
|
400 CONTINUE
|
|
410 CONTINUE
|
|
RETURN
|
|
9900 FORMAT('0Non-locality correction is applied, parameter =',f8.3)
|
|
END
|