File: DELTAL.FT of Tape: Various/ETH/f2
(Source file text)
COMMENT PROGRAM DELTAL
COMMON/W/ W1,GQ,WG,WH,NWMAX,DQSQ,MAXNO,PI,GR,ARMAX
COMMON/P/ HSTVOL,HSTKF,EF,NPURE,HSTVAL,HSTRC,POISSO,HSTNM
COMMON/M/ GSTKF,GSTVOL,GSTVAL,GSTRC,DVOVV,GSTNM
DIMENSION W1(1001),GQ(1001)
DIMENSION WG(20),WH(20)
DIMENSION GR(250),DL(5,5)
DIMENSION TITLE1(5),TITLE2(5),TITLE3(5),TITLE4(5)
DATA TITLE1 /'ASHCROFT PP:'/
DATA TITLE2 /'HEINE-ABARENKOV PP:'/
DATA TITLE3 /'PHASE SHIFTS'/
DATA TITLE4 /'FRIEDEL SUM'/
INTEGER ARMAX
PI=4.*ATAN(1.)
MAXNO=19
READ(5,500) HSTNM,NPURE,EF,HSTKF,HSTVOL,HSTVAL,HSTRC,POISSO
500 FORMAT(A2,I2,6F9.5)
IF (HSTRC.EQ.0) READ(5,501) (WH(K),K=1,MAXNO)
501 FORMAT((F9.5))
READ(6,502) GSTNM,GSTKF,GSTVOL,GSTVAL,GSTRC,DVOVV
502 FORMAT(A2,5F9.5)
IF (GSTRC.EQ.0) READ(6,501) (WG(K),K=1,MAXNO)
CALL PSEUDO
GR(ARMAX)=0.
GR(ARMAX+1)=.5
GQ(ARMAX)=-.45
GQ(ARMAX+1)=.15
CALL PLOTS(.02,0)
CALL XYPLOT(-8,-8,-3)
CALL AXIS(0,0,'Q/KF',-4,6,0,1,GR(ARMAX),GR(ARMAX+1))
CALL AXIS(0,0,'V (RYDBERG)',11,6,90,2,GQ(ARMAX),GQ(ARMAX+1))
CALL LINE(GR,GQ,ARMAX-1,1,0,200)
IF (GSTRC.NE.0) CALL SYMBOL(1,15,.7,TITLE1,0,12)
IF (GSTRC.EQ.0) CALL SYMBOL(1,15,.7,TITLE2,0,19)
CALL WHERE(A,B,C)
CALL SYMBOL(A,15,.7,HSTNM,0,2)
CALL SYMBOL(A+1.4,15,.7,'-',0,1)
CALL SYMBOL(A+2.1,15,.7,GSTNM,0,2)
CALL PLEXIT
FSUM=0.0
DELST=0.0
SL=0.0
DO 5 LL=1,5
DELTA=0.0
L=LL-1
DO 4 N=1,NWMAX
QUPKF2=DQSQ*FLOAT(N-1)/EF
IF (QUPKF2.GT.4.0) GO TO 3
X=1.-QUPKF2/2.
IF (L.EQ.0) PL=1.
IF (L.EQ.1) PL=X
IF (L.EQ.2) PL=.5*(3.*X**2-1.)
IF (L.EQ.3) PL=.5*(5.*X**3-3.*X)
IF (L.EQ.4) PL=.125*(35.*X**4-30.*X**2+3.)
DELTA=DELTA+W1(N)*PL
4 CONTINUE
3 CONTINUE
DELTA=DELTA*(DQSQ/EF)*HSTVOL*HSTKF/(-16.*PI)
FSUM=FSUM+(2./PI)*FLOAT(2*L+1)*DELTA
DL(LL,1)=DELTA**2
DL(LL,2)=SIN(DELTA)**2
DL(LL,3)=(DELTA-DELST)**2
DL(LL,4)=SIN(DELTA-DELST)**2
IF (L.GT.0) SL=SL+FLOAT(L)*DL(LL,4)
DL(LL,5)=SL
DELST=DELTA
WRITE(4,800) L,DELTA,FSUM
5 CONTINUE
WRITE(4,801)
WRITE(4,802) ((DL(K,L),L=1,5),K=1,5)
800 FORMAT(1H0,'L='I3,5X,'DELTA='F12.6,' FRIEDEL SUM='F12.6)
801 FORMAT(1H0,'DEL**2'T14'SIN(DEL)**2'T28'DDEL**2'T42
1 'SIN(DDEL)**2'T56'SUM L*SIN(DDEL)**2',/,1H )
802 FORMAT(5(/,1H ,5(F10.5,4X)))
END