[Fortran] 纯文本查看 复制代码
WRITE(NOUT,1020)
IF(IPRINT.GE.0)WRITE(NOUT,1021)
21 ITER=ITER+1
IF(CDABS(E).LT.1.D-8) E=E+0.02D0
C=C1*E
E1=E
DO 22 I=1,NSTEP
22 KA(I)=C-B(I)
CK=WN(C,P(48))
CALL NORMA(RMAX,CK,RL,ETA,H,NOR,UV(1),UV(2))
CALL BCOND(H,RL,U,C,WBO(1),WBO(2),NBO,KA(1),KA(2))
IF(P(39).GT.0.05D0) GOTO 23
CALL MATCH(KA,E,MM,NSTEP,NRC,INST,NU,H,NRCSAV,ETA,L)
23 CALL INTEG(KA,U,NSTEP,INST,H,NOR,DELE,UV,NBO)
IF(NOD.GE.1) CALL NVAR(DELE,NODE,NOD,U,H,NRC,NU,NRCSAV,KA)
RMATCH=DFLOAT(INST)*H
IF(IPRINT.GE.0)WRITE(NOUT,1022)ITER,CK,E,RMATCH,NODE
DELE=DELE/C1
C CORRECTION IN ENERGY
E2=E
E1=E+DELE
IF(NODE*(NODE-NOD).NE.0)E1=DCMPLX(DREAL(E1),0.D0)
E=E1
X1=DREAL(E1)
X2=DIMAG(E1)
IF(ITER.LE.NITER) GOTO 24
WRITE(NOUT,1091)
IERROR=1
GOTO 90
C TEST NEW ENERGY VALUE
24 IF(X1.LT.P(13).OR.X1.GT.P(14)) GOTO 25
IF(X2.LT.P(15).OR.X2.GT.P(16)) GOTO 25
C ACCURACY TEST
X1=DABS(DREAL(DELE))
X2=DABS(DIMAG(DELE))
IF(X1.GT.P(11)) GOTO 21
IF(X2.GT.P(12)) GOTO 21
C NEW ENERGY ACCURATE ENOUGH - WFN IS NORMALIZED
GOTO 90
25 WRITE(NOUT,1090) E1
IERROR=1
GOTO 90
C
C OPTION 1 (SEARCH FOR THE POTENTIAL STRENGTHS)
C
40 WRITE(NOUT,1040)
IF(IPRINT.GE.0)WRITE(NOUT,1041)
E2=E
C=C1*E
CK=WN(C,P(48))
F1=1.D0
F2=1.D0
CALL NORMA(RMAX,CK,RL,ETA,H,NOR,UV(1),UV(2))
41 ITER=ITER+1
DO 42 I=1,NSTEP
42 KA(I)=C-B(I)-DCMPLX(F1*V1(I),F2*V2(I))
WB1=WBO(1)+DCMPLX(F1*DREAL(WBO(3)),F2*DIMAG(WBO(3)))
WB2=WBO(2)+DCMPLX(F1*DREAL(WBO(4)),F2*DIMAG(WBO(4)))
CALL BCOND(H,RL,U,C,WB1,WB2,NBO,KA(1),KA(2))
IF(P(39).GT.0.05D0) GOTO 43
CALL MATCH(KA,E,MM,NSTEP,NRC,INST,NU,H,NRCSAV,ETA,L)
43 CALL INTEG(KA,U,NSTEP,INST,H,NOR,DELE,UV,NBO)
IF(NOD.GE.1) CALL NVAR(DELE,NODE,NOD,U,H,NRC,NU,NRCSAV,KA)
RMATCH=DFLOAT(INST)*H
IF(IPRINT.GE.0) WRITE(NOUT,1042)ITER,F1,F2,RMATCH,NODE
CALL INTPOT(U,V1,A1,H,NSTEP)
CALL INTPOT(U,V2,A2,H,NSTEP)
C CHANGES IN F1 AND F2
X1=DREAL(A1)*DREAL(A2)+DIMAG(A1)*DIMAG(A2)
IF(DABS(X1).LT.1.0D-25) GO TO 44
DF1=(DREAL(DELE)*DREAL(A2)+DIMAG(DELE)*DIMAG(A2))/X1
DF2=(DREAL(A1)*DIMAG(DELE)-DIMAG(A1)*DREAL(DELE))/X1
GOTO 45
44 DF2=0.D0
DF1=DREAL(DELE)/DREAL(A1)
45 F11=F1
F12=F2
F1=F1+DF1
F2=F2+DF2
IF(ITER.GT.NITER)GOTO 80
IF(NODE*(NODE-NOD).NE.0) F2=0.01D0
C ACCURACY TEST
X1=DABS(DREAL(DELE/C1))
X2=DABS(DIMAG(DELE/C1))
IF(X1.GT.P(11))GOTO 41
IF(X2.GT.P(12))GOTO 41
GOTO 81
C
C OPTION 2 (REAL(E) IS FIXED. IM(E) AND THE REAL POTENTIAL ARE
C ADJUSTED)
C
60 WRITE(NOUT,1060)
F12=1.D0
IF(IPRINT.GE.0)WRITE(NOUT,1061)
F1=1.D0
61 ITER=ITER+1
C=C1*E
CK=WN(C,P(48))
DO 62 I=1,NSTEP
62 KA(I)=C-B(I)-DCMPLX(F1*V1(I),0.D0)
CALL NORMA(RMAX,CK,RL,ETA,H,NOR,UV(1),UV(2))
WB1=WBO(1)+F1*WBO(3)
WB2=WBO(2)+F1*WBO(4)
CALL BCOND(H,RL,U,C,WB1,WB2,NBO,KA(1),KA(2))
IF(P(39).GT.0.05D0) GOTO 63
CALL MATCH(KA,E,MM,NSTEP,NRC,INST,NU,H,NRCSAV,ETA,L)
63 CALL INTEG(KA,U,NSTEP,INST,H,NOR,DELE,UV,NBO)
IF(NOD.GE.1) CALL NVAR(DELE,NODE,NOD,U,H,NRC,NU,NRCSAV,KA)
RMATCH=DFLOAT(INST)*H
IF(IPRINT.GE.0) WRITE(NOUT,1062)ITER,CK,E,F1,RMATCH,NODE
CALL INTPOT(U,V1,A1,H,NSTEP)