PROGRAM RGFALL c revised 4nov14 constants given D exponents c revised 14nov13 GS can be too big for high series members c revised 18may11 John Lester error in ion pot lookup for high ions c revised 28oct09 error in isotope shift in vacuum c revised 25jun05 isoshift is now wavelength shift in mA instead of mK c revised 25may97 c this program is a quick and dirty demonstration of replacing programs c RNLTE and RLINE while keeping all the other SYNTHE programs the same. C READS LINES FROM UNIT 11 AND WRITES THEM ON UNIT 19 IF THE LINE C WAS ORIGINALLY FROM THE FILE NLTELINES.DAT OR TO UNIT 12 IF NOT, C IF IFNLTE=0 UNIT 19 IS READ BY SYNTHE AND THE LINES ARE C TREATED IN LTE. IF IFNLTE=1 UNIT 19 IS READ BY SPECTR AND THE C LINES ARE TREATED IN NLTE IF THE MODEL IS NLTE. C THESE LINES ARE TREATED WITH EXACT VOIGT OR FANO PROFILES C WL IS THE AIR WAVELENGTH IF WL .GT. 200 NM C IF THE SWITCH IFVAC=1 THE WAVELENGTH USED BY THE PROGRAM WILL C BE THE VACUUM WAVELENGTH OBTAINED FROM THE DIFFERENCE OF C THE ENERGY LEVELS C A SUFFIX P STANDS FOR PRIME INDICATING THE SECOND CONFIGURATION C J IS ANGULAR MOMENTUM C E IS ENERGY IN WAVENUMBERS C LABEL IS A LABEL FOR THE CONFIGURATION C THE GF TAPE DOES NOT KEEP LABEL AND LABELP DISTINCT C CODE FOR ATOM OR MOLECULE C NELION IS THE STORAGE LOCATION OF ELEM IN ARRAYS XNFPEL AND DOPPLE C GAMMAR IS THE RADIATIVE DAMPING CONSTANT C GAMMAW IS THE DAMPING CONSTANT PER HYDROGEN ATOM FOR VAN DER WAALS C BROADENING BY HYDROGEN AT T=10000K. C FOR HELIUM MULTIPLY BY .42 C FOR H2 MULTIPLY BY .85 C GAMMAS IS THE STARK DAMPING CONSTANT PER ELECTRON ASSUMED TO BE C TEMPERATURE INDEPENDENT C TO CONVERT GRIEM"S HALF WIDTH TO GAMMAS FOR DLAM AND LAM IN A C GAMMAS=3767.*DLAM/LAM**2 C LOG(GAMMA) IS READ IN C IF NOT READ IN GAMMAR IS CLASSICAL, GAMMAW IS FROM ALLER, AND C GAMMAS IS FROM PEYTREMANN C REF ARE A REFERENCE OR REFERENCES FOR GF AND DAMPING CONSTANTS C NBLO AND NBUP REFER TO DEPARTURE COEFFICIENT ARRAYS FOR THE LOWER C AND UPPER LEVELS (NOT FIRST AND SECOND) C ISO1 AND ISO2 ARE ISOTOPE NUMBERS FOR UP TO 2 COMPONENTS C X1 AND X2 ARE LOG FRACTIONAL ISOTOPIC ABUNDANCES THAT ARE ADDED TO C LOG GF TO OBTAIN AN ISOTOPIC ABUNDANCE C OTHER1 AND 2 ARE ADDITIONAL LABEL FIELDS OR QUANTUM NUMBERS OR C WHATEVER C OTHER1 IS NOW USED TO STORE LANDE G VALUES AS 2 I5 INTEGERS IN UNITS C OF .001 . EXAMPLE GLANDE=-.007 GLANDEP=2.499 OTHER1= -7 2499 C DWL CORRECTION TO WL C DLOGGF CORRECTION TO LOGGF C DGAMMAR LOG CORRECTION TO GAMMAR C DGAMMAS LOG CORRECTION TO GAMMAS C DGAMMAW LOG CORRECTION TO GAMMAW C ISOSHIFT IS ISOTOPE SHIFT OF WAVELENGTH IN MK = 0.001 CM-1 changed to mA C ISOSHIFT IS ISOTOPE SHIFT OF WAVELENGTH IN MA = 0.001 Angstrom = 0.0001 nm CC SAMPLE CARDS C 396.8470 -0.162 0.5 0.000 1.5 25191.541 20.01 4S 4P C 396.8470 116 8.24 -4.44 -7.80 REF PARAMETER (kw=99) c COMMON /LINDAT/WL,E,EP,LABEL(2),LABELP(2),OTHER1(2),OTHER2(2), COMMON /LINDAT/WL,E,EP,LABEL,LABELP,OTHER1,OTHER2, 1 WLVAC,CENTER,CONCEN, NELION,GAMMAR,GAMMAS,GAMMAW,REF, 2 NBLO,NBUP,ISO1,X1,ISO2,X2,GFLOG,XJ,XJP,CODE,ELO,GF,GS,GR,GW, 3 DWL,DGFLOG,DGAMMAR,DGAMMAS,DGAMMAW,DWLISO,ISOSHIFT,EXTRA3 c REAL*8 LINDAT8(14) c REAL*4 LINDAT4(28) REAL*8 LINDAT8I(3) REAL*8 LINDAT8II(3) REAL*4 LINDAT4I(4) REAL*4 LINDAT4II(23) c EQUIVALENCE (LINDAT8(1),WL),(LINDAT4(1),NELION) EQUIVALENCE (LINDAT8I(1),WL) EQUIVALENCE (LINDAT8II(1),WLVAC) EQUIVALENCE (LINDAT4I(1),NELION) EQUIVALENCE (LINDAT4II(1),NBLO) character*10 LABEL,LABELP,OTHER1,OTHER2 REAL*8 RESOLU,RATIO,RATIOLG,SIGMA2,WLBEG,WLEND REAL*8 WL,E,EP,WLVAC,CENTER,CONCEN c REAL*8 LABEL,LABELP,OTHER1,OTHER2 CHARACTER*20 NOTES CHARACTER*10 COTHER1,COTHER2 EQUIVALENCE (COTHER1,OTHER1),(COTHER2,OTHER2) CHARACTER*3 AUTO CHARACTER*6 IXFIXFP character*4 REF DIMENSION DECKJ(7,kw) INTEGER TYPE EQUIVALENCE (GAMMAS,ASHORE),(GAMMAW,BSHORE) EQUIVALENCE (GF,G,CGF),(TYPE,NLAST),(GAMMAR,XSECT,GAUNT) C correction 18 May 2011 plus new version of subroutine ionpots. COMMON /POTION/POTION(999) real*8 potion C COMMON /POTION/POTION(594) DIMENSION CODEX(17) DIMENSION DELLIM(7) DIMENSION NTENS(10) DATA NTENS/1,10,100,1000,10000,100000,1000000,10000000, 1 100000000,1000000000/ DATA CODEX/1.,2.,2.01,6.,6.01,12.,12.01,13.,13.01,14.,14.01, 1 20.,20.01,8.,11.,5.,19./ DATA DELLIM/100.,30.,10.,3.,1.,.3,.1/ C CALL BEGTIME READ(93)NLINES,LENGTH,IFVAC,IFNLTE,N19,TURBV,DECKJ,IFPRED, 1WLBEG,WLEND,RESOLU,RATIO,RATIOLG,CUTOFF,LINOUT write(6,1656)linout 1656 format(1x,'LINOUT=',i10) IXWLBEG=DLOG(WLBEG)/RATIOLG IF(DEXP(IXWLBEG*RATIOLG).LT.WLBEG)IXWLBEG=IXWLBEG+1 DELFACTOR=1. IF(WLBEG.GT.500.)DELFACTOR=WLBEG/500. N14=0 c OPEN(UNIT=11,STATUS='OLD',READONLY,SHARED,RECL=160) OPEN(UNIT=12,STATUS='OLD',FORM='UNFORMATTED',ACCESS='APPEND') OPEN(UNIT=14,STATUS='OLD',FORM='UNFORMATTED',ACCESS='APPEND') OPEN(UNIT=19,STATUS='OLD',FORM='UNFORMATTED',ACCESS='APPEND') OPEN(UNIT=20,STATUS='OLD',FORM='UNFORMATTED',ACCESS='APPEND') OTHER1=(' ') OTHER2=(' ') c OTHER2(2)=(' ') DWL=0. DLOGGF=0. DGAMMAR=0. DGAMMAS=0. DGAMMAW=0. DWLISO=0. alpha=0. c igiro=0 DO 900 ILINE=1,50000000 c READ(11,140,END=145)WL,GFLOG,CODE,E,XJ,LABEL,EP,XJP,LABELP, c 1 GR,GS,GW,REF,NBLO,NBUP,ISO1,X1,ISO2,X2,OTHER1, c 2 OTHER2,LANDE,LANDEP,ISOSHIFT,alpha READ(11,140,END=145)WL,GFLOG,CODE,E,XJ,LABEL,EP,XJP,LABELP, 1 GR,GS,GW,REF,NBLO,NBUP,ISO1,X1,ISO2,X2,OTHER1, 2 OTHER2,LANDE,LANDEP,ISOSHIFT,alpha 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,I2,I2,I3,F6.3,I3,F6.3,A10,A10,2I5,I6,f6.3) write(6,140)wl,gflog,code,alpha c type*,wl c if(alpha.ne.0)write(6,*)wl,alpha C 1234567 123456789012 1 C12345678901 123456 12345 1234567890 1234567890 C 234.0154 -3.888 3.00 0.000 0.5 2s 2S 42719.141 0.5 12p 2P more C C continuing 12345678901234567890 C 5.21 0.00 0.00LN 0 0 0 0.000 0 0.000 1234 5678 -7 c 140 FORMAT(F11.4,F7.3,F6.2,F12.3,F5.1,1X,A8,A2,F12.3,F5.1,1X,A8,A2, c 1 F6.2,F6.2,F6.2,A4,I2,I2,I3,F6.3,I3,F6.3,A8,A2,A8,A2,2I5,I6,f6.3) c if(code.eq.31.01.and.igiro.eq.0)then c do 1222 index=1,999 c type*,index,potion(index) c 1222 continue c igiro=igiro+1 c endif C OTHER1 IS HYPERFINE SHIFTS C IXFIXFP IS HYPERFINE NOTATION READ(COTHER1,'(2I5)')ISHIFT,ISHIFTP READ(COTHER2,'(A6,I1,A3)')IXFIXFP,LINESIZE,AUTO ESHIFT=ISHIFT*.001 ESHIFTP=ISHIFTP*.001 c DWLISO=-ISOSHIFT*.001*ABS(WL)**2/1.D7 c WLVAC=ABS(WL)+DWL+DWLISO DWLISO=ISOSHIFT*.0001 WLVAC=ABS(WL)+DWL c IF(IFVAC.EQ.1.OR.LABELP(1).EQ.'CONTINUU')WLVAC= IF(IFVAC.EQ.1.OR.LABELP.EQ.'CONTINUUM ')WLVAC= 1 1.D7/DABS(DABS(EP)+ESHIFTP-(DABS(E)+ESHIFT))+DWL+DWLISO IF(WLVAC.GT.WLEND+DELLIM(1))GO TO 145 IXWL=DLOG(WLVAC)/RATIOLG+.5D0 NBUFF=IXWL-IXWLBEG+1 LIM=MIN(8-LINESIZE,7) IF(CODE.EQ.1.)LIM=1 IF(WLVAC.LT.WLBEG-DELLIM(LIM)*DELFACTOR)GO TO 900 C IF(WLVAC.GT.WLEND+DELLIM(LIM)*DELFACTOR)GO TO 900 IF(WLVAC.GT.WLEND+DELLIM(LIM)*DELFACTOR)GO TO 145 C CORONAL APPROXIMATION LINE IF(AUTO.EQ.'COR')GO TO 900 C C 14NOV13 Stark width GS is sometimes too large for high series members CC IF(GS.NE.0.)GS=MIN(GS,-3.) c WRITE(6,140)WL,GFLOG,CODE,E,XJ,LABEL,EP,XJP,LABELP, c 1 GR,GS,GW,REF GF=10.**(GFLOG+DGFLOG+X1+X2) ELO=DMIN1(DABS(E),DABS(EP)) c 11sep05 changed exponention style and corrected for negative asymmetry c 22oct04 changed exponention style and corrected for negative asymmetry C GAMMAS=ASHORE for autoionizing lines C GAMMAW=BSHORE for autoionizing lines GAMMAR=10.**(GR+DGAMMAR) GAMMAS=10.**(GS+DGAMMAS) GAMMAW=10.**(GW+DGAMMAW) C IF ASYMMETRY PARAMETER ASHORE IS NEGATIVE, INPUT GAMMAS IS POSITIVE LOG IF(AUTO.EQ.'AUT'.AND.GS.GT.0.)GAMMAS=-10.**(-GS+DGAMMAS) IF(GR.EQ.0.)THEN GAMMAR=2.223D13/WLVAC**2 GR=ALOG10(GAMMAR) ENDIF NELEM=CODE ICHARGE=(CODE-FLOAT(NELEM))*100.+.1 ZEFF=ICHARGE+1 NELION=NELEM*6-6+IFIX(ZEFF) IF(NELEM.GT.19.AND.NELEM.LT.29.AND.ICHARGE.GT.5)NELION= 1 6*(NELEM+ICHARGE*10-30)-1 IF(GS.NE.0..AND.GW.NE.0.)GO TO 141 IF(GS.NE.0.)GO TO 138 IF(CODE.GE.100.)GO TO 137 EUP=DMAX1(DABS(E),DABS(EP)) EFFNSQ=25. c bug found by John Lester 18 May 2011 IZ=CODE IF(IZ.LE.30)INDEX=IZ*(IZ+1)/2+ICHARGE IF(IZ.GT.30)INDEX=IZ*5+341+ICHARGE DELEUP=POTION(INDEX)-EUP c if(iz.eq.31)type*,wl,index,potion(index),eup,deleup C DELEUP=POTION(NELION)-EUP IF(DELEUP.GT.0.)EFFNSQ=109737.31*ZEFF**2/DELEUP GAMMAS=1.0D-8*EFFNSQ**2*SQRT(EFFNSQ) GS=ALOG10(GAMMAS) C C 14NOV13 Stark width GS is sometimes too large for high series members GS=MIN(GS,-3.) C C GO TO 138 137 GAMMAS=1.0D-5 GS=-5. 138 IF(GW.NE.0.)GO TO 141 IF(CODE.GE.100.)GO TO 139 EUP=DMAX1(DABS(E),DABS(EP)) EFFNSQ=25. c bug found by John Lester 18 May 2011 IZ=CODE IF(IZ.LE.30)INDEX=IZ*(IZ+1)/2+ICHARGE IF(IZ.GT.30)INDEX=IZ*5+341+ICHARGE DELEUP=POTION(INDEX)-EUP C DELEUP=POTION(NELION)-EUP IF(DELEUP.GT.0.)EFFNSQ=109737.31D0*ZEFF**2/DELEUP EFFNSQ=AMIN1(EFFNSQ,1000.) RSQUP=2.5*(EFFNSQ/ZEFF)**2 DELELO=POTION(INDEX)-ELO C DELELO=POTION(NELION)-ELO EFFNSQ=109737.31D0*ZEFF**2/DELELO EFFNSQ=AMIN1(EFFNSQ,1000.) RSQLO=2.5*(EFFNSQ/ZEFF)**2 NSEQ=CODE-ZEFF+1. IF(NSEQ.GT.20.AND.NSEQ.LT.29)THEN RSQUP=(45.-FLOAT(NSEQ))/ZEFF RSQLO=0. ENDIF c IF(LABELP(1).EQ.'CONTINUU')RSQLO=0. IF(LABELP.EQ.'CONTINUUM ')RSQLO=0. IF(RSQUP.LT.RSQLO)RSQUP=2.*RSQLO GAMMAW=4.5D-9*(RSQUP-RSQLO)**.4 GW=ALOG10(GAMMAW) GO TO 141 139 GAMMAW=1.D-7/ZEFF GW=ALOG10(GAMMAW) 141 CONTINUE c WRITE(6,144)WL,GFLOG,CODE,E,XJ,LABEL,EP,XJP,LABELP,GR,GS,GW,REF c 1WRITE(6,144)WL,GFLOG,CODE,E,XJ,LABEL,EP,XJP,LABELP, c 1GAMMAR,GAMMAS,GAMMAW,REF,NBLO,NBUP,ISO1,X1,ISO2,X2,OTHER1,OTHER2 c type*,WL,GFLOG,CODE,E,XJ,EP,XJP 144 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,1x,A4,I2,I2,I3,F7.3,I3,F7.3,A10,A10) C TYPE=-6 3HE II LINE C TYPE=-5 4HE I LINE C TYPE=-4 3HE I LINE C TYPE=-3 4HE I LINE C TYPE=-2 DEUTERIUM LINE C TYPE=-1 HYDROGEN LINE C TYPE=0 NORMAL LINE C TYPE=1 AUTOIONIZING LINE C TYPE=2 CORONAL APPROXIMATION LINE C TYPE=3 PRD LINE C TYPE.GT.3 = NLAST CONTINUUM TYPE=0 IF(CODE.EQ.1.00)TYPE=-1 IF(CODE.EQ.1.00.AND.ISO1.EQ.2)TYPE=-2 IF(CODE.EQ.2.00)TYPE=-3 IF(CODE.EQ.2.00.AND.ISO1.EQ.3)TYPE=-4 IF(CODE.EQ.2.01)TYPE=-6 IF(CODE.EQ.2.01.AND.ISO1.EQ.3)TYPE=-6 IF(AUTO.EQ.'COR')TYPE=2 IF(AUTO.EQ.'AUT')TYPE=1 IF(AUTO.EQ.'PRD')TYPE=3 IF(LABELP .EQ.'CONTINUUM ')NLAST=XJP IF(LABELP .EQ.'CONTINUUM ')GF=GF*(XJ+XJ+1.) NCON=0 IF(ISO1.EQ.0.AND.ISO2.GT.0)NCON=ISO2 IF(TYPE.EQ.1)GO TO 17 IF(TYPE.GT.3)GO TO 17 FRELIN=2.99792458D17/WLVAC CGF=.026538D0/1.77245D0*GF/FRELIN C GR IS GAUNT FACTOR FOR CORONAL LINES IF(TYPE.EQ.2)GAMMAR=GR IF(TYPE.EQ.2)GO TO 1253 GAMMAR=GAMMAR/12.5664D0/FRELIN GAMMAS=GAMMAS/12.5664D0/FRELIN GAMMAW=GAMMAW/12.5664D0/FRELIN 17 NBUP=IABS(NBUP) NBLO=IABS(NBLO) NELIONX=0 IF(TYPE.EQ.1)GO TO 1253 IF(NBLO+NBUP.EQ.0)GO TO 1260 DO 1250 I=1,17 IF(CODE.EQ.CODEX(I))GO TO 1252 1250 CONTINUE IF(TYPE.EQ.1)GO TO 1253 WRITE(6,1251)CODE 1251 FORMAT(9H BAD CODE,F10.2) CALL EXIT 1252 NELIONX=I 1253 WRITE(19)WLVAC,ELO,GF,NBLO,NBUP,NELION,TYPE,NCON,NELIONX, 1GAMMAR,GAMMAS,GAMMAW,alpha,NBUFF,LIM cc IF(LINOUT.GE.0)WRITE(20)LINDAT8,LINDAT4 IF(LINOUT.GE.0)WRITE(20)LINDAT8I,LABEL,LABELP,OTHER1,OTHER2, 1 LINDAT8II,LINDAT4I,REF,LINDAT4II c IF(LINOUT.GE.0)WRITE(68,*)LINDAT8I,LABEL,LABELP,OTHER1,OTHER2, c 1 LINDAT8II,LINDAT4I,REF,LINDAT4II N19=N19+1 c WRITE(68,5555)WLVAC,ILINE,alpha WRITE(6,5555)WLVAC,ILINE,alpha 5555 FORMAT(4X,'WLVAC=',F10.4,'ILINE='I10,'alpha=',f10.3) GO TO 900 C PLAIN LINE 1260 WRITE(12)NBUFF,CGF,NELION,ELO,GAMMAR,GAMMAS,GAMMAW,alpha c type*,n14,nbuff,wlvac,alpha cc IF(LINOUT.GE.0)WRITE(14)LINDAT8,LINDAT4 IF(LINOUT.GE.0)WRITE(14)LINDAT8I,LABEL,LABELP,OTHER1,OTHER2, 1 LINDAT8II,LINDAT4I,REF,LINDAT4II N14=N14+1 NLINES=NLINES+1 900 CONTINUE 145 WRITE(6,1118)N14 1118 FORMAT(I10,' LINES ADDED TO TAPE 12') WRITE(6,1120)NLINES 1120 FORMAT(I10,' LINES TOTAL ON TAPE 12') WRITE(6,1119)N19 1119 FORMAT(I10,' LINES TOTAL ON TAPE 19') C IF(LINOUT.LT.0.)GO TO 1125 C IF(N19.GT.0)THEN C REWIND 20 C DO 1121 I=1,N19 C READ(20)LINDAT8,LINDAT C 1121 WRITE(13)LINDAT8,LINDAT C ENDIF C IF(NLINES.GT.0)THEN C REWIND 14 C DO 1122 I=1,NLINES C READ(14)LINDAT8,LINDAT C 1122 WRITE(13)LINDAT8,LINDAT C ENDIF C 1125 CONTINUE C IF(IFNLTE.EQ.1)N19=0 REWIND 93 WRITE(93)NLINES,LENGTH,IFVAC,IFNLTE,N19,TURBV,DECKJ,IFPRED, 1WLBEG,WLEND,RESOLU,RATIO,RATIOLG,CUTOFF,LINOUT write(6,1656)linout C CALL ENDTIME CALL EXIT END SUBROUTINE IONPOTS C C Kramida, A., Ralchenko, Yu., Reader, J., and NIST ASD Team (2014). C NIST Atomic Spectra Database (ver. 5.2). physics.nist.gov/asd C 2014, November 4. C IMPLICIT REAL*8 (A-H,O-Z) COMMON /POTION/POTION(999) DIMENSION POTH ( 2),POTHe( 3),POTLi( 4),POTBe( 5),POTB ( 6) DIMENSION POTC ( 7),POTN ( 8),POTO ( 9),POTF( 10),POTNe(11) DIMENSION POTNa(12),POTMg(13),POTAl(14),POTSi(15),POTP (16) DIMENSION POTS (17),POTCl(18),POTAr(19),POTK (20),POTCa(21) DIMENSION POTSc(22),POTTi(23),POTV (24),POTCr(25),POTMn(26) DIMENSION POTFe(27),POTCo(28),POTNi(29),POTCu(30),POTZn(31) DIMENSION POTGa(5),POTGe(5),POTAs(5),POTSe(5),POTBr(5) DIMENSION POTKr(5),POTRb(5),POTSr(5),POTY (5),POTZr(5) DIMENSION POTNb(5),POTMo(5),POTTc(5),POTRu(5),POTRh(5) DIMENSION POTPd(5),POTAg(5),POTCd(5),POTIn(5),POTSn(5) DIMENSION POTSb(5),POTTe(5),POTI (5),POTXe(5),POTCs(5) DIMENSION POTBa(5),POTLa(5),POTCe(5),POTPr(5),POTNd(5) DIMENSION POTPm(5),POTSm(5),POTEu(5),POTGd(5),POTTb(5) DIMENSION POTDy(5),POTHo(5),POTEr(5),POTTm(5),POTYb(5) DIMENSION POTLu(5),POTHf(5),POTTa(5),POTW (5),POTRe(5) DIMENSION POTOs(5),POTIr(5),POTPt(5),POTAu(5),POTHg(5) DIMENSION POTTl(5),POTPb(5),POTBi(5),POTPo(5),POTAt(5) DIMENSION POTRn(5),POTFr(5),POTRa(5),POTAc(5),POTTh(5) DIMENSION POTPa(5),POTU (5),POTNp(5),POTPu(5),POTAm(5) DIMENSION POTCm(5),POTBk(5),POTCf(5),POTEs(5) EQUIVALENCE (POTION( 1),POTH (1)) EQUIVALENCE (POTION( 3),POTHe(1)) EQUIVALENCE (POTION( 6),POTLi(1)) EQUIVALENCE (POTION( 10),POTBe(1)) EQUIVALENCE (POTION( 15),POTB (1)) EQUIVALENCE (POTION( 21),POTC (1)) EQUIVALENCE (POTION( 28),POTN (1)) EQUIVALENCE (POTION( 36),POTO (1)) EQUIVALENCE (POTION( 45),POTF (1)) EQUIVALENCE (POTION( 55),POTNe(1)) EQUIVALENCE (POTION( 66),POTNa(1)) EQUIVALENCE (POTION( 78),POTMg(1)) EQUIVALENCE (POTION( 91),POTAl(1)) EQUIVALENCE (POTION(105),POTSi(1)) EQUIVALENCE (POTION(120),POTP (1)) EQUIVALENCE (POTION(136),POTS (1)) EQUIVALENCE (POTION(153),POTCl(1)) EQUIVALENCE (POTION(171),POTAr(1)) EQUIVALENCE (POTION(190),POTK (1)) EQUIVALENCE (POTION(210),POTCa(1)) EQUIVALENCE (POTION(231),POTSc(1)) EQUIVALENCE (POTION(253),POTTi(1)) EQUIVALENCE (POTION(276),POTV (1)) EQUIVALENCE (POTION(300),POTCr(1)) EQUIVALENCE (POTION(325),POTMn(1)) EQUIVALENCE (POTION(351),POTFe(1)) EQUIVALENCE (POTION(378),POTCo(1)) EQUIVALENCE (POTION(406),POTNi(1)) EQUIVALENCE (POTION(435),POTCu(1)) EQUIVALENCE (POTION(465),POTZn(1)) EQUIVALENCE (POTION(496),POTGa(1)) EQUIVALENCE (POTION(501),POTGe(1)) EQUIVALENCE (POTION(506),POTAs(1)) EQUIVALENCE (POTION(511),POTSe(1)) EQUIVALENCE (POTION(516),POTBr(1)) EQUIVALENCE (POTION(521),POTKr(1)) EQUIVALENCE (POTION(526),POTRb(1)) EQUIVALENCE (POTION(531),POTSr(1)) EQUIVALENCE (POTION(536),POTY (1)) EQUIVALENCE (POTION(541),POTZr(1)) EQUIVALENCE (POTION(546),POTNb(1)) EQUIVALENCE (POTION(551),POTMo(1)) EQUIVALENCE (POTION(556),POTTc(1)) EQUIVALENCE (POTION(561),POTRu(1)) EQUIVALENCE (POTION(566),POTRh(1)) EQUIVALENCE (POTION(571),POTPd(1)) EQUIVALENCE (POTION(576),POTAg(1)) EQUIVALENCE (POTION(581),POTCd(1)) EQUIVALENCE (POTION(586),POTIn(1)) EQUIVALENCE (POTION(591),POTSn(1)) EQUIVALENCE (POTION(596),POTSb(1)) EQUIVALENCE (POTION(601),POTTe(1)) EQUIVALENCE (POTION(606),POTI (1)) EQUIVALENCE (POTION(611),POTXe(1)) EQUIVALENCE (POTION(616),POTCs(1)) EQUIVALENCE (POTION(621),POTBa(1)) EQUIVALENCE (POTION(626),POTLa(1)) EQUIVALENCE (POTION(631),POTCe(1)) EQUIVALENCE (POTION(636),POTPr(1)) EQUIVALENCE (POTION(641),POTNd(1)) EQUIVALENCE (POTION(646),POTPm(1)) EQUIVALENCE (POTION(651),POTSm(1)) EQUIVALENCE (POTION(656),POTEu(1)) EQUIVALENCE (POTION(661),POTGd(1)) EQUIVALENCE (POTION(666),POTTb(1)) EQUIVALENCE (POTION(671),POTDy(1)) EQUIVALENCE (POTION(676),POTHo(1)) EQUIVALENCE (POTION(681),POTEr(1)) EQUIVALENCE (POTION(686),POTTm(1)) EQUIVALENCE (POTION(691),POTYb(1)) EQUIVALENCE (POTION(696),POTLu(1)) EQUIVALENCE (POTION(701),POTHf(1)) EQUIVALENCE (POTION(706),POTTa(1)) EQUIVALENCE (POTION(711),POTW (1)) EQUIVALENCE (POTION(716),POTRe(1)) EQUIVALENCE (POTION(721),POTOs(1)) EQUIVALENCE (POTION(726),POTIr(1)) EQUIVALENCE (POTION(731),POTPt(1)) EQUIVALENCE (POTION(736),POTAu(1)) EQUIVALENCE (POTION(741),POTHg(1)) EQUIVALENCE (POTION(746),POTTl(1)) EQUIVALENCE (POTION(751),POTPb(1)) EQUIVALENCE (POTION(756),POTBi(1)) EQUIVALENCE (POTION(761),POTPo(1)) EQUIVALENCE (POTION(766),POTAt(1)) EQUIVALENCE (POTION(771),POTRn(1)) EQUIVALENCE (POTION(776),POTFr(1)) EQUIVALENCE (POTION(781),POTRa(1)) EQUIVALENCE (POTION(786),POTAc(1)) EQUIVALENCE (POTION(791),POTTh(1)) EQUIVALENCE (POTION(796),POTPa(1)) EQUIVALENCE (POTION(801),POTU (1)) EQUIVALENCE (POTION(806),POTNp(1)) EQUIVALENCE (POTION(811),POTPu(1)) EQUIVALENCE (POTION(816),POTAm(1)) EQUIVALENCE (POTION(821),POTCm(1)) EQUIVALENCE (POTION(826),POTBk(1)) EQUIVALENCE (POTION(831),POTCf(1)) EQUIVALENCE (POTION(836),POTEs(1)) C.....2017 JUN22 CHECK AGAINST NIST LISTING MADE BY JOHN LESTER DATA POTH / 109678.772D0,0./ DATA POTHe/ 198310.666D0, 438908.879D0,0./ DATA POTLi/ 43487.114D0, 610078.526D0, 987661.014D0,0./ DATA POTBe/ 75192.640D0, 146882.86D0,1241256.600D0, 1 1756018.822D0, 0./ DATA POTB /66928.040D0,202887.40D0,305930.80D0,2091972.D0, 1 2744107.936D0, 0./ C....C I CHANGED FROM 90820.42 TO 90820.45 C....C IV CHANGED FROM 520175.8 TO 520175.3 DATA POTC /90820.45D0,196674.D0,386241.0D0,520175.8D0, 1 3162423.30D0,3952061.670D0, 0./ C....N V CHANGED FROM 789537.0 TO 789537.2 DATA POTN / 117225.70D0,238750.20D0,382672.D0,624866.D0, 1 789537.2D0,4452723.30D0,5380089.80D0, 0./ DATA POTO / 109837.02D0,283270.90D0,443085.0D0,624382.0D0, 1 918657.D0,1114004.D0,5963073.00D0,7028394.70D0, 0./ DATA POTF / 140524.50D0,282058.6D0,505774.0D0,703110.D0,921480.D0, 1 1267606.0D0,1493632.D0,7693706.60D0,8897242.50D0, 0./ DATA POTNe/173929.750D0,330388.60D0,511544.D0,783890.D0, 1 1018250.D0,1273820.D0,1671750.D0,1928447.D0,9644840.7D0, 2 10986877.20D0,0./ DATA POTNa/ 41449.451D0,381390.2D0,577654.D0,797970.D0,1116300.D0, 1 1389100.D0,1681700.D0, 2130850.D0, 2418500.D0, 2 11817106.70D0,13297680.0D0,0./ C....MG II CHANGED FROM 121267.61 TO 121267.64 DATA POTMg/61671.050D0,121267.64D0,646402.D0,881285.D0,1139900.D0, 1 1506300.D0, 1814900.D0, 2144820.D0, 2645400.D0, 2 2964000.D0,14209914.7D0, 15829950.D0, 0./ C....Al V CHANGED FROM 1240684.0 TO 1240680.0 DATA POTAl/48278.48D0,151862.50D0,229445.70D0,967804.D0, 1 1240680.0D0,1536400.D0, 1949900.D0, 2295800.D0, 2 2663300.D0, 3215300.D0,3565010.D0, 16824539.3D0, 3 18584143.0D0, 0./ C....SI II CHANGED FROM 131838.14 TO 131838.10 DATA POTSi/65747.76D0,131838.10D0,270139.30D0,364093.10D0, 1 1345070.D0,1655590.D0, 1986700.D0, 2449200.D0, 2 2831800.D0, 3237400.D0,3840600.D0, 4221630.D0, 3 19661038.9D0, 21560631.0D0, 0./ DATA POTP / 84580.83D0,159451.70D0,243600.70D0,414922.8D0, 1 524462.9D0,1777890.D0, 2125800.D0, 2497100.D0, 2 3002900.D0, 3423000.D0,3867000.D0, 4521700.D0, 3 4934020.D0, 22719901.6D0,24759942.D0,0./ DATA POTS / 83559.1D0,188232.7D0,281100.D0,380870.D0,585514.D0, 1 710195.D0, 2266050.D0, 2651900.D0, 3063600.D0, 3611300.D0, 2 4069500.D0, 4552200.D0, 5258400.D0, 5702290.D0,26001545.1D0, 3 28182526.D0, 0./ C....Cl IX CHANGED FROM 3233080.0 TO 3233100.0 DATA POTCl/ 104591.00D0,192070.0D0,321000.D0,429400.D0,545800.D0, 1 781900.D0, 921096.D0, 2809280.D0, 3233100.0D0, 3683000.D0, 2 4274000.D0, 4771400.D0, 5293400.D0, 6051000.D0, 6526620.D0, 3 29506532.5D0, 31828983.D0, 0./ C....Ar VIII CHANGED FROM 1157056.0 TO 1157060.0 DATA POTAr/ 127109.842D0,222848.3D0,328550.D0,480600.D0,603700.D0, 1 736300.D0, 1003400.D0, 1157060.D0, 3408500.D0, 3869500.D0, 2 4359000.D0, 4992000.D0, 5528700.D0, 6090500.D0, 6899800.D0, 3 7407190.D0, 33235410.D0, 35699895.D0, 0./ C....K XIV CHANGED FROM 6342000.0 TO 6341600.0 DATA POTK / 35009.814D0,255072.8D0,369427.D0,491330.D0,666700.D0, 1 802000.D0, 948200.D0, 1249100.D0, 1418063.D0, 4062400.D0, 2 4562000.D0, 5090000.D0, 5764000.D0, 6341600.D0, 6943800.D0, 3 7805000.D0, 8344140.D0, 37189176.0D0,39795784.D0, 0./ DATA POTCa/ 49305.924D0,95751.870D0,410642.3D0,542595.D0, 1 680200.D0,877400.D0, 1026000.D0, 1187600.D0, 1520600.D0, 2 1704050.D0,4771600.D0, 5309000.D0, 5877000.D0, 6591000.D0, 3 7210000.D0,7853000.D0, 8766000.D0, 9337690.D0,41367028.D0, 4 44117409.D0,0./ DATA POTSc/52922.00D0,103237.1D0,199677.37D0,592732.D0,741600.D0, 1 892700.D0, 1113000.D0, 1275000.D0, 1452000.D0, 1816200.D0, 2 2014760.D0, 5543900.D0, 6111000.D0, 6720000.D0, 7473000.D0, 3 8135000.D0, 8820000.D0, 9784000.D0,10388070.D0,45771185.D0, 4 48665510.D0, 0./ DATA POTTi/ 55072.50D0,109494.D0,221735.6D0,348973.3D0,800900.D0, 1 964100.D0, 1134700.D0, 1375000.D0, 1549000.D0,1741500.D0, 2 2137900.D0, 2351110.D0, 6353000.D0, 6969000.D0,7618000.D0, 3 8408000.D0, 9116000.D0, 9842000.D0,10859000.D0,11495470.D0, 4 50401766.D0, 53440740.D0, 0./ DATA POTV / 54411.67D0,117900.D0, 236410.D0, 376730.D0,526532.0D0, 1 1033400.D0, 1215700.D0, 1399800.D0, 1661000.D0, 1859000.D0, 2 2055000.D0, 2488200.D0, 2712230.D0, 7227000.D0, 7882000.D0, 3 8573000.D0, 9398000.D0, 10153000.D0,10922000.D0,11991000.D0, 4 12660130.D0, 55259549.D0, 58443920.D0, 0./ DATA POTCr/ 54575.6D0,132971.02D0,249700.D0, 396500.D0,560200.D0, 1 731020.D0,1292800.D0, 1490200.D0, 1690100.D0, 1972000.D0, 2 2184000.D0,2393000.D0, 2860500.D0, 3098480.D0, 8159000.D0, 3 8850000.D0,9582000.D0,10443000.D0,11247000.D0,12059000.D0, 4 13180000.D0,13882280.D0, 60345293.D0,63675850.D0, 0./ C....MN I CHANGED FROM 59959.4 TO 59959.56 DATA POTMn/ 59959.56D0,126145.00D0,271550.D0,413000.D0, 584000.D0, 1 771100.D0, 961440.D0, 1577000.D0, 1789600.D0, 2005400.D0, 2 2308000.D0, 2536000.D0, 2771000.D0, 3250000.D0, 3509900.D0, 3 9144000.D0, 9873000.D0, 10649000.D0,11541000.D0,12398000.D0, 4 13253000.D0,14427000.D0, 15162200.D0,65659877.D0,69137430.D0, 5 0./ C....FE V CHANGED FROM 604900.0 TO 605000.0 DATA POTFe/ 63737.704D0,130655.40D0,247220.D0,442900.D0,605000.D0, 1 798370.D0, 1008000.D0, 1218380.D0, 1884000.D0, 2114000.D0, 2 2346000.D0, 2668000.D0, 2912000.D0, 3163000.D0, 3680000.D0, 3 3946570.D0,10184000.D0,10951000.D0,11770000.D0,12708000.D0, 4 13607000.D0,14505000.D0,15731000.D0,16500160.D0,71204137.D0, 5 74829550.D0, 0./ C....CO VI CHANGED FROM 822700.0 TO 823000.0 DATA POTCo/ 63564.6D0,137795.D0, 270200.D0, 413500.D0, 641200.D0, 1 823000.0D0, 1040000.D0, 1273000.D0, 1501300.D0, 2221000.D0, 2 2462600.D0, 2711000.D0, 3053000.D0, 3307000.D0, 3558000.D0, 3 4129200.D0, 4408530.D0,11269000.D0,12135000.D0,12950000.D0, 4 13900000.D0,14873000.D0,15815000.D0,17094000.D0,17896440.D0, 5 76979030.D0,80753210.D0, 0./ C....Ni XXIV CHANGED FROM 1718300.0 TO 17183000.0 DATA POTNi/ 61619.77D0,146541.56D0,283800.D0,443000.D0,613500.D0, 1 871000.D0,1065000.D0,1307000.D0,1558000.D0,1812000.D0, 2 2577000.D0,2836100.D0,3102000.D0,3463000.D0,3732000.D0, 3 3995000.D0,4606000.D0,4895950.D0,12429000.D0,13274000.D0, 4 14180000.D0, 15170000.D0, 16196000.D0,17183000.D0,18515000.D0, 5 19351330.D0, 82985464.D0, 86909350.D0, 0./ C....CU XXI CHANGED FROM 14518000.0 TO 14520000.0 DATA POTCu/ 62317.460D0,163669.20D0,297140.D0,462800.D0,644000.D0, 1 831000.D0,1121000.D0,1339000.D0,1597000.D0,1873000.D0, 2 2140000.D0,2960000.D0,3234000.D0,3517000.D0,3897000.D0, 3 4184000.D0,4458000.D0,5101000.D0,5408820.D0,13635000.D0, 4 14520000.D0,15470000.D0,16480000.D0,17578000.D0,18610000.D0, 5 19995000.D0,20865190.D0,89224526.D0,93299090.D0, 0./ C....ZN I CHANGED FROM 75769.328 TO 75769.310 DATA POTZn/75769.310D0,144892.6D0,320390.0D0,480490.D0,666000.D0, 1 871000.D0,1080000.D0,1403000.D0,1637000.D0,1920000.D0, 2 2213000.D0,2507000.D0,3368000.D0,3657000.D0,3957000.D0, 3 4355000.D0,4660000.D0,4946000.D0,5626000.D0,5947260.D0, 4 14896000.D0,15820000.D0,16820000.D0,17860000.D0,19019000.D0, 5 20095000.D0,21534000.D0,22438310.D0,95697194.D0,99923450.D0, 6 0./ DATA POTGa/ 48387.634D0,165465.8D0,247820.0D0,510070.D0,693700.D0/ DATA POTGe/ 63713.24D0, 128521.30D0,274693.D0,368720.D0,729930.D0/ DATA POTAs/ 78950.0D0, 149932.D0, 228650.D0, 404500.D0, 506200.D0/ DATA POTSe/ 78658.35D0,170960.D0, 255650.D0, 346390.D0, 550900.D0/ C....BR III CHANGED FROM 282000.0 TO 281000.0 C....BR IV CHANGED FROM 385400.0 TO 385390.0 DATA POTBr/ 95284.80D0,174140.D0, 281000.D0, 385390.D0, 480670.D0/ C....KR III CHANGED FROM 287700.0 TO 289000.0 DATA POTKr/112914.433D0,196475.4D0,289000.D0, 410100.D0,521800.D0/ DATA POTRb/ 33690.81D0,220105.00D0,316550.D0, 421000.D0,552000.D0/ DATA POTSr/45932.204D0,88965.180D0,345879.0D0,453930.D0,570000.D0/ DATA POTY / 50145.60D0, 98590.D0,165540.5D0, 488830.D0,604700.D0/ DATA POTZr/ 53506.00D0,105900.D0, 186880.D0,277602.80D0,648050.D0/ DATA POTNb/ 54513.80D0,115500.D0, 202000.D0, 303350.D0, 407897.D0/ C....MO V CHANGED FROM 439450.0 TO 438900.0 DATA POTMo/ 57204.30D0,130300.D0, 218800.D0, 325300.D0, 438900.D0/ C....TC I CHANGED FROM 57421.68 TO 57421.7 DATA POTTc/ 57421.7D0,123100.D0, 238300.D0, 331000.D0, 460000.D0/ DATA POTRu/ 59366.40D0,135200.D0, 229600.D0, 363000.D0, 476000.D0/ DATA POTRh/ 60160.10D0,145800.D0, 250500.D0, 339000.D0, 508000.D0/ DATA POTPd/ 67241.30D0,156700.D0, 265600.D0, 371000.D0, 492000.D0/ DATA POTAg/ 61106.45D0,173283.D0, 280900.D0, 395000.D0, 524000.D0/ DATA POTCd/ 72540.07D0,136374.74D0,302200.D0,411000.D0, 548000.D0/ DATA POTIn/46670.104D0,152200.10D0,226191.3D0,447200.D0,559000.D0/ C....SN II CHANGED FROM 118017.0 TO 118023.7 C....SN IV CHANGED FROM 328600.0 TO 328550.0 DATA POTSn/ 59232.69D0,118023.7D0,246020.0D0,328550.D0, 621300.D0/ DATA POTSb/ 69431.34D0, 134100.D0,204248.D0, 353300.D0, 443600.D0/ DATA POTTe/ 72667.80D0, 150000.D0,224500.D0, 301776.D0, 478000.D0/ DATA POTI / 84295.10D0,154304.0D0,238500.D0, 325500.D0, 415500.D0/ DATA POTXe/ 97833.787D0,169180.D0,250400.D0, 340400.D0, 437000.D0/ DATA POTCs/ 31406.468D0,186777.40D0,267740.D0,347000.D0,452000.D0/ DATA POTBa/ 42034.91D0,80686.30D0,289100.D0, 379000.D0, 468000.D0/ DATA POTLa/ 44981.D0, 90212.50D0, 154675.D0,402900.D0, 497000.D0/ DATA POTCe/ 44672.D0, 87500.D0, 162903.D0, 297670.D0, 528700.D0/ C....PR I CHANGED FROM 44140.0 TO 44120.0 DATA POTPr/ 44120.D0, 85100.D0, 174407.D0, 314400.D0, 464000.D0/ C....ND III CHANGED FROM 178600.0 TO 177800.0 DATA POTNd/ 44562.D0, 86500.D0, 177800.D0, 326000.D0, 483900.D0/ C....PM I CHANGED FROM 45020.0 TO 44980.0 C....PM III CHANGED FROM 180000.0 TO 178000.0 DATA POTPm/ 44980.D0, 87900.D0, 178000.D0, 331000.D0, 498000.D0/ C....SM III CHANGED FROM 189000.0 TO 190000.0 DATA POTSm/ 45519.6D0, 89300.D0, 190000.D0, 334000.D0, 505000.D0/ DATA POTEu/ 45734.740D0,90660.D0, 201000.D0, 344000.D0, 510000.D0/ DATA POTGd/ 49601.45D0, 97500.D0, 166400.D0, 355000.D0, 522000.D0/ DATA POTTb/ 47295.D0, 92900.D0, 176700.D0, 317500.D0, 536000.D0/ DATA POTDy/ 47901.70D0, 94100.D0, 185000.D0, 334000.D0, 501000.D0/ DATA POTHo/ 48567.D0, 95200.D0, 184200.D0, 343000.D0, 516000.D0/ DATA POTEr/ 49262.D0, 96200.D0, 183400.D0, 344000.D0, 525000.D0/ DATA POTTm/ 49879.80D0, 97200.D0, 191000.D0, 344000.D0, 528000.D0/ DATA POTYb/ 50443.20D0,98231.75D0,202070.D0, 351300.D0, 529000.D0/ C....LU III CHANGED FROM 169010.0 TO 169050.0 DATA POTLu/ 43762.60D0,112000.D0, 169050.D0, 364960.D0, 539000.D0/ DATA POTHf/ 55047.90D0,120000.D0, 188000.D0, 269150.D0, 551500.D0/ DATA POTTa/ 60891.40D0,131000.D0, 186000.D0, 282000.D0, 389340.D0/ DATA POTW / 63427.70D0,132000.D0, 210000.D0, 308000.D0, 416000.D0/ DATA POTRe/ 63181.60D0,134000.D0, 218000.D0, 315000.D0, 419000.D0/ DATA POTOs/ 68058.9D0, 137000.D0, 202000.D0, 331000.D0, 444000.D0/ DATA POTIr/ 72323.9D0, 137100.D0, 226000.D0, 323000.D0, 460000.D0/ DATA POTPt/ 72257.80D0,149700.D0, 234000.D0, 347000.D0, 452000.D0/ DATA POTAu/ 74409.11D0,162950.D0, 242000.D0, 363000.D0, 484000.D0/ C....HG V CHANGED FROM 493600.0 TO 494000.0 DATA POTHg/ 84184.150D0,151284.40D0,277900.D0,391600.D0,494000.D0/ DATA POTTl/ 49266.660D0,164765.D0, 240773.D0, 412500.D0,505000.D0/ DATA POTPb/59819.558D0,121245.28D0,257592.D0,341435.1D0,555000.D0/ C....BI V CHANGED FROM 442400.0 TO 442440.0 DATA POTBi/ 58761.650D0,134720.D0, 206180.D0, 365900.D0,442440.D0/ DATA POTPo/ 67860.D0, 156000.D0, 220000.D0, 290000.D0, 460000.D0/ DATA POTAt/ 75150.80D0,144210.D0, 214400.D0, 319800.D0, 406400.D0/ DATA POTRn/ 86692.5D0, 173000.D0, 237000.D0, 298000.D0, 427000.D0/ DATA POTFr/ 32848.872D0,181000.D0,270000.D0, 315000.D0, 403000.D0/ DATA POTRa/ 42573.36D0,81842.31D0,250000.D0, 331000.D0, 427000.D0/ DATA POTAc/ 43394.45D0, 94800.D0, 140590.D0, 361000.D0, 444000.D0/ C....TH II CHANGED FROM 96000.0 TO 97600.0 DATA POTTh/ 50867.0D0, 97600.D0, 147800.D0, 231060.D0, 468000.D0/ DATA POTPa/ 47500.D0, 96000.D0, 150000.D0, 249000.D0, 357000.D0/ DATA POTU / 49958.40D0, 94000.D0, 159700.D0, 296000.D0, 371000.D0/ DATA POTNp/ 50535.0D0, 93000.D0, 159000.D0, 273000.D0, 387000.D0/ DATA POTPu/ 48601.0D0, 93000.D0, 170000.D0, 282000.D0, 395000.D0/ DATA POTAm/ 48182.0D0, 94000.D0, 175000.D0, 297000.D0, 403000.D0/ DATA POTCm/ 48324.0D0, 100000.D0, 162000.D0, 304000.D0, 411000.D0/ DATA POTBk/ 49989.0D0, 96000.D0, 174000.D0, 290000.D0, 452000.D0/ DATA POTCf/ 50665.0D0, 97000.D0, 181000.D0, 304000.D0, 419000.D0/ DATA POTEs/ 51358.0D0, 98000.D0, 183000.D0, 313000.D0, 436000.D0/ RETURN END