c***********************************************************************
SUBROUTINE COU(R,RP,ETA,L,H,F,FP,G,GP,S)
c
c Coulomb Function Subroutine
c
c Calculates the functions at 2 points, R and RP for convenience
c in matching to the output of some integration formulae.
c
c R First argument
c RP Second argument
c E Coulomb parameter, eta
c L Number of angular momenta = lmax+1
c H Integration step size, usually = 0.10
c F Regular function at R
c FP Regular function at RP
c G Irregular function at R
c GP Irregular function at RP
c S Coulomb phase
c
c***********************************************************************
c
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION F(51),FP(51),G(51),GP(51),S(51)
C
LL=L
IF(LL.LT.50) THEN
ELP=50.
J=50
ELSE
ELP=LL
J=LL
ENDIF
A=ATAN (ETA/ELP)
B=SQRT (ETA**2+ELP**2)
Y=A*(ELP-0.5)+ETA*( LOG(B)-1.)-SIN (A)/(12.*B)
1 +SIN (3.*A)/(360.*B**3)-SIN (5.*A)/(1260.*B**5)
2 +SIN (7.*A)/(1680.*B**7)-SIN (9.*A)/(1188.*B**9)
C
K=J-1
DO 100 I=1,K
IF(J.LE.LL) S(J)=Y
ELP=ELP-1.
J=J-1
Y=Y-ATAN (ETA/ELP)
100 CONTINUE
S(1)=Y
DEL1=R-2.0*ETA
RMAX=.41666667*(ETA**2+4.*ETA+3.)
IF(RMAX.LT.10.0) RMAX=10.0
DEL=R-RMAX
IF(ETA.GE.5.0.AND.ABS (DEL1).LT.ABS (DEL)) THEN
DEL=DEL1
I1=2
C Transition line expansion
X=2.0*ETA
T1=ETA**2
T2=T1**2
T3=ETA** .666666667
T4=T3**2
T5=T4**2
T6=T3*T5
T7=T4*T6
T8=T3*T7
T9=ETA** .166666667
Y=1.22340402*T9*(1.+.495957017E-1/T4-.888888889E-2/T1
1 +.245519918E-2/T6-.910895806E-3/T2+.845362E-3/T8)
Z=-.707881773/T9*(1.-.172826039/T3+.317460317E-3/T1
1 -.358121485E-2/T5+.311782468E-3/T2-.907396643E-3/T7)
ELSE
C
IF(DEL.GE.0.0.OR.ETA.EQ.0.0) THEN
X=R
I1=1
ELSE
X=RMAX
I1=2
ENDIF
C Asymptotic expansion
T1=ETA**2
T2=2.*X
T4=ETA/T2
SS=1.
TS=0.
SL=0.
TL=1.-ETA/X
SSS=1.
STS=0.
SSL=0.
STL=TL
EN=0.
DO 700 K=1,25
IF(ABS (SS/SSS).GT.1.0E-10) THEN
T5=EN+1.
T6=T5+EN
T7=EN*T5
T8=T6*T4/T5
T9=(T1-T7)/(T2*T5)
T5=T8*SS-T9*TS
TS=T8*TS+T9*SS
SS=T5
T5=T8*SL-T9*TL-SS/X
TL=T8*TL+T9*SL-TS/X
SL=T5
SSS=SSS+SS
STS=STS+TS
SSL=SSL+SL
STL=STL+TL
EN=EN+1.
ENDIF
700 CONTINUE
C
T3=X-ETA* LOG(T2)+S(1)
T8=SIN (T3)
T9=COS (T3)
Y=SSS*T9-STS*T8
Z=SSL*T9-STL*T8
ENDIF
C
DO 810 I=1,I1
IF(I.EQ.I1) THEN
G(1) = Y
W = Z
DEL = RP - R
ENDIF
C Runge-Kutta integration
N=ABS (DEL/H)+1.0
DX=DEL/FLOAT(N)
T1=DX/2.
T2=DX/8.
T3=2.0*ETA
DO 805 J=1,N
T4=DX*(T3/X-1.)*Y
X=X+T1
T5=DX*(T3/X-1.)*(Y+T1*Z+T2*T4)
X=X+T1
T6=DX*(T3/X-1.)*(Y+DX*Z+T1*T5)
Y=Y+DX*(Z+(T4+2.*T5)/6.)
Z=Z+(T4+4.*T5+T6)/6.
805 CONTINUE
810 CONTINUE
GP(1)=Y
C
T1=ETA**2
T8=SQRT (1.+T1)
G(2)=((1./R+ETA)*G(1)-W)/T8
GP(2)=((1./RP+ETA)*Y-Z)/T8
T2=1.
T3=2.
C Recur irregular function upwards
DO 910 I=3,LL
T4=T2+T3
T5=T2*T3
T6=T3*SQRT (T2**2+T1)
T7=T2*SQRT (T3**2+T1)
G (I)=(T4*(ETA+T5/R )*G (I-1)-T6*G (I-2))/T7
GP(I)=(T4*(ETA+T5/RP)*GP(I-1)-T6*GP(I-2))/T7
T2=T2+1.
T3=T3+1.
910 CONTINUE
N=MAX0(L+11, INT(2.0*R+11.0) )
I1=N
Y =1.0E-20
YP=Y
Z =0.
ZP=Z
C Recur regular function downwards
DO 930 I=1,I1
T2=N
T3=T2+1.
T4=T2+T3
T5=T2*T3
T6=T2*SQRT (T3**2+T1)
T7=T3*SQRT (T2**2+T1)
X =(T4*(ETA+T5/R )*Y -T6*Z )/T7
XP=(T4*(ETA+T5/RP)*YP-T6*ZP)/T7
IF(N.LE.LL) THEN
F (N)=X
FP(N)=XP
ELSE
c Scale for l > lmax
IF(ABS (X).GT.1.0) THEN
Y =Y *1.0E-20
YP=YP*1.0E-20
X =X *1.0E-20
XP=XP*1.0E-20
ENDIF
ENDIF
N=N-1
Z =Y
ZP=YP
Y =X
YP=XP
930 CONTINUE
Z =1./(T8*(F (1)*G (2)-F (2)*G (1)))
ZP=1./(T8*(FP(1)*GP(2)-FP(2)*GP(1)))
DO 950 I=1,LL
F (I)=F (I)*Z
950 FP(I)=FP(I)*ZP
RETURN
END