PROGRAM EXTRAP99f IMPLICIT REAL*8 (A-H,O-Z) REAL*8 EPOLARF(99,12),SERIESGF(99),SERIESJ(12) REAL*8 SERIESS(99),SERIESW(99) CHARACTER*4 REF,EEEE CHARACTER*10 ELABJE,ELABJO,NAME(12),ELABF(99,12) DATA SERIESJ/5.,4.,4.,3.,4.,3.,3.,2.,3.,2.,2.,1./ DATA NAME/'2p20f 1[4]','2p20f 1[4]','2p20f 1[3]','2p20f 1[3]', 1 '2p20f 0[3]','2p20f 0[3]','2p20f 1[2]','2p20f 1[2]', 2 '2p20f 0[2]','2p20f 0[2]','2p20f 1[1]','2p20f 1[1]'/ DO 1 N=21,99 SERIESS(N)=LOG10((N/20.D0)**4) SERIESW(N)=LOG10((N/20.D0)**1.6) 1 SERIESGF(N)=LOG10((20.D0/N)**3) CALL POLARPF(EPOLARF,ELABF) DO 33 N=3,99 DO 33 I=1,12 33 PRINT 32,ELABF(N,I),EPOLARF(N,I) 32 FORMAT(2X,A10,F15.3) C1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890 C 110.4425 -3.710 6.00 0.000 0.0 s2p2 3P 90544.850 1.0 2p18d 1P 5.97 -1.87 -6.19K04 DO 9 LINE=1,9999 READ(2,140,END=88)WL,GFLOG,CODE,EJE,XJE,ELABJE,EJO,XJO,ELABJO, 1 GAMMAR,GAMMAS,GAMMAW,REF 140 FORMAT(F11.4,F7.3,F6.2,F12.3,F5.1,1X,A10,F12.3,F5.1,1X,A10, 1 F6.2,F6.2,F6.2,A4) PRINT 140,WL,GFLOG,CODE,EJE,XJE,ELABJE,EJO,XJO,ELABJO, 1 GAMMAR,GAMMAS,GAMMAW,REF c IF(ELABJE(1:4).NE.'2p20')GO TO 20 DO 8 ISERIES=1,12 IF(ELABJE.EQ.NAME(ISERIES).AND. 1XJE.EQ.SERIESJ(ISERIES))GO TO 11 8 CONTINUE CALL ABORT 11 DO 15 N=21,99 EJE=EPOLARF(N,ISERIES) WAVENO=ABS(EJE-EJO) WLVAC=1.D7/WAVENO WL=WLVAC IF(WLVAC.GT.200.)WAVE=WAVE/(1.0000834213D0+ 1 2406030.D0/(1.30D10-WAVENO**2)+15997.D0/(3.89D9-WAVENO**2)) GAMMASN=GAMMAS+SERIESS(N) GAMMAWN=GAMMAW+SERIESW(N) GFLOGN=GFLOG+SERIESGF(N) ELABJE=ELABF(N,ISERIES) REF='EXTR' WRITE(11,140)WL,GFLOGN,CODE,EJE,XJE,ELABJE,EJO,XJO,ELABJO, 1 GAMMAR,GAMMASN,GAMMAWN,REF 15 WRITE(12,140)WAVENO,GFLOGN,CODE,EJE,XJE,ELABJE,EJO,XJO,ELABJO, 1 GAMMAR,GAMMASN,GAMMAWN,REF 9 CONTINUE 88 CALL EXIT END SUBROUTINE POLARPF(EPOLARF,ELABF) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*4 ELAB(12) REAL*8 EPOLARF(99,12),XJF(12) CHARACTER*10 ELABF(99,12) DATA XJF/5.,4.,4.,3.,4.,3.,3.,2.,3.,2.,2.,1./ DATA ELAB/'1[4]','1[4]','1[3]','1[3]', 1 '0[3]','0[3]','1[2]','1[2]', 2 '0[2]','0[2]','1[1]','1[1]'/ DO 30 N=3,99 RYD=109732.298d0 EION=(90883.854d0*4.+90820.469d0*2.)/6. Z=1. ALPHAD=5.48 ALPHAQ=0.475 L=3 EAV=EPOLAR(N,L,RYD,Z,EION,ALPHAD,ALPHAQ,TPOLAR) PRINT *,EAV C HARTREE-FOCK F2=2.3426*18.**3/N**3 ZETA=42.28 C WRITE(ELABF(N,1),7)N,ELAB(1) 7 FORMAT('2p',I2,'f ',A4) ZF=ZETA/2.+F2/15. EPOLARF(N,1)=EAV+ZETA/2.+F2/15. WRITE(ELABF(N,2),7)N,ELAB(2) EPOLARF(N,2)=EAV+ZETA/2.+F2/15. WRITE(ELABF(N,3),7)N,ELAB(3) X=SQRT((3./4.*ZETA-F2/15.D0)**2+F2**2/75.D0) PRINT *,N,ZETA,F2,X EPOLARF(N,3)=EAV-ZETA/4.-F2/15.+X WRITE(ELABF(N,4),7)N,ELAB(4) EPOLARF(N,4)=EAV-ZETA/4.-F2/15.+X WRITE(ELABF(N,5),7)N,ELAB(5) EPOLARF(N,5)=EAV-ZETA/4.-F2/15.-X WRITE(ELABF(N,6),7)N,ELAB(6) EPOLARF(N,6)=EAV-ZETA/4-F2/15.-X WRITE(ELABF(N,7),7)N,ELAB(7) X=SQRT((3.*ZETA/4.-F2/50.)**2+4./125.*F2**2) EPOLARF(N,7)=EAV-ZETA/4.-F2/50.+X WRITE(ELABF(N,8),7)N,ELAB(8) EPOLARF(N,8)=EAV-ZETA/4.-F2/50.+X WRITE(ELABF(N,9),7)N,ELAB(9) EPOLARF(N,9)=EAV-ZETA/4.-F2/50.-X WRITE(ELABF(N,10),7)N,ELAB(10) EPOLARF(N,10)=EAV-ZETA/4.-F2/50.-X WRITE(ELABF(N,11),7)N,ELAB(11) EPOLARF(N,11)=EAV+ZETA/2.+4.*F2/25. WRITE(ELABF(N,12),7)N,ELAB(12) EPOLARF(N,12)=EAV+ZETA/2.+4.*F2/25. 30 CONTINUE RETURN END FUNCTION EPOLAR(N,L,RYD,Z,EION,ALPHAD,ALPHAQ,TPOLAR) IMPLICIT REAL*8 (A-H,O-Z) EHYD=RYD*Z**2/N**2 ALPHA=7.29735308d-03 X=N EREL=ALPHA**2*RYD*Z**4/X**4*(X/(L+.5)-3./4.) PNL=RYD*(3.*X**2-L*(L+1))/(2.*X**5*(L-.5)*L*(L+.5)*(L+1)*(L+1.5)) QNL=RYD/PNL* 1(35.*X**2-5.*X**2*(6.*L*(L+1.)-5.)+3.*(L-1.)*L*(L+1.)*(L+2.))/ 2(8.*X**7*(L-1.5)*(L-1)*(L-.5)*L*(L+.5)*(L+1)*(L+1.5)*(L+2)* 3(L+2.5)) EPOL=ALPHAD*Z**4*PNL*(1.+ALPHAQ/ALPHAD*Z**2*QNL) TPOLAR=-EHYD-EREL-EPOL EPOLAR=EION+TPOLAR RETURN END