PROGRAM ATLAS7V C revised 12aug93 IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ABROSS/ABROSS(kw),TAUROS(kw) COMMON /ABTOT/ABTOT(kw),ALPHA(kw) COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BB/BB1(kw,7),XNFPB(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2) COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /BK/BK1(kw,8),XNFPK(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1) COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /CONT/ABTOTC(kw),ALPHAC(kw),TAUNUC(kw),SNUC(kw),HNUC(kw), 1 JNUC(kw),JMINSC(kw),RESIDC(kw) REAL*8 JNUC,JMINSC COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw), 1 GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH, 2 IFCONV REAL*8 MIXLTH COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /FRESET/FRESET(500),RCOSET(500),NULO,NUHI,NUMNU,IFWAVE, 1 WBEGIN,DELTAW COMMON /HEIGHT/HEIGHT(kw) COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /ITER/ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /JUNK/TITLE(74),FREQID(6),WLTE,XSCALE COMMON /MUS/ANGLE(20),SURFI(20),NMU COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /OPTOT/ACONT(kw),SCONT(kw),ALINE(kw),SLINE(kw),SIGMAC(kw), 1 SIGMAL(kw) COMMON /PUT/PUT,IPUT COMMON /PZERO/PZERO,PCON,PRADK0,PTURB0,KNU(kw),PRADK(kw),EDENS(kw) REAL*8 KNU COMMON /RAD/ACCRAD(kw),PRAD(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TAUSHJ/TAUNU(kw),SNU(kw),HNU(kw),JNU(kw),JMINS(kw) REAL*8 JNU,JMINS COMMON /TEFF/TEFF,GRAV,GLOG COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB C K=1.38054E-16 C H=6.6256E-27 C C=2.997925E10 C E=1.60210E-19 C ATMASS=1.660E-24 C C C INPUT SECTION C PREFIX P PRESSURE C PREFIX T TEMPERATURE C PREFIX X ABUNDANCE FRACTION C PREFIX F IONIZATION FRACTION C PREFIX R FREQUENCY INTEGRAL OR INTEGRATION COEFFICIENT C PREFIX A OR AB MASS ABSORPTION COEFFICIENT C PREFIX XNFP NUMBER DENSITY OVER PARTITION FUNCTION C ALPHA IS THE FRACTION OF OPACITY CAUSED BY SCATTERING C NLTEON=0 LTE C NLTEON=1 NLTE C BHYD STATISTICAL EQUILIBRIUM FACTOR FOR HYDROGEN C BMIN STATISTICAL EQUILIBRIUM FACTOR FOR HMINUS C ABUND CONTAINS THE NORMALLY ASSUMED ABUNDANCES C ELEM CONTAINS THE LETTER CODES FOR ELEMENTS C RCOSET HAS INTEGRATION COEFFICIENTS FOR THE FREQUENCIES IN FRESET C NUMNU NUMBER OF FREQUENCIES IN THE FREQUENCY SET C NULO NUMBER OF THE FREQUENCY AT WHICH INTEGRATION STARTS C NUHI NUMBER OF THE FREQUENCY AT WHICH INTEGRATION STOPS C IFCORR TEMPERATURE CORRECTION ON OR OFF C IFPRES PRESSURE INTEGRATION ON OR OFF C IFSURF=0 CALCULATE FLUX FOR EVERY DEPTH C IFSURF=1 CALCULATE FLUX AT SURFACE ONLY C IFSURF=2 CALCULATE INTENSITY AT SURFACE C IFSCAT=0 NO SCATTERING IN SOURCE FUNCTION SNU=BNU C IFSCAT=1 SCATTERING IN SOURCE FUNCTION SOLVE MATRIX EQUATION C IFMOL=1 SET UP EQUILIBRIUM EQUATIONS FOR NUMBER DENSITIES C IFMOL=0 ASSUME NO MOLECULES AND ITERATE FOR NUMBER DENSITIES C NUMITS NUMBER OF ITERATIONS C FREQID IS A LABEL FOR THE FREQUENCY SET C XSCALE IS A SCALING FACTOR FOR METAL ABUNDANCES C IFPRNT(I)=0 DO NOT PRINT ANYTHING FOR ITERATION I C IFPRNT(I)=1 PRINT MINIMAL SUMMARY TABLE AT END OF ITERATION C IFPRNT(I)=2 PRINT ALL FREQUENCY INDEPENDENT DATA C IFPRNT(I)=3 PRINT SNU,TAUNU,JNU,ETC. C IFPRNT(I)=4 PRINT OPACITIES C IFPNCH(I)=0 DO NOT PUNCH FOR ITERATION I C IFPNCH(I)=1 PUNCH STRUCTURE C IFPNCH(I)=2 PUNCH STRUCTURE AND SURFACE FLUX OR INTENSITY C IFPNCH(I)=5 PUNCH 2 AND MOLECULAR NUMBER DENSITIES/PART FNS C FOR IFSURF=2 HAVE NMU ANGLES C IFWAVE=1 STEP NUMNU WAVELENGTHS STARTING AT WBEGIN BY WSTEP C XABUND ARE THE ABUNDANCES USED IN THE MODEL EXP10(X)=EXP(X*2.30258509299405E0) ITEMP=0 1 CALL READIN(1) C C ITERATION SECTION DO 100 ITERAT=1,NUMITS ITER=ITERAT C CHANGING ITEMP TELLS THE SUBROUTINES THEY HAVE A NEW TEMPERATURE ITEMP=ITEMP+ITER C IF(IFPRES.EQ.0)GO TO 12 C INTEGRATE EQUATION OF HYDROSTATIC EQUILIBRIUM PZERO=PCON+PRADK0+PTURB0 DO 11 J=1,NRHOX C PTOTAL(J)=GRAV*RHOX(J) PTOTAL(J)=GRAV*RHOX(J)+PZERO P(J)=GRAV*RHOX(J)-PRAD(J)-PTURB(J)-PCON IF(P(J).GT.0.)GO TO 11 CALL W(6HJ ,DBLE(J),1) CALL W(6HP ,P,J) CALL W(6HPZERO ,PZERO,1) CALL W(6HACCRAD,ACCRAD,NRHOX) CALL W(6HPRAD ,PRAD,NRHOX) CALL EXIT 11 CONTINUE C 11 P(J)=PTOTAL(J)-PRAD(J)-PTURB(J) CALL POPS(0.,1,XNE) 12 CONTINUE CALL POPS(1.00D0,12,XNFH) CALL POPS(2.01D0,12,XNFHE) CALL POPS(1.01D0,11,XNFPH) CALL POPS(2.02D0,11,XNFPHE) CALL POPS(5.00D0,11,XNFPB) CALL POPS(6.01D0,11,XNFPC) CALL POPS(8.00D0,11,XNFPO) CALL POPS(11.00D0,11,XNFPNA) CALL POPS(12.01D0,11,XNFPMG) CALL POPS(13.01D0,11,XNFPAL) CALL POPS(14.01D0,11,XNFPSI) CALL POPS(20.01D0,11,XNFPCA) C CALL W(6HXNFPH ,XNFPH ,80) C CALL W(6HXNFPHE,XNFPHE,120) C CALL W(6HXNFPC ,XNFPC ,80) C CALL W(6HXNFPMG,XNFPMG,80) C CALL W(6HXNFPAL,XNFPAL,80) C CALL W(6HXNFPSI,XNFPSI,80) CALL PUTOUT(1) C C ERASE FREQUENCY INTEGRALS IF(IFCORR.EQ.1)CALL TCORR(1,0) CALL ROSS(1,0) CALL RADIAP(1,0) IF(NLTEON.EQ.1)CALL STATEQ(1,0) C C FREQUENCY INTEGRATION SECTION DO 25 NU=NULO,NUHI IF(IFWAVE.EQ.0)GO TO 21 IF(WBEGIN.GT.1.E10)GO TO 210 WAVE=WBEGIN+DBLE(NU-NULO)*DELTAW FREQ=2.997925E17/WAVE RCO=ABS(DELTAW/WAVE*FREQ) GO TO 22 C EQUALLY SPACED FREQUENCIES 210 FREQ=WBEGIN+DBLE(NU-NULO)*DELTAW RCO=DELTAW GO TO 22 21 FREQ=FRESET(NU) RCO=RCOSET(NU) 22 FREQLG= LOG(FREQ) WAVENO=FREQ/2.997925E10 FREQ15=FREQ/1.D15 DO 20 J=1,NRHOX EHVKT(J)=EXP(-FREQ*HKT(J)) STIM(J)=1.-EHVKT(J) C 20 BNU(J)=1.47439E-47*FREQ**3*EHVKT(J)/STIM(J) C FOR UNDERFLOW ON UNIVAC 20 BNU(J)=1.47439E-2*FREQ15**3*EHVKT(J)/STIM(J) IF(IFOP(15).EQ.1)GO TO 60 IF(IFOP(16).EQ.1)GO TO 60 CALL PUTOUT(2) N=1 CALL KAPP(N,NSTEPS,STEPWT) CALL JOSH(IFSCAT,IFSURF) RCOWT=RCO*STEPWT IF(IFSURF.GT.0)GO TO 53 IF(IFCORR.EQ.1)CALL TCORR(2,RCOWT) CALL RADIAP(2,RCOWT) CALL ROSS(2,RCOWT) IF(NLTEON.EQ.1)CALL STATEQ(2,RCOWT) C THIS PASSES VALUE OF STEPWT TO PUTOUT 53 PUT=STEPWT IPUT=NSTEPS CALL PUTOUT(3) CALL PUTOUT(4) GO TO 25 C 60 N=0 CALL KAPP(N,NSTEPS,STEPWT) CALL JOSH(IFSCAT,IFSURF) IF(IFSURF.EQ.2)HNU(1)=SURFI(1) IF(IFSURF.EQ.2)CONTIN=SURFI(1) IF(IFSURF.LT.2)CONTIN=HNU(1) PUT=CONTIN CALL PUTOUT(2) IF(IFSURF.GT.0)GO TO 700 DO 70 J=1,NRHOX ABTOTC(J)=ABTOT(J) ALPHAC(J)=ALPHA(J) TAUNUC(J)=TAUNU(J) SNUC(J)=SNU(J) HNUC(J)=HNU(J) JNUC(J)=JNU(J) JMINSC(J)=JMINS(J) 70 RESIDC(J)=0. 700 SUMWT=0. RESIDC(1)=0. C N=1 GO TO 72 C 24 N=N+1 IF(RESIDC(1).GT..9995)GO TO 79 IF(RESIDC(1).GT..998.AND.IFSURF.GT.0)GO TO 79 IF(IFSURF.GT.0)GO TO 72 DO 71 J=1,NRHOX IF(RESIDC(J).LT..998 )GO TO 72 C IF(RESIDC(J).LT..999 )GO TO 72 71 CONTINUE 79 STEPWT=1.-SUMWT N=N+1 IF(STEPWT.LT..0001)STEPWT=0. N=NSTEPS+1 RESIDC(1)=1. IF(IFSURF.EQ.1)HNU(1)=CONTIN IF(IFSURF.EQ.2)SURFI(1)=CONTIN IF(IFSURF.GT.0)GO TO 770 DO 75 J=1,NRHOX ABTOT(J)=ABTOTC(J) ALPHA(J)=ALPHAC(J) TAUNU(J)=TAUNUC(J) SNU(J)=SNUC(J) HNU(J)=HNUC(J) JNU(J)=JNUC(J) 75 JMINS(J)=JMINSC(J) GO TO 76 72 CALL LINOP(N,NSTEPS,STEPWT) DO 73 J=1,NRHOX 73 ALINE(J)=ALINES(J) CALL JOSH(IFSCAT,IFSURF) IF(IFSURF.EQ.2)HNU(1)=SURFI(1) IF(IFSURF.EQ.1)RESIDC(1)=HNU(1)/CONTIN IF(IFSURF.EQ.2)RESIDC(1)=SURFI(1)/CONTIN IF(IFSURF.GT.0)GO TO 770 76 DO 77 J=1,NRHOX 77 RESIDC(J)=HNU(J)/HNUC(J) 770 SUMWT=SUMWT+STEPWT 78 RCOWT=RCO*STEPWT C IF(STEPWT.EQ.0.)GO TO 23 IF(IFSURF.GT.0)GO TO 23 IF(IFCORR.EQ.1)CALL TCORR(2,RCOWT) CALL RADIAP(2,RCOWT) CALL ROSS(2,RCOWT) IF(NLTEON.EQ.1)CALL STATEQ(2,RCOWT) C THIS PASSES VALUE OF STEPWT TO PUTOUT 23 PUT=STEPWT IPUT=NSTEPS CALL PUTOUT(3) IF(N.LT.NSTEPS)GO TO 24 IF(N.EQ.NSTEPS)GO TO 79 CALL PUTOUT(4) 25 CONTINUE IF(IFSURF.GT.0)GO TO 1 C C FINISH ITERATION CALL ROSS(3,0) IF(IFPRES.EQ.1)CALL CONVEC CALL RADIAP(3,0) IF(IFCORR.EQ.1)CALL TCORR(3,0) IF(NLTEON.EQ.1)CALL STATEQ(3,0) CALL HIGH IF(IFTURB.EQ.1)CALL TURB CALL PUTOUT(5) C 100 CONTINUE GO TO 1 END SUBROUTINE PUTOUT(MODE) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ABROSS/ABROSS(kw),TAUROS(kw) COMMON /ABTOT/ABTOT(kw),ALPHA(kw) COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BB/BB1(kw,7),XNFPB(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2) COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /BK/BK1(kw,8),XNFPK(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1) COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw), 1 GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH, 2 IFCONV REAL*8 MIXLTH COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /FRESET/FRESET(500),RCOSET(500),NULO,NUHI,NUMNU,IFWAVE, 1 WBEGIN,DELTAW COMMON /HEIGHT/HEIGHT(kw) COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /ITER/ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /JUNK/TITLE(74),FREQID(6),WLTE,XSCALE COMMON /MUS/ANGLE(20),SURFI(20),NMU COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /OPTOT/ACONT(kw),SCONT(kw),ALINE(kw),SLINE(kw),SIGMAC(kw), 1 SIGMAL(kw) COMMON /PZERO/PZERO,PCON,PRADK0,PTURB0,KNU(kw),PRADK(kw),EDENS(kw) REAL*8 KNU COMMON /PUT/PUT,IPUT COMMON /RAD/ACCRAD(kw),PRAD(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TAUSHJ/TAUNU(kw),SNU(kw),HNU(kw),JNU(kw),JMINS(kw) REAL*8 JNU,JMINS COMMON /TEFF/TEFF,GRAV,GLOG COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB DIMENSION SURFIN(20),F(20),ABLOG(20) EQUIVALENCE (F(1),STIM(1)) DATA ON,OFF/3HON ,3HOFF/ EXP10(X)=EXP(X*2.30258509299405E0) C GO TO(100,200,300,400,500),MODE C C HEADINGS 100 IF(IFPRNT(ITER).EQ.0)RETURN IFHEAD=0 NU=NULO-1 IF(IFPNCH(ITER).LT.2)RETURN WRITE(7,552)TEFF,GLOG RETURN C C INITIALIZE SUMS OVER STEPS 200 HSURF=0. C HNU(1)=0. WAVE=2.997925E17/FREQ NU=NU+1 DO 201 MU=1,NMU 201 SURFIN(MU)=0. N=0 CONTIN=PUT RETURN C C SUM OVER STEPS AND STEP DEPENDENT QUANTITIES 300 N=N+1 NSTEPS=IPUT STEPWT=PUT HSURF=HSURF+HNU(1)*STEPWT DO 301 MU=1,NMU 301 SURFIN(MU)=SURFIN(MU)+SURFI(MU)*STEPWT IF(IFPRNT(ITER).EQ.0)RETURN IF(NSTEPS.EQ.1)GO TO 310 IF(IFHEAD.EQ.0)WRITE(6,101) IFHEAD=1 C IF(N.EQ.1)WRITE(6,303) IF(N.EQ.1.AND.IFPRNT(ITER).GT.1)WRITE(6,303) 303 FORMAT(1H0) RESID=HNU(1)/CONTIN HNULG= LOG10(HNU(1)) HNUMG=-2.5*HNULG DO 340 JTAU1=1,NRHOX IF(TAUNU(JTAU1).GT.1.)GO TO 341 340 CONTINUE 341 CONTINUE C RHOX1= LOG10(RHOX1) C IDUM=MAP1(TAUNU,RHOX,NRHOX,1.,RHOX1,1) TAUEND= LOG10(TAUNU(NRHOX)) IF(IFPRNT(ITER).GT.1) 1WRITE(6,305)STEPWT,HNU(1),HNULG,HNUMG,RESID,JTAU1,TAUEND C 305 FORMAT(61X,F10.8,0PE13.4,0PF12.5,F10.3,F9.5,I6,F6.2) 305 FORMAT(61X,F10.8,1PE13.4,0PF12.5,F10.3,F9.5,I6,F6.2) 310 IF(IFPRNT(ITER).EQ.4)GO TO 320 IF(IFPRNT(ITER).NE.3)RETURN WRITE(6,312)WAVE,FREQ,(J,RHOX(J),TAUNU(J),ABTOT(J), 1ALPHA(J),BNU(J),SNU(J),JNU(J),JMINS(J),HNU(J),J=1,NRHOX) 312 FORMAT(1H1//6X10HWAVELENGTHF9.3,3X9HFREQUENCY1PE13.6/ 1/12X4HRHOX,7X5HTAUNU,6X5HABTOT,5X5HALPHA,8X3HBNU,8X3HSNU, 28X3HJNU,7X5HJMINS,7X3HHNU/(6XI2,1P9E11.3)) RETURN 320 WRITE(6,321) 321 FORMAT( 126H1 AHYD AH2P AHMIN SIGH AHE1 AHE2 AHEMIN SIGHE 1 ACOOL ALUKE AHOT SIGEL SIGH2 AHLINEALINESSIGLINAXLINE SIGXLAXCONT 2 SIGX) DO 325 J=1,NRHOX DO 322 I=1,20 ABLOG(I)=0. 322 CONTINUE IF(AHYD (J).GT.0.)ABLOG( 1)= LOG10(AHYD (J)) IF(AH2P (J).GT.0.)ABLOG( 2)= LOG10(AH2P (J)) IF(AHMIN (J).GT.0.)ABLOG( 3)= LOG10(AHMIN (J)) IF(SIGH (J).GT.0.)ABLOG( 4)= LOG10(SIGH (J)) IF(AHE1 (J).GT.0.)ABLOG( 5)= LOG10(AHE1 (J)) IF(AHE2 (J).GT.0.)ABLOG( 6)= LOG10(AHE2 (J)) IF(AHEMIN(J).GT.0.)ABLOG( 7)= LOG10(AHEMIN(J)) IF(SIGHE (J).GT.0.)ABLOG( 8)= LOG10(SIGHE (J)) IF(ACOOL (J).GT.0.)ABLOG( 9)= LOG10(ACOOL (J)) IF(ALUKE (J).GT.0.)ABLOG(10)= LOG10(ALUKE (J)) IF(AHOT (J).GT.0.)ABLOG(11)= LOG10(AHOT (J)) IF(SIGEL (J).GT.0.)ABLOG(12)= LOG10(SIGEL (J)) IF(SIGH2 (J).GT.0.)ABLOG(13)= LOG10(SIGH2 (J)) IF(AHLINE(J).GT.0.)ABLOG(14)= LOG10(AHLINE(J)) IF(ALINES(J).GT.0.)ABLOG(15)= LOG10(ALINES(J)) IF(SIGLIN(J).GT.0.)ABLOG(16)= LOG10(SIGLIN(J)) IF(AXLINE(J).GT.0.)ABLOG(17)= LOG10(AXLINE(J)) IF(SIGXL (J).GT.0.)ABLOG(18)= LOG10(SIGXL (J)) IF(AXCONT(J).GT.0.)ABLOG(19)= LOG10(AXCONT(J)) IF(SIGX (J).GT.0.)ABLOG(20)= LOG10(SIGX (J)) 325 WRITE(6,326)J,ABLOG,J 326 FORMAT(I4,2X20F6.2,1XI3) RETURN C C PRINT SUMS OVER STEPS C 400 IF(IFPRNT(ITER).EQ.0)RETURN 400 IF(IFPRNT(ITER).LE.1)RETURN IF(NSTEPS.EQ.1)CONTIN=HSURF RESID=HSURF/CONTIN DO 440 JTAU1=1,NRHOX IF(TAUNU(JTAU1).GT.1.)GO TO 441 440 CONTINUE 441 CONTINUE C IDUM=MAP1(TAUNU,RHOX,NRHOX,1.,RHOX1,1) C RHOX1= LOG10(RHOX1) TAUEND= LOG10(TAUNU(NRHOX)) IF(NSTEPS.GT.1)JTAU1=0 IF(NSTEPS.GT.1)TAUEND=0. IF(IFSURF.NE.0.AND.IFSURF.NE.1)GO TO 405 IF(IFHEAD.EQ.0)WRITE(6,101) 101 FORMAT(1H1/////10X4HWAVE,7X7HHLAMBDA,7X5HLOG H,7X3HMAG, 110X9HFREQUENCY,8X3HHNU,10X5HLOG H,7X3HMAG,10X6HTAUONE,6H TAUNU) IFHEAD=1 IF(HSURF.LE.0.)HSURF=1.E-30 HLAM=HSURF*FREQ/WAVE HNULG= LOG10(HSURF) HLAMLG= LOG10(HLAM) HLAMMG=-2.5*HLAMLG HNUMG=-2.5*HNULG WRITE(6,1401) 1401 FORMAT(1H ) WRITE (6,401)NU,WAVE,HLAM,HLAMLG,HLAMMG,FREQ,HSURF,HNULG,HNUMG, 1RESID,JTAU1,TAUEND,NU 401 FORMAT(I5,F11.3,1PE13.4,0PF12.5,F10.3,1PE20.6,E13.4,0PF12.5,F10.3, C 401 FORMAT(I5,F11.3,0PE13.4,0PF12.5,F10.3,0PE20.6,E13.4,0PF12.5,F10.3, 1F9.5,I6,F6.2,I5) 405 IF(IFSURF.NE.2)GO TO 410 IF(IFHEAD.EQ.0)WRITE(6,102) 102 FORMAT(1H1/////10X4HWAVE,5X9HFREQUENCY,3X12HTAUONE TAUNU, 15(17H MU INTENSITY )) IFHEAD=1 WRITE(6,406)NU,WAVE,FREQ,JTAU1,TAUEND, 1(ANGLE(MU),SURFIN(MU),MU=1,NMU) 406 FORMAT(I5,F10.3,1PE15.6,I5,0PF6.2,5(0PF6.3,1PE11.3)/ 141X,5(0PF6.3,1PE11.3)/41X,5(0PF6.3,1PE11.3)/41X,5(0PF6.3,1PE11.3)) 410 IF(IFPNCH(ITER).LT.2)RETURN IF(IFSURF.GT.2)RETURN IF(IFSURF.EQ.2)GO TO 415 WRITE(7,411)FREQ,HSURF,CONTIN,RESID 411 FORMAT(4HFLUX,1PE20.6,E13.4,E13.4,0PF10.5) RETURN 415 WRITE(7,416)FREQ,(ANGLE(MU),SURFIN(MU),MU=1,NMU) 416 FORMAT(9HINTENSITY,1PD15.6,3(0PF5.2,1PE11.4)/(5(0PF5.2,1PE11.4))) RETURN C C SUMMARIES 500 IF(IFPRNT(ITER).EQ.0)GO TO 550 IF(IFPRNT(ITER).EQ.1)GO TO 540 WRITE(6,501)(J,RHOX(J),PTOTAL(J),PTURB(J),GRDADB(J),DLTDLP(J), 1VELSND(J),DLRDLT(J),HEATCP(J),HSCALE(J),VCONV(J),FLXCNV(J), 2J=1,NRHOX) 501 FORMAT(1H1/////132H RHOX PTOTAL PTURB GRDADB + 1 DLTDLP VELSND DLRDLT HEATCP HSCALE VCONV + 2 FLXCNV /(I3,1P11E11.3)) WRITE(6,502)FLUX 502 FORMAT(1H0108X4HFLUX1PE12.4) WRITE(6,503)(J,XNATOM(J),EDENS(J),PRADK(J),XNFPH(J,1),XNFPH(J,2), 1XNFPHE(J,1),XNFPHE(J,2),XNFPHE(J,3),VTURB(J),J=1,NRHOX) 503 FORMAT(1H1/////132H XNATOM EDENS PRADK XNFPH1 + 1 XNFPH2 XNFPHE1 XNFPHE2 XNFPHE3 VTURB + 2 /(I3,1P9E11.3)) CALL W(6HPRADK0,PRADK0,1) 540 WRITE(6,541) TEFF,GLOG,TITLE,ITER 541 FORMAT(1H1//////5H TEFF,F8.0,8H LOG G,F7.3,10X74A1,2X, 19HITERATION,I3) DO 539 J=1,NRHOX IF(IFCORR.EQ.0)FLXRAD(J)=FLUX-FLXCNV(J) 539 FLXCNV(J)=FLXCNV(J)/(FLXCNV(J)+FLXRAD(J)) WRITE(6,542)(J,RHOX(J),T(J),P(J),XNE(J),RHO(J),ABROSS(J), 1HEIGHT(J),TAUROS(J),FLXCNV(J),ACCRAD(J),FLXERR(J),FLXDRV(J), 2J=1,NRHOX) 542 FORMAT(132H0 ELECTRON + 1 ROSSELAND HEIGHT ROSSELAND FRACTION RADIATIVE PE 2R CENT FLUX/132H RHOX TEMP PRESSURE NUMBER DEN 4SITY MEAN (KM) DEPTH CONV FLUX ACCELERATION + 5 ERROR DERIV/(I3,1PE10.3,0PF9.1,1P8E11.3,0PF14.3,F8.3)) 550 IF(IFPNCH(ITER).EQ.0)RETURN C C PUNCHOUT A=OFF IF(IFCONV.EQ.1)A=ON B=OFF IF(IFTURB.EQ.1)B=ON WRITE(7,552) TEFF,GLOG,WLTE,TITLE,IFOP,A,MIXLTH,B,TRBFDG, 1TRBPOW,TRBSND,TRBCON,XSCALE,(IZ,ABUND(IZ),IZ=1,99) 552 FORMAT(5HTEFF F7.0,9H GRAVITY F5.3,1XA4/6HTITLE 74A1 1/13H OPACITY IFOP20I2/12H CONVECTION A3,F6.2,12H TURBULENCE A3, 24F6.2/16HABUNDANCE SCALE F7.3,17H ABUNDANCE CHANGE2(I2,F6.3)/ 3(17H ABUNDANCE CHANGE6(I3,F7.2))) WRITE(7,554)NRHOX,(RHOX(J),T(J),P(J),XNE(J),ABROSS(J),ACCRAD(J), 1VTURB(J),J=1,NRHOX) 554 FORMAT(10HREAD DECK6I3,33H RHOX,T,P,XNE,ABROSS,ACCRAD,VTURB/ 1(1PD15.8,0PF9.1,1P5E10.3)) C 1(0PD15.8,0PF9.1,0P5E10.3)) WRITE(7,555)PRADK0 555 FORMAT(5HPRADK1PE11.4) C 555 FORMAT(5HPRADK0PE11.4) IF(NLTEON.EQ.0)GO TO 560 WRITE(7,556)NRHOX,(RHOX(J),(BHYD(J,I),I=1,6),BMIN(J),J=1,NRHOX) 556 FORMAT(27HREAD DEPARTURE COEFFICIENTSI3,21H RHOX BHYD 1-6 BMIN/ 1(1PE11.4,0P7F9.4)) C 1(0PE11.4,0P7F9.4)) 560 IF(IFWAVE.EQ.1)GO TO 570 WRITE(7,562)NUMNU,NULO,NUHI,FREQID,(NU,FRESET(NU),RCOSET(NU), 1NU=1,NUMNU) 562 FORMAT(16HREAD FREQUENCIES3I4,3X6A1/(I5,1P2E17.8,I5,2E17.8)) C 562 FORMAT(16HREAD FREQUENCIES3I4,3X6A1/(I5,0P2E17.8,I5,2E17.8)) 570 WRITE(7,571)ITER 571 FORMAT(5HBEGIN,20X10HITERATION I3,10H COMPLETED ) RETURN END SUBROUTINE TCORR(MODE,RCOWT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ABROSS/ABROSS(kw),TAUROS(kw) COMMON /ABTOT/ABTOT(kw),ALPHA(kw) COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw), 1 GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH, 2 IFCONV REAL*8 MIXLTH COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /ITER/ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /RAD/ACCRAD(kw),PRAD(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TAUSHJ/TAUNU(kw),SNU(kw),HNU(kw),JNU(kw),JMINS(kw) REAL*8 JNU,JMINS COMMON /TEFF/TEFF,GRAV,GLOG COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB DIMENSION RJMINS(kw),RDABH(kw),RDIAGJ(kw),OLDT1(kw) C(((((((((((((((((((((((( C DIMENSION DABTOT(kw),DTDRHX(kw),HRATIO(kw),CODRHX(kw),G(kw), C 1GFLUX(kw),DDLT(kw),DRHOX(kw),DTFLUX(kw),DTLAMB(kw),DUM(kw), C 2TINTEG(kw),DTSURF(kw),T1(kw),CNVFLX(kw),GRDEFF(kw),RHOXL(kw) DIMENSION DABTOT(kw),DTDRHX(kw),HRATIO(kw),CODRHX(kw),G(kw), 1GFLUX(kw),DDLT(kw),DTAU(kw),DTFLUX(kw),DTLAMB(kw),DUM(kw), 2TINTEG(kw),DTSURF(kw),T1(kw),CNVFLX(kw),GRDEFF(kw),RHOXL(kw) DIMENSION DABROS(kw) DIMENSION TAUNEW(kw),TPLUS(kw),TNEW1(kw),TNEW2(kw) DIMENSION AB1(kw),PTOT1(kw),P1(kw),AB2(kw),PTOT2(kw),P2(kw) DIMENSION PPP(kw),RRR(kw),DRHOX(kw) DIMENSION PRDNEW(kw) C EQUIVALENCE (HKT(1),G(1),DUM(1),DTSURF(1)) C EQUIVALENCE (TKEV(1),CNVFLX(1),RHOXL(1)) C EQUIVALENCE (TLOG(1),DTDRHX(1),DTFLUX(1)),(TK(1),T1(1)) C EQUIVALENCE (FLXERR(1),DABTOT(1),DRHOX(1)),(TAUNU(1),DDLT(1)) C EQUIVALENCE (RDABH(1),CODRHX(1),GFLUX(1),TINTEG(1),HRATIO(1)) C EQUIVALENCE (RDIAGJ(1),DTLAMB(1),GRDEFF(1)) EQUIVALENCE (HKT(1),DABROS(1),G(1),PTOT1(1),DUM(1),DTSURF(1)) EQUIVALENCE (TKEV(1),CNVFLX(1),RHOXL(1)) EQUIVALENCE (TLOG(1),DTDRHX(1),DTFLUX(1)) C EQUIVALENCE (TK(1),TPLUS(1),PTOT2(1),PPP(1),T1(1)) EQUIVALENCE (TK(1),TPLUS(1),PTOT2(1),PPP(1)) C EQUIVALENCE (FLXERR(1),DABTOT(1),AB1(1),AB2(1),DTAU(1),RRR(1)) EQUIVALENCE ( DABTOT(1),AB1(1),AB2(1),DTAU(1),RRR(1)) EQUIVALENCE (TAUNU(1),DDLT(1),TAUNEW(1),DRHOX(1)) EQUIVALENCE (RDABH(1),CODRHX(1),GFLUX(1),TINTEG(1),HRATIO(1)) EQUIVALENCE (RDIAGJ(1),DTLAMB(1),GRDEFF(1)) EQUIVALENCE (SNU(1),TNEW1(1),TNEW2(1)) EQUIVALENCE (HNU(1),P1(1),P2(1)) EQUIVALENCE (JNU(1),PRDNEW(1)) C)))))))))))))))))))))))) GO TO (10,20,30),MODE C ERASE FREQUENCY INTEGRALS 10 DO 11 J=1,NRHOX RJMINS(J)=0. RDABH(J)=0. RDIAGJ(J)=0. 11 FLXRAD(J)=0. RETURN C C FREQUENCY INTEGRATION C(((((((((((((((((((((((( C 20 DO 21 J=1,NRHOX 20 CALL DERIV(RHOX,ABTOT,DABTOT,NRHOX) DO 21 J=1,NRHOX RDABH(J)=RDABH(J)+DABTOT(J)/ABTOT(J)*HNU(J)*RCOWT C)))))))))))))))))))))))) RJMINS(J)=RJMINS(J)+ABTOT(J)*JMINS(J)*RCOWT 21 FLXRAD(J)=FLXRAD(J)+HNU(J)*RCOWT TERM2=0. DO 24 J=1,NRHOX TERM1=TERM2 IF(J.NE.NRHOX)D=TAUNU(J+1)-TAUNU(J) IF(D.LE..01)GO TO 23 EX=0. IF(D.LT.10.)EX=EXPI(3,D) TERM2=.5*(D+EX-.5)/D GO TO 22 23 TERM2=(.922784335098467- LOG(D))*D*(.25+D*(8.33333333333333E-2+D* 1(1.04166666666667E-2+D*1.38888888888889E-3))) 22 DIAGJ=TERM1+TERM2 DBDT=BNU(J)*FREQ*HKT(J)/T(J)/STIM(J) 24 RDIAGJ(J)=RDIAGJ(J)+ABTOT(J)*(DIAGJ-1.)/(1.-ALPHA(J)*DIAGJ)* 1(1.-ALPHA(J))*DBDT*RCOWT RETURN C C AVRETT-KROOK TAU CORRECTION MODIFIED FOR CONVECTION 30 CALL DERIV(RHOX,T,DTDRHX,NRHOX) CALL DERIV(RHOX,DLTDLP,DDLT,NRHOX) C(((((((((((((((((((((((( CALL DERIV(RHOX,ABROSS,DABROS,NRHOX) DO 31 J=1,NRHOX RDABH(J)=RDABH(J)-FLXRAD(J)*DABROS(J)/ABROSS(J) C)))))))))))))))))))))))) CNVFLX(J)=0. DEL=1. D=0. IF(IFCONV.EQ.1)CNVFLX(J)=FLXCNV(J) IF(J.LT.3)CNVFLX(J)=0. IF(CNVFLX(J).GT.0.)DEL=DLTDLP(J)-GRDADB(J) VCO=.5*MIXLTH*SQRT(-.5*PTOTAL(J)/RHO(J)*DLRDLT(J)) FLUXCO=.5*RHO(J)*HEATCP(J)*T(J)*MIXLTH/12.5664 IF(MIXLTH.GT.0.)D=8.*5.6697E-5*T(J)**4/ 1(ABROSS(J)*HSCALE(J)*RHO(J))/(FLUXCO*12.5664)/VCO D=D**2/2. CNVFL=0. IF(CNVFLX(J)/FLXRAD(J).GT.1.E-3)CNVFL=CNVFLX(J) C 31 CODRHX(J)=(RDABH(J)+CNVFLX(J)*(DTDRHX(J)/T(J)*(1.-9.*D/(D+DEL))+ 31 CODRHX(J)=(RDABH(J)+CNVFL *(DTDRHX(J)/T(J)*(1.-9.*D/(D+DEL))+ 1 1.5*DDLT(J)/DEL*(1.+D/(D+DEL))))/(FLXRAD(J)+CNVFLX(J)* 2 1.5*DLTDLP(J)/DEL*(1.+D/(D+DEL))) CODRHX(1)=0. CODRHX(2)=0. C CALL INTEG(RHOX,CODRHX,G,NRHOX) CALL INTEG(RHOX,CODRHX,G,NRHOX,0.) DO 32 J=1,NRHOX G(J)=EXP(G(J)) 32 GFLUX(J)=G(J)*(FLXRAD(J)+CNVFLX(J)-FLUX)/(FLXRAD(J)+CNVFLX(J)* 1 1.5*DLTDLP(J)/DEL*(1.+D/(D+DEL))) C(((((((((((((((((((((((( C CALL INTEG(RHOX,GFLUX,DRHOX,NRHOX) C CALL INTEG(TAUROS,GFLUX,DTAU,NRHOX) CALL INTEG(TAUROS,GFLUX,DTAU,NRHOX,0.) DO 33 J=1,NRHOX C DRHOX(J)=DRHOX(J)/G(J) C DRHOX(J)= MAX (-TAUROS(J)/ABROSS(J)/2., MIN (TAUROS(J)/ABROSS(J), C 1DRHOX(J))) C 33 DTFLUX(J)=-DRHOX(J)*DTDRHX(J) DTAU(J)=DTAU(J)/G(J) DTAU(J)= MAX (-TAUROS(J)/2., MIN (TAUROS(J)/2.,DTAU(J))) 33 DTFLUX(J)=-DTAU(J)*DTDRHX(J)/ABROSS(J) DO 3301 J=1,NRHOX IF(TAUROS(J).GE..03)GO TO 3302 DO 3300 I=1,J 3300 DTFLUX(I)=DTFLUX(I)*.5 3301 CONTINUE 3302 CONTINUE C)))))))))))))))))))))))) DTFLUX(1)=0. DTFLUX(2)=0. C DO 41 J=1,NRHOX 41 FLXERR(J)=(FLXRAD(J)+CNVFLX(J)-FLUX)/FLUX*100. CALL DERIV(TAUROS,FLXERR,FLXDRV,NRHOX) TEFF25=TEFF/25. DO 43 J=1,NRHOX C IF(CNVFLX(J)/FLXRAD(J).LT.1.E-5)FLXDRV(J)=RJMINS(J)/ABROSS(J)/ IF(CNVFLX(J)/FLXRAD(J).LT.1.E-3)FLXDRV(J)=RJMINS(J)/ABROSS(J)/ 1FLUX*100. DTLAMB(J)=-FLXDRV(J)*FLUX/100./RDIAGJ(J)*ABROSS(J) IF(CNVFLX(J)/FLXRAD(J).LT.1.E-5.AND.TAUROS(J).LT.1.)GO TO 42 DTLAMB(J)=0. DTLAMB(J-1)=DTLAMB(J-1)/2. DTLAMB(J-2)=DTLAMB(J-2)/2. DTLAMB(J-3)=DTLAMB(J-3)/2. DTLAMB(J-4)=DTLAMB(J-4)/2. DTLAMB(J-5)=DTLAMB(J-5)/2. C FUDGE TO AVOID VERY LARGE TEMPERATURE CORRECTIONS 42 DTLAMB(J)= MAX (-TEFF25, MIN (TEFF25,DTLAMB(J))) 43 CONTINUE C DTSUR=(FLUX-FLXRAD(1))/FLUX*.25*T(1) DTSUR= MAX (-TEFF25, MIN (TEFF25,DTSUR)) DO 45 J=1,NRHOX 45 DUM(J)=DTFLUX(J)+DTLAMB(J) C CALL INTEG(TAUROS,DUM,TINTEG,NRHOX) CALL INTEG(TAUROS,DUM,TINTEG,NRHOX,0.) IDUM=MAP1(TAUROS,TINTEG,NRHOX,.1,TONE,1) IDUM=MAP1(TAUROS,TINTEG,NRHOX,2.,TTWO,1) TAV=(TTWO-TONE)/2. IF(DTSUR*TAV.LE.0.)TAV=0. IF(ABS(TAV).GT.ABS(DTSUR))TAV=DTSUR DTSUR=DTSUR-TAV DO 49 J=1,NRHOX 49 DTSURF(J)=DTSUR C DO 50 J=1,NRHOX HRATIO(J)=CNVFLX(J)/(CNVFLX(J)+FLXRAD(J)) 50 T1(J)=DTFLUX(J)+DTLAMB(J)+DTSURF(J) C IF(IFPRNT(ITER).LE.1)GO TO 60 IF(IFPRNT(ITER).EQ.0)GO TO 60 WRITE(6,100) (J,RHOX(J),T(J),DTLAMB(J),DTSURF(J),DTFLUX(J),T1(J), 1HRATIO(J),FLXERR(J),FLXDRV(J),J=1,NRHOX) 100 FORMAT(1H1///94H0 RHOX T DTLAMB DTSURF DTFL 1UX T1 CONV/TOTAL ERROR DERIV/ 2(I3,1PE12.4,0PF10.1,4F9.1,1X1PE11.3,1X0P2F10.3)) C 2(I3,0PE12.4,0PF10.1,4F9.1,1X0PE11.3,1X0P2F10.3)) C 60 DO 61 J=1,NRHOX IF(IFCONV.EQ.1)GO TO 62 IF(ITER.EQ.1)GO TO 62 IF(OLDT1(J)*T1(J).GT.0.)T1(J)=T1(J)*1.25 IF(OLDT1(J)*T1(J).LT.0.)T1(J)=T1(J)*.5 62 OLDT1(J)=T1(J) C 61 T(J)=T(J)+T1(J) 61 CONTINUE C(((((((((((((((((((((((( C C DETERMINE RHOX CORRECTION TO MAINTAIN CONSTANT TAUROS TAUROS(1)=ABROSS(1)*RHOX(1) DELTAU=( LOG(TAUROS(NRHOX))- LOG(TAUROS(1)))/DBLE(NRHOX-1) C DELTAU=( LOG(TAUROS(NRHOX))- LOG(TAUROS(2)))/DBLE(NRHOX-2) C START= LOG(TAUROS(2))-2.*DELTAU START= LOG(TAUROS(1))-DELTAU DO 501 J=1,NRHOX TPLUS(J)=T(J)+T1(J) C TPLUS(J)=T(J)+DTFLUX(J) 501 TAUNEW(J)=EXP(START+DELTAU*DBLE(J)) IDUM=MAP1(TAUROS,T,NRHOX,TAUNEW,TNEW1,NRHOX) IDUM=MAP1(TAUROS,PRAD,NRHOX,TAUNEW,PRDNEW,NRHOX) CALL TTAUP(TNEW1,TAUNEW,AB1,PTOT1,P1,PRDNEW,PTURB,GRAV,NRHOX) C CALL TTAUP(TNEW1,TAUNEW,AB1,PTOT1,P1,PRAD,PTURB,GRAV,NRHOX) IDUM=MAP1(TAUROS,TPLUS,NRHOX,TAUNEW,TNEW2,NRHOX) CALL TTAUP(TNEW2,TAUNEW,AB2,PTOT2,P2,PRDNEW,PTURB,GRAV,NRHOX) DO 503 J=1,NRHOX C PPP=(RHOX2-RHOX1)/RHOX1 503 PPP(J)=(PTOT2(J)-PTOT1(J))/PTOT1(J) IDUM=MAP1(TAUNEW,PPP,NRHOX,TAUROS,RRR,NRHOX) TAUROS(1)=0. C RRR(1)=0. DO 505 J=1,NRHOX 505 DRHOX(J)=RRR(J)*RHOX(J) C)))))))))))))))))))))))) DO 65 J=1,NRHOX 65 T(J)=T(J)+T1(J) C C FUDGES TO MAKE UP FOR BAD STARTING GUESSES C(((((((((((((((((((((((( IFUDGE=0 C)))))))))))))))))))))))) IF(IFCONV.EQ.1)GO TO 71 IF(ITER.GT.1)GO TO 80 IF(FLXERR(NRHOX).LT.90..AND.FLXERR(NRHOX).GT.-50.)GO TO 80 DO 70 J=1,NRHOX 70 T(J)=TEFF*(.75*(.710+TAUROS(J)-.1331*EXP(-3.4488*TAUROS(J))))**.25 C(((((((((((((((((((((((( IFUDGE=1 C)))))))))))))))))))))))) GO TO 80 71 DO 72 J=1,NRHOX IF(FLXERR(J).GT.1000.)GO TO 73 72 CONTINUE GO TO 80 73 DO 74 J=1,NRHOX GRDEFF(J)=(FLXRAD(J)*DLTDLP(J)+FLXCNV(J)*GRDADB(J))/(FLXRAD(J)+ 1FLXCNV(J)) IF(FLXCNV(J).GT.0.)GRDEFF(J)= MAX (GRDEFF(J),(1.+DLTDLP(J))/3.) 74 RHOXL(J)= LOG(RHOX(J)) C CALL INTEG(RHOXL,GRDEFF,TLOG,NRHOX) CALL INTEG(RHOXL,GRDEFF,TLOG,NRHOX,0.) DO 75 JSTART=1,NRHOX IF(FLXCNV(JSTART).GT.0.)GO TO 76 75 CONTINUE GO TO 80 76 DO 77 J=JSTART,NRHOX 77 T(J)=T(J-1)*EXP(TLOG(J)-TLOG(J-1)) C(((((((((((((((((((((((( IFUDGE=1 C)))))))))))))))))))))))) 80 DO 81 J=1,NRHOX TK(J)=1.38054E-16*T(J) HKT(J)=6.6256E-27/TK(J) HCKT(J)=HKT(J)*2.997925E10 TKEV(J)=8.6171E-5*T(J) 81 TLOG(J)= LOG(T(J)) C(((((((((((((((((((((((( IF(IFUDGE.EQ.1)RETURN C CHANGE RHOX TO MAINTAIN CONSTANT TAUROS DO 91 J=1,NRHOX 91 RHOX(J)=RHOX(J)+DRHOX(J) C)))))))))))))))))))))))) RETURN END SUBROUTINE STATEQ(MODE,RCOWT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C THE BOUND-BOUND COLLISION RATES WERE DERIVED FROM AN ANALYTIC FIT C TO THE CROSS SECTION CALCULATIONS OF BURKE,ORMONDE AND WHITAKER, C PROC. PHYS. SOC., 1968, VOL 92, 319 C C THE CROSS SECTION USED (IN UNITS OF PI*A0**2) IS C C QIJ = 4*FIJ*(EH/E0)**2*(LOG(E/E0)/(E/E0)+.148 /(E/E0)**6) C C FIJ = OSCILLATOR STRENGTH C EH = GROUND STATE BINDING ENERGY C E0 = THRESHOLD ENERGY C D M PETERSON MAY 1968 COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /ITER/ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TAUSHJ/TAUNU(kw),SNU(kw),HNU(kw),JNU(kw),JMINS(kw) REAL*8 JNU,JMINS COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION QRADIK(kw,6),QRADKI(kw,6),QRDHMK(kw),QRDKHM(kw) DIMENSION DQRAD(kw,6),DQRD(kw),TOLD(kw) DIMENSION HCONT(6),DUMMY(6) DIMENSION A(6,6),RIGHT(6),QCOLL(8,8) EQUIVALENCE (A(1),TAUNU(1)),(QCOLL(1),HNU(1)),(HCONT(1),DUMMY(1)) DIMENSION F(8,8) DATA F/8*0.,.4162,7*0.,.07910,.6408,6*0.,.02899,.1193,.8420,5*0., 1.01394,.04467,.1506,1.038,4*0.,.007800,.02209,.05585,.1794,1.231, 23*0.,.004814,.01271,.02768,.06551,.2070,1.425,2*0.,.003184,.008037 3,.01604,.03229,.07455,.2340,1.615,0./ GO TO(10,20,30),MODE C ERASE FREQUENCY INTEGRALS 10 DO 11 I=1,6 DO 11 J=1,NRHOX TOLD(J)=T(J) QRDHMK(J)=0. QRDKHM(J)=0. DQRD(J)=0. DQRAD(J,I)=0. QRADKI(J,I)=0. 11 QRADIK(J,I)=0. RETURN C FREQUENCY INTEGRALS 20 RFRWT=12.5664/6.6256E-27*RCOWT/FREQ HVC=2.*6.6256E-27*FREQ*(FREQ/2.997925E10)**2 DO 21 N=2,6 21 HCONT(N)=COULX(N,FREQ,1.) HMINBF=0. IF(FREQ.GT.1.8259E14.AND.FREQ.LT.2.111E14)HMINBF= 1 3.695E-16+(-1.251E-1+1.052E13/FREQ)/FREQ IF(FREQ.GE.2.111E14)HMINBF=6.801E-20+(5.358E-3+(1.481E13+ 1(-5.519E27+(4.808E11/FREQ)*1.E30)/FREQ)/FREQ)/FREQ DO 25 J=1,NRHOX RJ=RFRWT*JNU(J) RJE=RFRWT*EHVKT(J)*(JNU(J)+HVC) RJEDT=RJE*HKT(J)*FREQ/T(J) DO 26 I=2,6 QRADIK(J,I)=QRADIK(J,I)+HCONT(I)*RJ DQRAD(J,I)=DQRAD(J,I)+HCONT(I)*RJEDT 26 QRADKI(J,I)=QRADKI(J,I)+HCONT(I)*RJE QRDHMK(J)=QRDHMK(J)+HMINBF*RJ DQRD(J)=DQRD(J)+HMINBF*RJEDT 25 QRDKHM(J)=QRDKHM(J)+HMINBF*RJE RETURN C 30 IF(IFPRNT(ITER).GT.0)WRITE(6,201) 201 FORMAT(1H1/////36X30HHMINUS STATISTICAL EQUILIBRIUM/10X4HRHOX, 1 7X6HQELECT,6X6HQASSOC,6X6HQCHARG,6X6HQRDKHM,6X6HQRDHMK,7X4HBMIN) DO 210 J=1,NRHOX DT=T(J)-TOLD(J) THETA=5040./T(J) QELECT=10.**(-8.7)*THETA**(1.5)*XNE(J) QASSOC=10.**(-8.7)*2.*BHYD(J,1)*XNFPH(J,1) QCHARG=10.**(-7.4)*THETA**.333333*XNFPH(J,2) QRDKHM(J)=QRDKHM(J)+DQRD(J)*DT BMIN(J)=(QRDKHM(J)+QELECT+QASSOC+QCHARG)/ 1(QRDHMK(J)+QELECT+QASSOC+QCHARG) 210 WRITE(6,211)J,RHOX(J),QELECT,QASSOC,QCHARG,QRDKHM(J), 1QRDHMK(J),BMIN(J) 211 FORMAT(I5,1P6E12.3,0PF10.4) C 211 FORMAT(I5,0P6E12.3,0PF10.4) C IF(IFPRNT(ITER).GT.0)WRITE(6,31) 31 FORMAT(1H1/////30X83HSTATISTICAL EQUILIBRIUM RATES RATE=SIGN(AL 1OG10( MAX (ABS(RATE*1.E20),1.)),RATE) / 2132H0 RAD 1-K K-1 2-K K-2 3-K K-3 4-K K-4 5-K + 3K-5 6-K K-6 COLL 1-K 2-K 3-K 4-K 5-K 6-K 5-8 + 46-8 / 5132H COLL 1-2 1-3 1-4 1-5 1-6 1-7 2-3 2-4 2-5 + 62-6 2-7 3-4 3-5 3-6 3-7 4-5 4-6 4-7 5-6 5-7 + 76-7 ) C DO 120 J=1,NRHOX DT=T(J)-TOLD(J) TH=13.595/TKEV(J) DO 50 I=1,8 Y=I QCOLL(I,I)=2.2E-8*Y**3/SQRT(TH)*EXP(-TH/Y**2)*XNE(J) C QCOLL(I,I) IS THE BOUND FREE RATE IF (I.EQ.8) GO TO 50 I1=I+1 DO 40 K=I1,8 Z=K GIK=1./Y**2-1./Z**2 X0=TH*GIK Q=2.186E-10*F(I,K)/GIK**2*X0*SQRT(T(J))*(EXPI(1,X0)+.148*X0* 2EXPI(5,X0)) QCOLL(I,K)=Q*XNE(J) QCOLL(K,I)=QCOLL(I,K)*(Y/Z)**2*EXP(X0) 40 CONTINUE 50 CONTINUE DO 65 I=1,6 A(I,I)=QRADIK(J,I) QRADKI(J,I)=QRADKI(J,I)+DQRAD(J,I)*DT RIGHT(I)=QRADKI(J,I)+QCOLL(I,I)+QCOLL(I,7)+QCOLL(I,8) DO 55 K=1,8 55 A(I,I)=A(I,I)+QCOLL(I,K) IF (I.EQ.6) GO TO 65 I1=I+1 DO 60 K=I1,6 A(I,K)=-QCOLL(I,K) 60 A(K,I)=-QCOLL(K,I) 65 CONTINUE C CALL SOLVIT(A,6,RIGHT,DUMMY) DO 80 L=1,6 80 BHYD(J,L)=RIGHT(L) IF (IFPRNT(ITER).LE.1) GO TO 120 DO 90 I=1,6 QRADKI(J,I)=SIGN( LOG10( MAX (ABS(QRADKI(J,I)*1.E20),1.D0)), 1QRADKI(J,I)) 90 QRADIK(J,I)=SIGN( LOG10( MAX (ABS(QRADIK(J,I)*1.E20),1.D0)), 1QRADIK(J,I)) DO 95 I=1,8 DO 95 K=1,8 95 QCOLL(I,K)=SIGN( LOG10( MAX (ABS(QCOLL(I,K)*1.E20),1.D0)), 1QCOLL(I,K)) WRITE (6,100) J,(QRADIK(J,I),QRADKI(J,I),I=1,6), 1(QCOLL(I,I),I=1,6),QCOLL(5,8),QCOLL(6,8) 100 FORMAT (1H0I5,12F6.2,6X8F6.2) WRITE (6,110) (QCOLL(1,K),K=2,7),(QCOLL(2,K),K=3,7),(QCOLL(3,K), 1K=4,7),(QCOLL(4,K),K=5,7),(QCOLL(5,K),K=6,7),QCOLL(6,7) 110 FORMAT (6X21F6.2) 120 CONTINUE C 160 WRITE (6,170)(J,RHOX(J),(BHYD(J,I),I=1,6),J=1,NRHOX) 170 FORMAT(1H1/////30X36HSTATISTICAL EQUILIBRIUM FOR HYDROGEN/ 1 15X4HRHOX,10X2HB1,8X2HB2,8X2HB3,8X2HB4,8X2HB5,8X2HB6/ 2(8XI2,1PE11.4,1X0P6F10.4)) C 2(8XI2,0PE11.4,1X0P6F10.4)) C RETURN END SUBROUTINE RADIAP(MODE,RCOWT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ABTOT/ABTOT(kw),ALPHA(kw) COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw) COMMON /PZERO/PZERO,PCON,PRADK0,PTURB0,KNU(kw),PRADK(kw),EDENS(kw) REAL*8 KNU COMMON /RAD/ACCRAD(kw),PRAD(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /TAUSHJ/TAUNU(kw),SNU(kw),HNU(kw),JNU(kw),JMINS(kw) REAL*8 JNU,JMINS DIMENSION H(kw) GO TO (10,20,30),MODE 10 DO 11 J=1,NRHOX H(J)=0. EDENS(J)=0. 11 ACCRAD(J)=0. PRADK0=0. RETURN 20 DO 21 J=1,NRHOX EDENS(J)=EDENS(J)+JNU(J)*RCOWT H(J)=H(J)+HNU(J)*RCOWT 21 ACCRAD(J)=ACCRAD(J)+ABTOT(J)*HNU(J)*RCOWT PRADK0=PRADK0+KNU(1)*RCOWT RETURN 30 DO 31 J=1,NRHOX EDENS(J)=EDENS(J)*12.5664/2.997925E10 ACCRAD(J)=ACCRAD(J)*12.5664/2.997925E10 C FUDGE TO KEEP MODEL FROM BLOWING UP WITH LARGE FLUX ERRORS IF(H(J)/FLUX.GT.1.)ACCRAD(J)=ACCRAD(J)*FLUX/H(J) 31 CONTINUE PRADK0=PRADK0*12.5664/2.997925E10 IF(H(1)/FLUX.GT.1.)PRADK0=PRADK0*FLUX/H(1) C CALL INTEG(RHOX,ACCRAD,PRAD,NRHOX) CALL INTEG(RHOX,ACCRAD,PRAD,NRHOX,ACCRAD(1)*RHOX(1)) DO 32 J=1,NRHOX 32 PRADK(J)=PRAD(J)+PRADK0 RETURN END SUBROUTINE ROSS(MODE,RCOWT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ABROSS/ABROSS(kw),TAUROS(kw) COMMON /ABTOT/ABTOT(kw),ALPHA(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) GO TO(10,20,30),MODE 10 DO 11 J=1,NRHOX 11 ABROSS(J)=0. RETURN 20 DO 21 J=1,NRHOX DBDT=BNU(J)*FREQ*HKT(J)/T(J)/STIM(J) 21 ABROSS(J)=ABROSS(J)+DBDT/ABTOT(J)*RCOWT RETURN 30 DO 31 J=1,NRHOX 31 ABROSS(J)=(4.*5.6697E-5/3.14159)*T(J)**3/ABROSS(J) C RHOX0=RHOX(1) C RHOX(1)=0. C CALL INTEG(RHOX,ABROSS,TAUROS,NRHOX) C RHOX(1)=RHOX0 C TO FIX PROBLEM WITH TEMPERATURE DROP AT FIRST POINT ABROSS(1)=ABROSS(2) CALL INTEG(RHOX,ABROSS,TAUROS,NRHOX,ABROSS(1)*RHOX(1)) TAUROS(1)=0. RETURN END SUBROUTINE DERIV(X,F,DFDX,N) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C ASSUMES THAT ANY ZERO IN X OCCURS AT A ENDPOINT DIMENSION X(1),F(1),DFDX(1) DFDX(1)=(F(2)-F(1))/(X(2)-X(1)) N1=N-1 DFDX(N)=(F(N)-F(N1))/(X(N)-X(N1)) IF(N.EQ.2)RETURN S=ABS(X(2)-X(1))/(X(2)-X(1)) DO 1 J=2,N1 SCALE= MAX (ABS(F(J-1)),ABS(F(J)),ABS(F(J+1)))/ABS(X(J)) IF(SCALE.EQ.0.)SCALE=1. D1=(F(J+1)-F(J))/(X(J+1)-X(J))/SCALE D=(F(J)-F(J-1))/(X(J)-X(J-1))/SCALE TAN1=D1/(S*SQRT(1.+D1**2)+1.) TAN=D/(S*SQRT(1.+D**2)+1.) 1 DFDX(J)=(TAN1+TAN)/(1.-TAN1*TAN)*SCALE RETURN END SUBROUTINE INTEG(X,F,FINT,N,START) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C SUBROUTINE INTEG(X,F,FINT,N) DIMENSION X(1),F(1),FINT(1) DIMENSION A(kw),B(kw),C(kw) CALL PARCOE(F,X,A,B,C,N) FINT(1)=START C FINT(1)=(A(1)+(B(1)/2.+C(1)/3.*X(1))*X(1))*X(1) C FINT(2)=(A(1)+(B(1)/2.+C(1)/3.*X(2))*X(2))*X(2) C IF(N.EQ.2)RETURN N1=N-1 C DO 10 I=2,N1 DO 10 I=1,N1 10 FINT(I+1)=FINT(I)+(A(I)+B(I)/2.*(X(I+1)+X(I))+ 1C(I)/3.*((X(I+1)+X(I))*X(I+1)+X(I)*X(I)))*(X(I+1)-X(I)) RETURN END SUBROUTINE PARCOE(F,X,A,B,C,N) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION F(1),X(1),A(1),B(1),C(1) C(1)=0. B(1)=(F(2)-F(1))/(X(2)-X(1)) A(1)=F(1)-X(1)*B(1) N1=N-1 C(N)=0. B(N)=(F(N)-F(N1))/(X(N)-X(N1)) A(N)=F(N)-X(N)*B(N) IF(N.EQ.2)RETURN DO 1 J=2,N1 J1=J-1 D=(F(J)-F(J1))/(X(J)-X(J1)) C(J)=F(J+1)/((X(J+1)-X(J))*(X(J+1)-X(J1)))-F(J)/((X(J)-X(J1))* 1(X(J+1)-X(J)))+F(J1)/((X(J)-X(J1))*(X(J+1)-X(J1))) B(J)=D-(X(J)+X(J1))*C(J) 1 A(J)=F(J1)-X(J1)*D+X(J)*X(J1)*C(J) C(2)=0. B(2)=(F(3)-F(2))/(X(3)-X(2)) A(2)=F(2)-X(2)*B(2) C(3)=0. B(3)=(F(4)-F(3))/(X(4)-X(3)) A(3)=F(3)-X(3)*B(3) DO 2 J=2,N1 IF(C(J).EQ.0.)GO TO 2 J1=J+1 WT=ABS(C(J1))/(ABS(C(J1))+ABS(C(J))) A(J)=A(J1)+WT*(A(J)-A(J1)) B(J)=B(J1)+WT*(B(J)-B(J1)) C(J)=C(J1)+WT*(C(J)-C(J1)) 2 CONTINUE A(N1)=A(N) B(N1)=B(N) C(N1)=C(N) RETURN END FUNCTION MAP1(XOLD,FOLD,NOLD,XNEW,FNEW,NNEW) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION XOLD(1),FOLD(1),XNEW(1),FNEW(1) L=2 LL=0 DO 50 K=1,NNEW 10 IF(XNEW(K).LT.XOLD(L))GO TO 20 L=L+1 IF(L.GT.NOLD)GO TO 30 GO TO 10 20 IF(L.EQ.LL)GO TO 50 IF(L.EQ.2)GO TO 30 IF(L.EQ.3)GO TO 30 L1=L-1 IF(L.GT.LL+1.OR.L.EQ.3)GO TO 21 IF(L.GT.LL+1.OR.L.EQ.4)GO TO 21 CBAC=CFOR BBAC=BFOR ABAC=AFOR IF(L.EQ.NOLD)GO TO 22 GO TO 25 21 L2=L-2 D=(FOLD(L1)-FOLD(L2))/(XOLD(L1)-XOLD(L2)) CBAC=FOLD(L)/((XOLD(L)-XOLD(L1))*(XOLD(L)-XOLD(L2)))+ 1(FOLD(L2)/(XOLD(L)-XOLD(L2))-FOLD(L1)/(XOLD(L)-XOLD(L1)))/ 2(XOLD(L1)-XOLD(L2)) BBAC=D-(XOLD(L1)+XOLD(L2))*CBAC ABAC=FOLD(L2)-XOLD(L2)*D+XOLD(L1)*XOLD(L2)*CBAC IF(L.LT.NOLD)GO TO 25 22 C=CBAC B=BBAC A=ABAC LL=L GO TO 50 25 D=(FOLD(L)-FOLD(L1))/(XOLD(L)-XOLD(L1)) CFOR=FOLD(L+1)/((XOLD(L+1)-XOLD(L))*(XOLD(L+1)-XOLD(L1)))+ 1(FOLD(L1)/(XOLD(L+1)-XOLD(L1))-FOLD(L)/(XOLD(L+1)-XOLD(L)))/ 2(XOLD(L)-XOLD(L1)) BFOR=D-(XOLD(L)+XOLD(L1))*CFOR AFOR=FOLD(L1)-XOLD(L1)*D+XOLD(L)*XOLD(L1)*CFOR WT=0. IF(ABS(CFOR).NE.0.)WT=ABS(CFOR)/(ABS(CFOR)+ABS(CBAC)) A=AFOR+WT*(ABAC-AFOR) B=BFOR+WT*(BBAC-BFOR) C=CFOR+WT*(CBAC-CFOR) LL=L GO TO 50 30 IF(L.EQ.LL)GO TO 50 L=AMIN0(NOLD,L) C=0. B=(FOLD(L)-FOLD(L-1))/(XOLD(L)-XOLD(L-1)) A=FOLD(L)-XOLD(L)*B LL=L 50 FNEW(K)=A+(B+C*XNEW(K))*XNEW(K) MAP1=LL-1 RETURN END SUBROUTINE SOLVIT(A,N,B,IPIVOT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C SOLVES LINEAR EQUATIONS C A IS A COMPLETELY FILLED N BY N ARRAY WHICH IS DESTROYED. C B IS THE RIGHT SIDE VECTOR OF LENGTH N AND RETURNS AS THE SOLUTION C IPIVOT IS A SCRATCH AREA OF LENGTH N. DIMENSION A(1),B(1),IPIVOT(1) EQUIVALENCE(AMAX,SWAP,PIVOT,T) DO 20 J=1,N 20 IPIVOT(J)=0 DO 550 I=1,N AMAX=0. DO 105 J=1,N IF(IPIVOT(J).EQ.1)GO TO 105 JK=J-N DO 100 K=1,N JK=JK+N IF(IPIVOT(K).EQ.1)GO TO 100 AA=ABS(A(JK)) IF(AMAX.GE.AA)GO TO 100 IROW=J ICOLUM=K AMAX=AA 100 CONTINUE 105 CONTINUE IPIVOT(ICOLUM)=IPIVOT(ICOLUM)+1 IF(IROW.EQ.ICOLUM)GO TO 260 IRL=IROW-N ICL=ICOLUM-N DO 200 L=1,N IRL=IRL+N SWAP=A(IRL) ICL=ICL+N A(IRL)=A(ICL) 200 A(ICL)=SWAP SWAP=B(IROW) B(IROW)=B(ICOLUM) B(ICOLUM)=SWAP 260 ICIC=ICOLUM*N+ICOLUM-N PIVOT=A(ICIC) A(ICIC)=1. ICL=ICOLUM-N DO 350 L=1,N ICL=ICL+N 350 A(ICL)=A(ICL)/PIVOT B(ICOLUM)=B(ICOLUM)/PIVOT L1IC=ICOLUM*N-N DO 550 L1=1,N L1IC=L1IC+1 IF(L1.EQ.ICOLUM)GO TO 550 T=A(L1IC) A(L1IC)=0. L1L=L1-N ICL=ICOLUM-N DO 450 L=1,N L1L=L1L+N ICL=ICL+N 450 A(L1L)=A(L1L)-A(ICL)*T B(L1)=B(L1)-B(ICOLUM)*T 550 CONTINUE RETURN END FUNCTION EXPI(N,X) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C EXPONENTIAL INTEGRAL FOR POSITIVE ARGUMENTS AFTER CODY AND C THACHER, MATH. OF COMP.,22,641(1968) DATA X1/-1.E20/ DATA A0,A1,A2,A3,A4,A5,B0,B1,B2,B3,B4/ 1-44178.5471728217,57721.7247139444,9938.31388962037, 2 1842.11088668000,101.093806161906,5.03416184097568, 3 76537.3323337614,32597.1881290275,6106.10794245759, 4 635.419418378382,37.2298352833327/ DATA C0,C1,C2,C3,C4,C5,C6,D1,D2,D3,D4,D5,D6/ 1 4.65627107975096E-7, 2 .999979577051595,9.04161556946329,24.3784088791317, 3 23.0192559391333,6.90522522784444,.430967839469389, 4 10.0411643829054,32.4264210695138,41.2807841891424, 5 20.4494785013794,3.31909213593302,.103400130404874/ DATA E0,E1,E2,E3,E4,E5,E6,F1,F2,F3,F4,F5,F6/ 1-.999999999998447,-26.6271060431811,-241.055827097015, 2-895.927957772937,-1298.85688746484,-545.374158883133, 3-5.66575206533869, 28.6271060422192, 292.310039388533, 4 1332.78537748257, 2777.61949509163, 2404.01713225909, 5 631.657483280800/ IF(X.EQ.X1)GO TO 40 EX=EXP(-X) X1=X IF(X.GT.4.)GO TO 10 IF(X.GT.1.)GO TO 20 IF(X.GT.0.)GO TO 30 EX1=0. GO TO 40 10 EX1=(EX+EX*(E0+(E1+(E2+(E3+(E4+(E5+E6/X)/X)/X)/X)/X)/X)/ 1 (X+ F1+(F2+(F3+(F4+(F5+F6/X)/X)/X)/X)/X))/X GO TO 40 20 EX1=EX*(C6+(C5+(C4+(C3+(C2+(C1+C0*X)*X)*X)*X)*X)*X)/ 1 (D6+(D5+(D4+(D3+(D2+(D1+X)*X)*X)*X)*X)*X) GO TO 40 30 EX1=(A0+(A1+(A2+(A3+(A4+A5*X)*X)*X)*X)*X)/ 1 (B0+(B1+(B2+(B3+(B4+X)*X)*X)*X)*X)- LOG(X) 40 EXPI=EX1 IF(N.EQ.1)RETURN N1=N-1 DO 41 I=1,N1 41 EXPI=(EX-X*EXPI)/DBLE(I) RETURN END SUBROUTINE W(A,B,N) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION B(1) WRITE(6,100)A,(B(I),I=1,N) 100 FORMAT(1H0,A6,1P10E12.4/(7X,10E12.4)) C 100 FORMAT(1H0,A6,0P10E12.4/(7X,10E12.4)) RETURN END SUBROUTINE READIN(MODE) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C MODE=1 COMPUTE A MODEL C MODE=2 READ A PREVIOUSLY CALCULATED MODEL FOR SOME APPLICATION C MODE=20 SAME AS 2 BUT ON ENCOUNTERING END RETURN WITH NRHOX=0 COMMON /ABROSS/ABROSS(kw),TAUROS(kw) COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BB/BB1(kw,7),XNFPB(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2) COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /BK/BK1(kw,8),XNFPK(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1) COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw), 1 GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH, 2 IFCONV REAL*8 MIXLTH COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw) COMMON /FREE/WORD(6),NUMCOL,LETCOL,LAST,MORE,IFFAIL,MAXPOW COMMON /FRESET/FRESET(500),RCOSET(500),NULO,NUHI,NUMNU,IFWAVE, 1 WBEGIN,DELTAW COMMON /HEIGHT/HEIGHT(kw) COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /ITER/ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /JUNK/TITLE(74),FREQID(6),WLTE,XSCALE COMMON /MUS/ANGLE(20),SURFI(20),NMU COMMON /PZERO/PZERO,PCON,PRADK0,PTURB0,KNU(kw),PRADK(kw),EDENS(kw) REAL*8 KNU COMMON /RAD/ACCRAD(kw),PRAD(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEFF/TEFF,GRAV,GLOG COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB DIMENSION CARD(80) EQUIVALENCE (CARD(1),XABUND(1)),(CARD81,XABUND(81)) DIMENSION RHOXA(kw),DUM1(kw),DUM2(kw),DUM3(kw),DUM4(kw),DUM5(kw) DIMENSION DUM6(kw),DUM7(kw),DUM8(kw),TAUSTD(kw) EQUIVALENCE (DUM1(1),DLTDLP(1)),(DUM2(1),HEATCP(1)) EQUIVALENCE (DUM3(1),DLRDLT(1)),(DUM4(1),VELSND(1)) EQUIVALENCE (DUM5(1),GRDADB(1)),(DUM6(1),HSCALE(1)) EQUIVALENCE (DUM7(1),FLXCNV(1)),(RHOXA(1),VCONV(1),DUM8(1)) EQUIVALENCE (TAUSTD(1),XNATOM(1)) DIMENSION IFB(21) DIMENSION IFOP1(20) C H1,H2PLUS,HMINUS,HRAY,HE1,HE2,HEMINUS,HERAY,COOL,LUKE, C HOT,ELECTRON,H2RAY,HLINES,LINES,LINESCAT,XLINES,XLSCAT,XCONT,XSCAT DATA IFOP1/324,609929997,579591588,429928,11165,11166,564793810, 1 15271257,173061,636997,11527,369467847,16486929,577716835, 2 22965179,849711626,1687220147,1687711471,45152896,45946435/ C END DEPARTURE COEFFICIENTS,H1,HMINUS,HE1,HE2,C1,MG1,AL1,SI1 C C2,AL2,MG2,SI2,CA1,CA2,NA1,O1,B1,FE1,O2,K1 DATA IFB/7367,324,579591588,11165,11166,139,18084,1841,26372, 1 140,1842,18085,26373,4172,4173,19231,583,102,8427,584,435/ DATA WWLTE,WWNLTE/4HLTE ,4HNLTE/ DATA BLANK/1H / EXP10(X)=EXP(X*2.30258509299405E0) CARD81=BLANK LAST=81 MAXPOW=38 98 MORE=0 LETCOL=1 99 READ(5,1) CARD 1 FORMAT(80A1) C (M)ACHINE (I)NDEPENDENT (A)LPHAMERIC (C)ODE C BASE 37 A=1, Z=26, 0=27, 9=36 MIAC=IWORDF(CARD) NUMCOL=LETCOL C TEFF 3 IF(MIAC.EQ.1020133)GO TO 100 C GRAVITY IF(MIAC.EQ.519223721)GO TO 200 C OPACITY IF(MIAC.EQ.1070201044)GO TO 300 C KAPPA IF(MIAC.EQ.20688921)GO TO 400 C ITERATIONS IF(MIAC.EQ.661856797)GO TO 500 C MOLECULES IF(MIAC.EQ.930198669)GO TO 600 C CALCULATE IF(MIAC.EQ.210518764)GO TO 700 C ABUNDANCE IF(MIAC.EQ.74175307)GO TO 800 C PRINT IF(MIAC.EQ.30911189)GO TO 900 C PUNCH IF(MIAC.EQ.31069574)GO TO 1000 C READ IF(MIAC.EQ.918640)GO TO 1100 C LTE IF(MIAC.EQ.17173)GO TO 1200 C NLTE IF(MIAC.EQ.726315)GO TO 1300 C BEGIN IF(MIAC.EQ.4011517)GO TO 1500 C SCATTERING IF(MIAC.EQ.1323236444)GO TO 1600 C END IF(MIAC.EQ.7367)GO TO 1700 C TITLE IF(MIAC.EQ.37966926)GO TO 1800 C CONVECTION IF(MIAC.EQ.236883734)GO TO 1900 C TURBULENCE IF(MIAC.EQ.1427151802)GO TO 2000 C CHANGE RHOX IF(MIAC.EQ.223095242)GO TO 2100 C FREQUENCIES C IF(MIAC.EQ.450075960)GO TO 2200 C SURFACE IF(MIAC.EQ.1357812572)GO TO 2300 C PRESSURE IF(MIAC.EQ.1143518210)GO TO 2400 C CORRECTION IF(MIAC.EQ.237080870)GO TO 2500 C WAVELENGTH IF(MIAC.EQ.1597906832)GO TO 2600 C SCALE MODEL IF(MIAC.EQ.35762836)GO TO 2700 C CALL IF(MIAC.EQ.153784)GO TO 2800 C 9000 WRITE(6,2) CARD 2 FORMAT(21H I DO NOT UNDERSTAND 80A1) CALL EXIT 97 LETCOL=MAX0(LETCOL,NUMCOL) MORE=1 MIAC=IWORDF(CARD) IF(IFFAIL.EQ.1)GO TO 98 MORE=0 GO TO 3 C************ 100 TEFF=FREEFF(CARD) FLUX=5.6697E-5/12.5664*TEFF**4 GO TO 97 C************ 200 GRAV=FREEFF(CARD) IF(GRAV.LT.10.)GRAV=EXP10(GRAV) GLOG= LOG10(GRAV) GO TO 97 C************ 300 MIAC=IWORDF(CARD) C ON IF(MIAC.EQ.569)GO TO 380 C OFF IF(MIAC.EQ.20763)GO TO 390 C IFOP IF(MIAC.EQ.464662)GO TO 370 GO TO 9000 370 NUMCOL=LETCOL DO 371 I=1,20 371 IFOP(I)=FREEFF(CARD) GO TO 98 C ON 380 ISWCH=1 GO TO 391 C OFF 390 ISWCH=0 391 MORE=1 395 MIAC=IWORDF(CARD) IF(IFFAIL.EQ.1)GO TO 97 DO 392 I=1,20 II=I IF(MIAC.EQ.IFOP1(I))GO TO 393 392 CONTINUE GO TO 9000 393 IFOP(II)=ISWCH GO TO 395 C************ 400 GO TO 9000 C************ 500 NUMITS=FREEFF(CARD) DO 501 I=1,15 501 IFPNCH(I)=0 IFPNCH(NUMITS)=1 GO TO 97 C************ 600 MIAC=IWORDF(CARD) C ON IF(MIAC.EQ.569)GO TO 610 C OFF IF(MIAC.EQ.20763)GO TO 620 GO TO 9000 610 IFMOL=1 GO TO 97 620 IFMOL=0 GO TO 97 C************ 700 NRHOX=FREEFF(CARD) TAU1LG=FREEFF(CARD) STEPLG=FREEFF(CARD) DO 701 J=1,NRHOX TAUROS(J)=EXP10(TAU1LG+DBLE(J-1)*STEPLG) 701 T(J)=TEFF*(.75*(.710+TAUROS(J)-.1331*EXP(-3.4488*TAUROS(J))))**.25 702 DO 703 J=1,NRHOX XNE(J)=0. PRADK(J)=2.521E-15* MAX (T(J)**4,TEFF**4/2.) VTURB(J)=0. 703 PTURB(J)=0. PRADK0=PRADK(1) PCON=0. PTURB0=0. PZERO=PRADK0 DO 704 J=1,NRHOX 704 PRAD(J)=PRADK(J)-PRADK0 CALL TTAUP(T,TAUROS,ABROSS,PTOTAL,P,PRAD,PTURB,GRAV,NRHOX) DO 705 J=1,NRHOX RHOX(J)=PTOTAL(J)/GRAV 705 PTOTAL(J)=PTOTAL(J)+PZERO GO TO 97 C************ 800 MIAC=IWORDF(CARD) C SCALE IF(MIAC.EQ.35762836)GO TO 810 C CHANGE IF(MIAC.EQ.223095242)GO TO 820 GO TO 9000 810 NUMCOL=LETCOL XSCALE=FREEFF(CARD) GO TO 97 820 MORE=1 821 IZ=FREEFF(CARD) IF(IFFAIL.EQ.1)GO TO 98 ABUND(IZ)=FREEFF(CARD) GO TO 821 C************ 900 DO 901 I=1,NUMITS 901 IFPRNT(I)=FREEFF(CARD) GO TO 97 C************ 1000 DO 1001 I=1,NUMITS 1001 IFPNCH(I)=FREEFF(CARD) GO TO 97 C************ 1100 MIAC=IWORDF(CARD) NUMCOL=LETCOL C FREQUENCIES IF(MIAC.EQ.450075960)GO TO 1110 C DEPARTURE COEFFICIENTS IF(MIAC.EQ.287559136)GO TO 1120 C STARTING T-TAU IF(MIAC.EQ.1355094447)GO TO 1130 C DECK IF(MIAC.EQ.209579)GO TO 1140 C DECK6 IF(MIAC.EQ.7754456)GO TO 1140 GO TO 9000 C FREQUENCIES 1110 NUM=FREEFF(CARD) NULO=FREEFF(CARD) NUHI=FREEFF(CARD) NUMNU=NUM LETCOL=NUMCOL NDUMMY=IWORDF(CARD) DO 1111 I=1,6 1111 FREQID(I)=WORD(I) NUMCOL=LETCOL DO 1112 I=1,NUMNU NU=FREEFR(CARD) FRESET(NU)=FREEFF(CARD) C PROVISION FOR READING WAVELENGTHS IF(FRESET(NU).LT.1.E7)FRESET(NU)=2.997925E17/FRESET(NU) C PROVISION FOR READING WAVENUMBERS SCALED BY 1.E25 IF(FRESET(NU).GT.1.E20)FRESET(NU)=FRESET(NU)*(2.997925E10/1.E25) 1112 RCOSET(NU)=FREEFF(CARD) GO TO 98 C DEPARTURE COEFFICIENTS 1120 NLTEON=1 WLTE=WWNLTE GO TO 1150 1130 NRHOX=FREEFF(CARD) DO 1131 J=1,NRHOX NUMCOL=1 READ(5,1)CARD TAUROS(J)=FREEFF(CARD) 1131 T(J)=FREEFF(CARD) IF(TAUROS(1).GT.0.)GO TO 702 DO 1132 J=1,NRHOX 1132 TAUROS(J)=EXP10(TAUROS(J)) GO TO 702 1140 NRHOX=FREEFF(CARD) DO 1141 J=1,NRHOX NUMCOL=1 READ(5,1)CARD RHOX(J)=FREEFF(CARD) T(J)=FREEFF(CARD) MORE=1 P(J)=FREEFF(CARD) XNE(J)=FREEFF(CARD) ABROSS(J)=FREEFF(CARD) PRAD(J)=FREEFF(CARD) VTURB(J)=FREEFF(CARD) 1141 MORE=0 IF(RHOX(1).GE.0.)GO TO 1143 DO 1142 J=1,NRHOX 1142 RHOX(J)=EXP10(RHOX(J)) 1143 PRADK0=0. PTURB0=PTURB(1) PCON=0. PZER0=PCON+PRADK0+PTURB0 IF(MIAC.NE.7754456)GO TO 98 READ(5,1)CARD NUMCOL=1 PRADK0=FREEFF(CARD) DO 1144 J=1,NRHOX 1144 ACCRAD(J)=PRAD(J) CALL INTEG(RHOX,ACCRAD,PRAD,NRHOX,ACCRAD(1)*RHOX(1)) DO 1145 J=1,NRHOX 1145 PRADK(J)=PRAD(J)+PRADK0 GO TO 98 1150 CONTINUE 1151 READ(5,1)CARD MORE=0 LETCOL=1 MIAC=IWORDF(CARD) NUMCOL=LETCOL LEVEL=FREEFF(CARD) NB=FREEFF(CARD) DO 1152 I=1,21 IF(MIAC.EQ.IFB(I))GO TO 1153 1152 CONTINUE GO TO 9000 1153 GO TO (1170,1154,1156,1158,1160,1162,1164,1166,1168,3170,3172, 1 3174,3176,3178,3180,3182,3184,3186,3200,3206,3218),I 1154 DO 1155 J=1,NB 1155 BHYD(J,LEVEL)=FREEFR(CARD) GO TO 1151 1156 DO 1157 J=1,NB 1157 BMIN(J)=FREEFR(CARD) GO TO 1151 1158 DO 1159 J=1,NB 1159 BHE1(J,LEVEL)=FREEFR(CARD) GO TO 1151 1160 DO 1161 J=1,NB 1161 BHE2(J,LEVEL)=FREEFR(CARD) GO TO 1151 1162 DO 1163 J=1,NB 1163 BC1(J,LEVEL)=FREEFR(CARD) GO TO 1151 1164 DO 1165 J=1,NB 1165 BMG1(J,LEVEL)=FREEFR(CARD) GO TO 1151 1166 DO 1167 J=1,NB 1167 BAL1(J,LEVEL)=FREEFR(CARD) GO TO 1151 1168 DO 1169 J=1,NB 1169 BSI1(J,LEVEL)=FREEFR(CARD) GO TO 1151 3170 DO 3171 J=1,NB 3171 BC 2(J,LEVEL)=FREEFR(CARD) GO TO 1151 3172 DO 3173 J=1,NB 3173 BAL2(J,LEVEL)=FREEFR(CARD) GO TO 1151 3174 DO 3175 J=1,NB 3175 BMG2(J,LEVEL)=FREEFR(CARD) GO TO 1151 3176 DO 3177 J=1,NB 3177 BSI2(J,LEVEL)=FREEFR(CARD) GO TO 1151 3178 DO 3179 J=1,NB 3179 BCA1(J,LEVEL)=FREEFR(CARD) GO TO 1151 3180 DO 3181 J=1,NB 3181 BCA2(J,LEVEL)=FREEFR(CARD) GO TO 1151 3182 DO 3183 J=1,NB 3183 BNA1(J,LEVEL)=FREEFR(CARD) GO TO 1151 3184 DO 3185 J=1,NB 3185 BO 1(J,LEVEL)=FREEFR(CARD) GO TO 1151 3186 DO 3187 J=1,NB 3187 BB 1(J,LEVEL)=FREEFR(CARD) GO TO 1151 3200 DO 3201 J=1,NB 3201 BFE1(J,LEVEL)=FREEFR(CARD) GO TO 1151 3206 DO 3207 J=1,NB 3207 BO 2(J,LEVEL)=FREEFR(CARD) GO TO 1151 3218 DO 3219 J=1,NB 3219 BK 1(J,LEVEL)=FREEFR(CARD) GO TO 1151 1170 DO 2180 J=1,NRHOX DO 2171 I=1,29 2171 BHE1(J,I)=BHE1(J,I)*BHE2(J,1) DO 2172 I=1,14 2172 BC 1(J,I)=BC 1(J,I)*BC 2(J,1) DO 2173 I=1,11 2173 BMG1(J,I)=BMG1(J,I)*BMG2(J,1) DO 2174 I=1,9 2174 BAL1(J,I)=BAL1(J,I)*BAL2(J,1) DO 2175 I=1,11 2175 BSI1(J,I)=BSI1(J,I)*BSI2(J,1) DO 2176 I=1,8 2176 BCA1(J,I)=BCA1(J,I)*BCA2(J,1) 2180 CONTINUE WRITE(6,1171) 1171 FORMAT(1H1,9X,14HBHYD......BMIN) WRITE(6,1172)(I,I=1,8) 1172 FORMAT(1X,10I12) DO 1174 J=1,NRHOX 1174 WRITE(6,1173)J,(BHYD(J,I),I=1,8),BMIN(J) 1173 FORMAT(I3,1P10E12.4) C1173 FORMAT(I3,1P10E12.4) WRITE(6,1175) 1175 FORMAT(1H1,9X,4HBHE1) WRITE(6,1172)(I,I=1,10) DO 1176 J=1,NRHOX 1176 WRITE(6,1173)J,(BHE1(J,I),I=1,10) WRITE(6,1175) WRITE(6,1172)(I,I=11,20) DO 1177 J=1,NRHOX 1177 WRITE(6,1173)J,(BHE1(J,I),I=11,20) WRITE(6,1175) WRITE(6,1172)(I,I=21,29) DO 1178 J=1,NRHOX 1178 WRITE(6,1173)J,(BHE1(J,I),I=21,29) WRITE(6,1179) 1179 FORMAT(1H1,9X,4HBHE2) WRITE(6,1172)(I,I=1,6) DO 1180 J=1,NRHOX 1180 WRITE(6,1173)J,(BHE2(J,I),I=1,6) WRITE(6,1181) 1181 FORMAT(1H1,9X,3HBC1) WRITE(6,1172)(I,I=1,10) DO 1182 J=1,NRHOX 1182 WRITE(6,1173)J,(BC1(J,I),I=1,10) WRITE(6,1181) WRITE(6,1172)(I,I=11,14) DO 1183 J=1,NRHOX 1183 WRITE(6,1173)J,(BC1(J,I),I=11,14) WRITE(6,1192) 1192 FORMAT(1H1,9X,3HBC2) WRITE(6,1172)(I,I=1,6) DO 1193 J=1,NRHOX 1193 WRITE(6,1173)J,(BC2(J,I),I=1,6) WRITE(6,1184) 1184 FORMAT(1H1,9X,4HBMG1) WRITE(6,1172)(I,I=1,10) DO 1185 J=1,NRHOX 1185 WRITE(6,1173)J,(BMG1(J,I),I=1,10) WRITE(6,1184) WRITE(6,1172)(I,I=11,11) DO 1191 J=1,NRHOX 1191 WRITE(6,1173)J,(BMG1(J,I),I=11,11) WRITE(6,1194) 1194 FORMAT(1H1,9X,4HBMG2) WRITE(6,1172)(I,I=1,6) DO 1195 J=1,NRHOX 1195 WRITE(6,1173)J,(BMG2(J,I),I=1,6) WRITE(6,1186) 1186 FORMAT(1H1,9X,4HBAL1) WRITE(6,1172)(I,I=1,9) DO 1187 J=1,NRHOX 1187 WRITE(6,1173)J,(BAL1(J,I),I=1,9) WRITE(6,1196) 1196 FORMAT(1H1,9X,4HBAL2) WRITE(6,1172)(I,I=1,1) DO 1197 J=1,NRHOX 1197 WRITE(6,1173)J,(BAL2(J,I),I=1,1) WRITE(6,1188) 1188 FORMAT(1H1,9X,4HBSI1) WRITE(6,1172)(I,I=1,10) DO 1189 J=1,NRHOX 1189 WRITE(6,1173)J,(BSI1(J,I),I=1,10) WRITE(6,1188) WRITE(6,1172)(I,I=11,11) DO 1190 J=1,NRHOX 1190 WRITE(6,1173)J,(BSI1(J,I),I=11,11) WRITE(6,1198) 1198 FORMAT(1H1,9X,4HBSI2) WRITE(6,1172)(I,I=1,10) DO 1199 J=1,NRHOX 1199 WRITE(6,1173)J,(BSI2(J,I),I=1,10) WRITE(6,3188) 3188 FORMAT(1H1,9X,4HBCA1) WRITE(6,1172)(I,I=1,8) DO 3189 J=1,NRHOX 3189 WRITE(6,1173)J,(BCA1(J,I),I=1,8) WRITE(6,3190) 3190 FORMAT(1H1,9X,4HBCA2) WRITE(6,1172)(I,I=1,5) DO 3191 J=1,NRHOX 3191 WRITE(6,1173)J,(BCA2(J,I),I=1,5) WRITE(6,3192) 3192 FORMAT(1H1,9X,4HBNA1) WRITE(6,1172)(I,I=1,8) DO 3193 J=1,NRHOX 3193 WRITE(6,1173)J,(BNA1(J,I),I=1,8) WRITE(6,3194) 3194 FORMAT(1H1,9X,4HBO1 ) WRITE(6,1172)(I,I=1,10) DO 3195 J=1,NRHOX 3195 WRITE(6,1173)J,(BO1(J,I),I=1,10) WRITE(6,3194) WRITE(6,1172)(I,I=11,13) DO 3196 J=1,NRHOX 3196 WRITE(6,1173)J,(BO1(J,I),I=11,13) WRITE(6,3197) 3197 FORMAT(1H1,9X,4HBB1 ) WRITE(6,1172)(I,I=1,7) DO 3198 J=1,NRHOX 3198 WRITE(6,1173)J,(BB1(J,I),I=1,7) WRITE(6,3202) 3202 FORMAT(1H1,9X,4HBFE1) WRITE(6,1172)(I,I=1,10) DO 3203 J=1,NRHOX 3203 WRITE(6,1173)J,(BFE1(J,I),I=1,10) WRITE(6,3202) WRITE(6,1172)(I,I=11,15) DO 3204 J=1,NRHOX 3204 WRITE(6,1173)J,(BFE1(J,I),I=11,15) WRITE(6,3208) 3208 FORMAT(1H1,9X,4HBO2 ) WRITE(6,1172)(I,I=1,4) DO 3209 J=1,NRHOX 3209 WRITE(6,1173)J,(BO2(J,I),I=1,4) WRITE(6,3210) 3210 FORMAT(1H1,9X,4HBK 1) WRITE(6,1172)(I,I=1,8) DO 3211 J=1,NRHOX 3211 WRITE(6,1173)J,(BK 1(J,I),I=1,8) GO TO 98 C************ 1200 NLTEON=0 WLTE=WWLTE DO 1202 J=1,40 DO 1201 I=1,6 1201 BHYD(J,I)=1. 1202 BMIN(J)=1. GO TO 97 C************ 1300 NLTEON=1 WLTE=WWNLTE GO TO 97 C************ 1500 IF(MODE.NE.1)GO TO 1510 IF(NUMITS.EQ.0)WRITE(6,1501) IF(NRHOX.EQ.0)WRITE(6,1502) IF(NUMNU.EQ.0)WRITE(6,1503) IF(TEFF.EQ.0.)WRITE(6,1504) IF(GRAV.EQ.0.)WRITE(6,1505) 1501 FORMAT(20H HOW MANY ITERATIONS) 1502 FORMAT(14H HOW MANY RHOX) 1503 FORMAT(21H HOW MANY FREQUENCIES) 1504 FORMAT(10H WHAT TEFF) 1505 FORMAT(13H WHAT GRAVITY) IF(NUMITS.EQ.0)CALL EXIT IF(NRHOX.EQ.0)CALL EXIT IF(NUMNU.EQ.0)CALL EXIT IF(TEFF.EQ.0.)CALL EXIT IF(GRAV.EQ.0.)CALL EXIT 1510 CONTINUE IF(ABUND(1).LT.0.)ABUND(1)=EXP10(ABUND(1)) IF(ABUND(2).LT.0.)ABUND(2)=EXP10(ABUND(2)) DO 1511 IZ=3,99 IF(ABUND(IZ).GT.0.)ABUND(IZ)= LOG10(ABUND(IZ)) 1511 CONTINUE WRITE(6,1512)TEFF,GLOG,WLTE,TITLE,XSCALE, 1(ELEM(IZ),ABUND(IZ),IZ=1,99) 1512 FORMAT(1H1/////5H TEFF,F7.0,8H LOG G,F8.4,3X,A4/ 17H0TITLE ,74A1/7H0XSCALE,F10.6,2(3X,A2,F8.5)/(10(1X,A2,F6.2))) C1512 FORMAT(1H1/////5H TEFFF7.0,8H LOG GF6.2,3XA4/ C 17H0TITLE ,74A1/7H0XSCALEF8.3,2(3X,A2,F6.3)/(10(1XA2,F6.2))) DO 1513 IZ=3,99 1513 XABUND(IZ)=EXP10(ABUND(IZ))*XSCALE XABUND(1)=ABUND(1) XABUND(2)=ABUND(2) WTMOLE=0. DO 1514 IZ=1,99 1514 WTMOLE=WTMOLE+XABUND(IZ)*ATMASS(IZ) DO 1516 J=1,NRHOX TK(J)=1.38054E-16*T(J) HKT(J)=6.6256E-27/TK(J) HCKT(J)=HKT(J)*2.997925E10 TKEV(J)=8.6171E-5*T(J) TLOG(J)= LOG(T(J)) XNATOM(J)=P(J)/TK(J)-XNE(J) RHO(J)=XNATOM(J)*WTMOLE*1.660E-24 1516 PTURB(J)=.5*RHO(J)*VTURB(J)**2 WRITE(6,1517)IFOP 1517 FORMAT(3H0H1I2,7H H2PLUSI2,7H HMINUSI2,5H HRAYI2,4H HE1I2, 1 4H HE2I2,8H HEMINUSI2,6H HERAYI2,5H COOLI2,5H LUKEI2/ 2 4H HOTI2,9H ELECTRONI2,6H H2RAYI2,7H HLINESI2,6H LINESI2, 3 9H LINESCATI2,7H XLINESI2,7H XLSCATI2,6H XCONTI2,6H XSCATI2) WRITE(6,1518)IFCORR,IFPRES,IFSURF,IFSCAT,IFCONV,MIXLTH,IFMOL, 1IFTURB,TRBFDG,TRBPOW,TRBSND,TRBCON 1518 FORMAT(7H0IFCORRI2,8H IFPRESI2,8H IFSURFI2,8H IFSCATI2, 1 8H IFCONVI2,8H MIXLTHF6.2,7H IFMOLI2/7H IFTURBI2, 2 8H TRBFDGF6.2,8H TRBPOWF6.2,8H TRBSNDF6.2,8H TRBCONF6.2) IF(MODE.NE.1)GO TO 1575 WRITE(6,1521)NUMITS,IFPRNT,IFPNCH 1521 FORMAT(7H NUMITSI3,8H IFPRNT15I2,8H IFPNCH15I2) IF(IFWAVE.EQ.0)GO TO 1560 WRITE(6,1536)WBEGIN,DELTAW,NUMNU 1536 FORMAT(7H0WBEGINF11.4,9H DELTAWF7.4,8H NUMNUI5) GO TO 1575 1560 WRITE(6,1561)FREQID,NUMNU,NULO,NUHI 1561 FORMAT(8H0FREQID 6A1,8H NUMNUI4,7H NULOI4,7H NUHII4) NN=(NUMNU+3)/4 NNN=NUMNU-NN*3 IF(NNN.LT.1)NN=1 IF(NNN.LT.1)NNN=1 WRITE(6,1563)((NU,FRESET(NU),RCOSET(NU),NU=I,NUMNU,NN),I=1,NNN) 1563 FORMAT((4(3XI3,1P2E13.6))) C1563 FORMAT((4(3XI3,0P2E13.6))) IF(NN.EQ.NNN)GO TO 1575 NNN=NNN+1 WRITE(6,1564)((NU,FRESET(NU),RCOSET(NU),NU=I,NUMNU,NN),I=NNN,NN) 1564 FORMAT((3(3XI3,1P2E13.6))) C1564 FORMAT((3(3XI3,0P2E13.6))) C 1575 CONTINUE WRITE(6,1576)(J,RHOX(J),T(J),P(J),XNE(J),ABROSS(J),PRAD(J), 1VTURB(J),(BHYD(J,I),I=1,6),BMIN(J),J=1,NRHOX) 1576 FORMAT(1H1/////8X4HRHOX,9X1HT,8X1HP,8X3HXNE,6X6HABROSS,5X4HPRAD, 1 6X5HVTURB,24X4HBHYD,25X4HBMIN/ C 2(I3,0PE13.6,0PF9.1,0P5E10.3,1X0P7F8.4)) 2(I3,1PE13.6,0PF9.1,1P5E10.3,1X0P7F8.4)) C RETURN C************ 1600 MIAC=IWORDF(CARD) C ON IF(MIAC.EQ.569)GO TO 1610 C OFF IF(MIAC.EQ.20763)GO TO 1620 GO TO 9000 1610 IFSCAT=1 GO TO 97 1620 IFSCAT=0 GO TO 97 C************ 1700 IF(MODE.NE.20)CALL EXIT NRHOX=0 RETURN C************ 1800 DO 1801 I=1,74 1801 TITLE(I)=CARD(I+6) GO TO 98 C************ 1900 MIAC=IWORDF(CARD) C ON IF(MIAC.EQ.569)GO TO 1910 C OFF IF(MIAC.EQ.20763)GO TO 1920 GO TO 9000 1910 IFCONV=1 NUMCOL=LETCOL MIXLTH=FREEFF(CARD) GO TO 97 1920 IFCONV=0 MIXLTH=1. DO 1921 J=1,NRHOX DLTDLP(J)=0. HEATCP(J)=0. DLRDLT(J)=0. VELSND(J)=0. GRDADB(J)=0. HSCALE(J)=0. FLXCNV(J)=0. 1921 VCONV(J)=0. GO TO 97 C************ 2000 MIAC=IWORDF(CARD) C ON IF(MIAC.EQ.569)GO TO 2010 C OFF IF(MIAC.EQ.20763)GO TO 2020 GO TO 9000 2010 IFTURB=1 NUMCOL=LETCOL TRBFDG=FREEFF(CARD) TRBPOW=FREEFF(CARD) TRBSND=FREEFF(CARD) TRBCON=FREEFF(CARD) GO TO 97 2020 IFTURB=0 TRBFDG=0. TRBPOW=0. TRBSND=0. TRBCON=0. GO TO 97 C************ 2100 NNEW=FREEFF(CARD) DO 2101 J=1,NNEW 2101 RHOXA(J)=FREEFR(CARD) IDUM=MAP1(RHOX,T,NRHOX,RHOXA,DUM1,NNEW) IDUM=MAP1(RHOX,P,NRHOX,RHOXA,DUM2,NNEW) IDUM=MAP1(RHOX,XNE,NRHOX,RHOXA,DUM3,NNEW) IDUM=MAP1(RHOX,ABROSS,NRHOX,RHOXA,DUM4,NNEW) IDUM=MAP1(RHOX,VTURB,NRHOX,RHOXA,DUM5,NNEW) IDUM=MAP1(RHOX,PRAD,NRHOX,RHOXA,DUM6,NNEW) IDUM=MAP1(RHOX,BMIN,NRHOX,RHOXA,DUM7,NNEW) DO 2102 J=1,NNEW T(J)=DUM1(J) P(J)=DUM2(J) XNE(J)=DUM3(J) ABROSS(J)=DUM4(J) VTURB(J)=DUM5(J) PRAD(J)=DUM6(J) PRADK(J)=PRAD(J)+PRADK0 2102 BMIN(J)=DUM7(J) DO 2105 I=1,6 IDUM=MAP1(RHOX,BHYD(1,I),NRHOX,RHOXA,DUM1,NNEW) DO 2104 J=1,NNEW 2104 BHYD(J,I)=DUM1(J) 2105 CONTINUE NRHOX=NNEW DO 2106 J=1,NRHOX 2106 RHOX(J)=RHOXA(J) GO TO 97 C************ 2300 MIAC=IWORDF(CARD) C INTENSITY IF(MIAC.EQ.651354309)GO TO 2310 C FLUX IF(MIAC.EQ.321147)GO TO 2320 C OFF IF(MIAC.EQ.20763)GO TO 2330 GO TO 9000 2310 NMU=FREEFF(CARD) DO 2311 MU=1,NMU 2311 ANGLE(MU)=FREEFF(CARD) IFSURF=2 GO TO 97 2320 IFSURF=1 NMU=1 GO TO 97 2330 IFSURF=0 NMU=1 GO TO 97 C************ 2400 MIAC=IWORDF(CARD) C ON IF(MIAC.EQ.569)GO TO 2410 C OFF IF(MIAC.EQ.20763)GO TO 2420 GO TO 9000 2410 IFPRES=1 GO TO 97 2420 IFPRES=0 GO TO 97 C************ 2500 MIAC=IWORDF(CARD) C ON IF(MIAC.EQ.569)GO TO 2510 C OFF IF(MIAC.EQ.20763)GO TO 2520 GO TO 9000 2510 IFCORR=1 GO TO 97 2520 IFCORR=0 DO 2521 J=1,40 FLXERR(J)=0. 2521 FLXDRV(J)=0. GO TO 97 C************ 2600 WBEGIN=FREEFF(CARD) DELTAW=FREEFF(CARD) WEND=FREEFF(CARD) IFWAVE=1 NULO=1 NUHI= INT((WEND-WBEGIN)/ABS(DELTAW)+.5)+1 NUMNU=NUHI IF(WBEGIN.LT.1.E7)GO TO 97 IF(WBEGIN.GT.1.E20)GO TO 2610 C FREQUENCY STEPS WBEGIN=2.997925E17/WBEGIN DELTAW=2.997925E17/DELTAW WEND=2.997925E17/WEND GO TO 97 C WAVENUMBER STEPS SCALE BY 1.E25 2610 WBEGIN=1.E7/(WBEGIN/1.E25) DELTAW=1.E7/(DELTAW/1.E25) WEND=1.E7/(WEND/1.E25) GO TO 97 C************ C SCALING MODELS OR CHANGING RHOX SPACING TO BE UNIFORM IN TAUROS 2700 NRHOX=FREEFF(CARD) TAU1LG=FREEFF(CARD) STEPLG=FREEFF(CARD) MORE=1 TEFF1=FREEFF(CARD) GNEW=FREEFF(CARD) IF(GNEW.LT.10.)GNEW=EXP10(GNEW) MORE=0 DO 2701 J=1,NRHOX 2701 TAUSTD(J)=EXP10(TAU1LG+DBLE(J-1)*STEPLG) C CALL INTEG(RHOX,ABROSS,TAUROS,NRHOX) CALL INTEG(RHOX,ABROSS,TAUROS,NRHOX,ABROSS(1)*RHOX(1)) TAUROS(1)=0. IDUM=MAP1(TAUROS,RHOX,NRHOX,TAUSTD,DUM1,NRHOX) IDUM=MAP1(TAUROS,T,NRHOX,TAUSTD,DUM2,NRHOX) IDUM=MAP1(TAUROS,P,NRHOX,TAUSTD,DUM3,NRHOX) IDUM=MAP1(TAUROS,XNE,NRHOX,TAUSTD,DUM4,NRHOX) IDUM=MAP1(TAUROS,ABROSS,NRHOX,TAUSTD,DUM5,NRHOX) IDUM=MAP1(TAUROS,PRAD,NRHOX,TAUSTD,DUM6,NRHOX) IDUM=MAP1(TAUROS,VTURB,NRHOX,TAUSTD,DUM7,NRHOX) IDUM=MAP1(TAUROS,BMIN,NRHOX,TAUSTD,DUM8,NRHOX) DO 2702 J=1,NRHOX RHOX(J)=DUM1(J) T(J)=DUM2(J) P(J)=DUM3(J) XNE(J)=DUM4(J) ABROSS(J)=DUM5(J) PRAD(J)=DUM6(J) PRADK(J)=PRAD(J)+PRADK0 VTURB(J)=DUM7(J) 2702 BMIN(J)=DUM8(J) DO 2704 I=1,6 IDUM=MAP1(TAUROS,BHYD(1,I),NRHOX,TAUSTD,DUM1,NRHOX) DO 2703 J=1,NRHOX 2703 BHYD(J,I)=DUM1(J) 2704 CONTINUE IF(TEFF1.EQ.0.)GO TO 97 IF(TEFF1.EQ.TEFF.AND.GNEW.EQ.GRAV)GO TO 97 DO 2710 J=1,NRHOX TAUROS(J)=TAUSTD(J) T(J)=T(J)*TEFF1/TEFF PTURB(J)=0. PRADK(J)=PRADK(J)*(TEFF1/TEFF)**4 2710 PRAD(J)=PRAD(J)*(TEFF1/TEFF)**4 PRADK0=PRADK0*(TEFF1/TEFF)**4 PZERO=PCON+PRADK0+PTURB0 TEFF=TEFF1 FLUX=5.6697E-5/12.5664*TEFF**4 GRAV=GNEW GLOG= LOG10(GRAV) CALL TTAUP(T,TAUROS,ABROSS,PTOTAL,P,PRAD,PTURB,GRAV,NRHOX) DO 2711 J=1,NRHOX RHOX(J)=PTOTAL(J)/GRAV 2711 PTOTAL(J)=PTOTAL(J)+PZERO C2711 RHOX(J)=PTOTAL(J)/GRAV GO TO 97 C************ 2800 CALL DUMMYR GO TO 97 C************ END SUBROUTINE DUMMYR IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C DUMMY INPUT ROUTINE FOR MODIFYING READIN RETURN END FUNCTION FREEFR(CARD) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREE/WORD(6),NUMCOL,LETCOL,LAST,MORE,IFFAIL,MAXPOW DIMENSION CARD(1) MORE=1 FREEFR=FREEFF(CARD) IF(IFFAIL.EQ.0)RETURN L=LAST-1 READ(5,1)(CARD(I),I=1,L) 1 FORMAT(80A1) NUMCOL=1 FREEFR=FREEFF(CARD) RETURN END FUNCTION FREEFF(CARD) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREE/WORD(6),NUMCOL,LETCOL,LAST,MORE,IFFAIL,MAXPOW DIMENSION CARD(1) DIMENSION A(10) DATA A/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/ DATA QPT/1H./,QCM/1H,/,QMI/1H-/,QE/1HE/,QPL/1H+/,QBL/1H / IFFAIL=0 IF(NUMCOL.GT.LAST)GO TO 3002 ANSWER=0. ASIGN=1. ISIGN=1 NPT=0 IF0=0 N=0 ASSIGN 100 TO NSWCH DO 1000 NCOL=NUMCOL,LAST C=CARD(NCOL) GO TO NSWCH,(100,200,300,400) 100 IF(C.EQ.QBL)GO TO 104 DO 101 I=1,10 IF(C.EQ.A(I))GO TO 102 101 CONTINUE IF(C.EQ.QPT)GO TO 103 IF(C.EQ.QCM)GO TO 104 IF(C.EQ.QMI)GO TO 105 999 ASIGN=1. ANSWER=0. NPT=0 IF0=0 N=0 ASSIGN 100 TO NSWCH GO TO 1000 102 N=N+1 ANSWER=10.D0*ANSWER+DBLE(I-1) GO TO 1000 103 ASSIGN 200 TO NSWCH GO TO 1000 104 IF(N.EQ.0)GO TO 999 FREEFF=ANSWER*ASIGN GO TO 998 105 IF(N.EQ.0)GO TO 106 GO TO 999 106 ASIGN=-1. GO TO 1000 200 DO 201 I=1,10 IF(C.EQ.A(I))GO TO 202 201 CONTINUE IF(C.EQ.QE )GO TO 203 IF(C.EQ.QMI)GO TO 304 IF(C.EQ.QPL)GO TO 303 IF(C.EQ.QBL)GO TO 204 IF(C.EQ.QCM)GO TO 204 GO TO 999 202 N=N+1 NPT=NPT+1 ANSWER=10.D0*ANSWER+DBLE(I-1) GO TO 1000 203 ASSIGN 300 TO NSWCH GO TO 1000 204 IF(N.EQ.0)GO TO 999 FREEFF=ANSWER*ASIGN/10.D0**NPT GO TO 998 300 DO 301 I=1,10 IF(C.EQ.A(I))GO TO 302 301 CONTINUE IF(C.EQ.QBL)GO TO 303 IF(C.EQ.QMI)GO TO 304 IF(C.EQ.QPL)GO TO 303 GO TO 999 302 NPOWER=I-1 IF0=1 310 ASSIGN 400 TO NSWCH GO TO 1000 303 NPOWER=0 GO TO 310 304 ISIGN=-1 NPOWER=0 GO TO 310 400 DO 401 I=1,10 IF(C.EQ.A(I))GO TO 402 401 CONTINUE IF(C.EQ.QCM)GO TO 403 IF(C.EQ.QBL)GO TO 403 GO TO 999 402 NPOWER=10*NPOWER+I-1 IF0=1 IF(NPOWER.GE.MAXPOW)GO TO 999 GO TO 1000 403 IF(IF0.EQ.0)GO TO 999 FREEFF=ANSWER*ASIGN*10.D0**(ISIGN*NPOWER-NPT) GO TO 998 1000 CONTINUE NUMCOL=LAST+1 3002 IFFAIL=1 IF(MORE.GT.0)GO TO 3000 WRITE(6,3001)(CARD(I),I=1,LAST) 3001 FORMAT(28H1FREEFF HAS READ OFF THE END/(1X80A1)) CALL EXIT 3000 FREEFF=0. RETURN 998 NUMCOL=NCOL+1 RETURN END FUNCTION IWORDF(CARD) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREE/WORD(6),NUMCOL,LETCOL,LAST,MORE,IFFAIL,MAXPOW DIMENSION CARD(1) DIMENSION A(36) EQUIVALENCE (QE,A(5)) DATA A/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,1HM,1HN, 11HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX,1HY,1HZ,1H0,1H1,1H2,1H3, 21H4,1H5,1H6,1H7,1H8,1H9/ DATA QPT/1H./,QCM/1H,/,QEQ/1H=/,QBL/1H / DO 1 I=1,6 1 WORD(I)=QBL IFFAIL=0 IF(LETCOL.GT.LAST)GO TO 4002 N=0 C (M)ACHINE (I)NDEPENDENT (A)LPHAMERIC (C)ODE MIAC=0 ASSIGN 500 TO NSWCH DO 2000 NCOL=LETCOL,LAST C=CARD(NCOL) GO TO NSWCH,(500,600) 500 IF(C.EQ.QBL)GO TO 1999 DO 501 II=1,26 IF(C.EQ.A(II))GO TO 502 501 CONTINUE 1999 MIAC=0 N=0 ASSIGN 500 TO NSWCH GO TO 2000 502 IF(C.NE.QE )GO TO 506 IF(NCOL.EQ.1)GO TO 506 C=CARD(NCOL-1) DO 503 I=27,36 IF(C.EQ.A(I))GO TO 504 503 CONTINUE IF(C.NE.QPT)GO TO 506 504 C=CARD(NCOL+1) DO 505 I=27,36 IF(C.EQ.A(I))GO TO 1999 505 CONTINUE IF(C.EQ.QBL)GO TO 1999 506 N=N+1 MIAC=II WORD(1)=A(II) ASSIGN 600 TO NSWCH GO TO 2000 600 IF(C.EQ.QBL)GO TO 603 IF(C.EQ.QEQ)GO TO 603 IF(C.EQ.QCM)GO TO 603 DO 601 II=1,36 IF(C.EQ.A(II))GO TO 602 601 CONTINUE GO TO 1999 602 N=N+1 IF(N.GT.6)GO TO 604 MIAC=37*MIAC+II WORD(N)=A(II) 604 GO TO 2000 603 IWORDF=MIAC GO TO 998 2000 CONTINUE LETCOL=LAST+1 4002 IFFAIL=1 IF(MORE.GT.0)GO TO 4000 WRITE(6,4001)(CARD(I),I=1,LAST) 4001 FORMAT(28H1IWORDF HAS READ OFF THE END/(1X80A1)) CALL EXIT 4000 IWORDF=0 RETURN 998 LETCOL=NCOL+1 RETURN END SUBROUTINE TTAUP(T,TAU,ABSTD,PTOTAL,P,PRAD,PTURB,GRAV,NUMTAU) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C ROSSELAND OPACITY FOR KITT PEAK GRID 1X 2KM/S DISTRIBUTION FNS C TAUS MUST HAVE LOG SPACING C ASSUMES PTOTAL=PRAD=PTURB=0 WHEN RHOX=0 DIMENSION T(1),TAU(1),ABSTD(1),PTOTAL(1),P(1),PRAD(1),PTURB(1) DIMENSION TABT(36),TABP(30) DIMENSION TABKAP(36,30),KTAB(36,30),PKAP(30) EQUIVALENCE (TABKAP(1),KTAB(1)) DIMENSION KTAB01(36),KTAB02(36),KTAB03(36),KTAB04(36) DIMENSION KTAB05(36),KTAB06(36),KTAB07(36),KTAB08(36) DIMENSION KTAB09(36),KTAB10(36),KTAB11(36),KTAB12(36) DIMENSION KTAB13(36),KTAB14(36),KTAB15(36),KTAB16(36) DIMENSION KTAB17(36),KTAB18(36),KTAB19(36),KTAB20(36) DIMENSION KTAB21(36),KTAB22(36),KTAB23(36),KTAB24(36) DIMENSION KTAB25(36),KTAB26(36),KTAB27(36),KTAB28(36) DIMENSION KTAB29(36),KTAB30(36) EQUIVALENCE (KTAB(001),KTAB01(1)),(KTAB(037),KTAB02(1)) EQUIVALENCE (KTAB(073),KTAB03(1)),(KTAB(109),KTAB04(1)) EQUIVALENCE (KTAB(145),KTAB05(1)),(KTAB(181),KTAB06(1)) EQUIVALENCE (KTAB(217),KTAB07(1)),(KTAB(253),KTAB08(1)) EQUIVALENCE (KTAB(289),KTAB09(1)),(KTAB(325),KTAB10(1)) EQUIVALENCE (KTAB(361),KTAB11(1)),(KTAB(397),KTAB12(1)) EQUIVALENCE (KTAB(433),KTAB13(1)),(KTAB(469),KTAB14(1)) EQUIVALENCE (KTAB(505),KTAB15(1)),(KTAB(541),KTAB16(1)) EQUIVALENCE (KTAB(577),KTAB17(1)),(KTAB(613),KTAB18(1)) EQUIVALENCE (KTAB(649),KTAB19(1)),(KTAB(685),KTAB20(1)) EQUIVALENCE (KTAB(721),KTAB21(1)),(KTAB(757),KTAB22(1)) EQUIVALENCE (KTAB(793),KTAB23(1)),(KTAB(829),KTAB24(1)) EQUIVALENCE (KTAB(865),KTAB25(1)),(KTAB(901),KTAB26(1)) EQUIVALENCE (KTAB(937),KTAB27(1)),(KTAB(973),KTAB28(1)) EQUIVALENCE (KTAB(1009),KTAB29(1)),(KTAB(1045),KTAB30(1)) DATA NT,NP/36,30/ DATA TABT/ 3.500, 3.525, 3.550, 3.575, 3.600, 3.625, 3.650, 1 3.675, 3.700, 3.725, 3.750, 3.775, 3.800, 3.825, 3.850, 3.875, 2 3.900, 3.925, 3.950, 3.975, 4.000, 4.050, 4.100, 4.150, 4.200, 3 4.250, 4.300, 4.350, 4.400, 4.450, 4.500, 4.600, 4.700, 4.800, 4 4.900, 5.000/ DATA TABP/ -2.000,-1.500,-1.000, -.500, 0.000, .500, 1.000, 1 1.250, 1.500, 1.750, 2.000, 2.250, 2.500, 2.750, 3.000, 3.200, 2 3.400, 3.600, 3.800, 4.000, 4.200, 4.400, 4.600, 4.800, 5.000, 3 5.200, 5.400, 5.600, 5.800, 6.000/ DATA KTAB01/ -2.000 1-4254,-4220,-4147,-3936,-3601,-3206,-2787,-2361,-1944,-1540, -2.000 2-1161, -838, -632, -553, -533, -532, -537, -542, -545, -541, -2.000 3 -525, -500, -489, -488, -493, -489, -481, -455, -451, -449, -2.000 4 -445, -428, -403, -405, -410, -437/ -2.000 DATA KTAB02/ -1.500 1-4257,-4220,-4175,-4039,-3758,-3394,-2995,-2584,-2173,-1772, -1.500 2-1386,-1030, -744, -583, -528, -517, -521, -528, -535, -538, -1.500 3 -531, -500, -486, -479, -486, -486, -479, -459, -446, -447, -1.500 4 -443, -428, -403, -404, -409, -436/ -1.500 DATA KTAB03/ -1.000 1-4264,-4214,-4179,-4100,-3889,-3565,-3190,-2795,-2395,-1997, -1.000 2-1609,-1238, -903, -654, -530, -494, -493, -502, -514, -522, -1.000 3 -525, -499, -481, -470, -475, -479, -475, -462, -442, -443, -1.000 4 -441, -426, -403, -403, -408, -434/ -1.000 DATA KTAB04/ -.500 1-4273,-4199,-4163,-4117,-3980,-3709,-3364,-2988,-2601,-2211, -.500 2-1823,-1444,-1083, -770, -554, -460, -441, -450, -469, -487, -.500 3 -501, -494, -474, -459, -459, -468, -467, -461, -439, -437, -.500 4 -437, -425, -404, -402, -407, -433/ -.500 DATA KTAB05/ 0.000 1-4267,-4164,-4116,-4086,-4012,-3809,-3503,-3151,-2781,-2401, 0.000 2-2017,-1633,-1257, -906, -612, -427, -360, -358, -381, -411, 0.000 3 -440, -468, -455, -445, -440, -449, -454, -452, -437, -429, 0.000 4 -432, -423, -404, -401, -406, -431/ 0.000 DATA KTAB06/ .500 1-4230,-4090,-4017,-3990,-3958,-3833,-3579,-3257,-2908,-2543, .500 2-2168,-1786,-1402,-1027, -682, -408, -254, -210, -228, -269, .500 3 -316, -393, -412, -414, -411, -420, -431, -434, -429, -417, .500 4 -422, -420, -403, -399, -405, -429/ .500 DATA KTAB07/ 1.000 1-4153,-3968,-3855,-3808,-3795,-3741,-3558,-3274,-2947,-2603, 1.000 2-2245,-1873,-1491,-1106, -732, -398, -148, -20, -3, -43, 1.000 3 -103, -233, -312, -344, -361, -377, -395, -403, -406, -398, 1.000 4 -406, -415, -402, -397, -403, -426/ 1.000 DATA KTAB08/ 1.250 1-4096,-3888,-3753,-3687,-3672,-3643,-3502,-3241,-2927,-2593, 1.250 2-2245,-1882,-1507,-1122, -743, -389, -100, 78, 132, 103, 1.250 3 40, -114, -231, -286, -320, -344, -369, -381, -387, -385, 1.250 4 -392, -410, -400, -396, -401, -424/ 1.250 DATA KTAB09/ 1.500 1-4023,-3797,-3637,-3550,-3525,-3512,-3412,-3180,-2880,-2557, 1.500 2-2218,-1867,-1500,-1122, -741, -375, -56, 171, 272, 267, 1.500 3 207, 31, -123, -208, -263, -298, -334, -355, -363, -365, 1.500 4 -373, -402, -398, -394, -400, -423/ 1.500 DATA KTAB10/ 1.750 1-3934,-3692,-3510,-3400,-3359,-3352,-3289,-3093,-2810,-2497, 1.750 2-2168,-1828,-1473,-1103, -726, -354, -14, 252, 405, 437, 1.750 3 390, 202, 13, -106, -186, -237, -288, -321, -333, -339, 1.750 4 -347, -391, -395, -392, -399, -421/ 1.750 DATA KTAB11/ 2.000 1-3828,-3576,-3372,-3241,-3180,-3169,-3136,-2980,-2719,-2417, 2.000 2-2098,-1768,-1425,-1067, -697, -325, 24, 322, 524, 603, 2.000 3 583, 397, 178, 19, -87, -162, -228, -275, -296, -305, 2.000 4 -313, -375, -390, -389, -397, -419/ 2.000 DATA KTAB12/ 2.250 1-3706,-3450,-3229,-3076,-2994,-2972,-2958,-2845,-2611,-2321, 2.250 2-2012,-1693,-1361,-1016, -657, -290, 64, 383, 626, 757, 2.250 3 774, 607, 366, 168, 33, -68, -149, -215, -249, -264, 2.250 4 -272, -349, -382, -386, -395, -417/ 2.250 DATA KTAB13/ 2.500 1-3569,-3315,-3082,-2909,-2806,-2768,-2761,-2688,-2487,-2214, 2.500 2-1915,-1605,-1285, -951, -604, -246, 107, 437, 711, 890, 2.500 3 955, 825, 573, 340, 175, 47, -52, -138, -189, -214, 2.500 4 -222, -312, -368, -381, -392, -415/ 2.500 DATA KTAB14/ 2.750 1-3418,-3172,-2933,-2742,-2619,-2563,-2553,-2512,-2349,-2097, 2.750 2-1809,-1507,-1198, -877, -542, -195, 153, 488, 783, 999, 2.750 3 1113, 1043, 794, 536, 340, 185, 66, -42, -115, -152, 2.750 4 -164, -261, -348, -374, -388, -412/ 2.750 DATA KTAB15/ 3.000 1-3256,-3024,-2783,-2578,-2435,-2360,-2339,-2319,-2197,-1971, 3.000 2-1697,-1402,-1104, -794, -471, -136, 203, 537, 843, 1088, 3.000 3 1248, 1255, 1024, 751, 529, 349, 204, 77, -19, -74, 3.000 4 -95, -193, -317, -363, -384, -408/ 3.000 DATA KTAB16/ 3.200 1-3120,-2900,-2662,-2449,-2290,-2200,-2168,-2155,-2066,-1865, 3.200 2-1601,-1314,-1024, -722, -408, -85, 247, 577, 887, 1148, 3.200 3 1338, 1416, 1209, 931, 691, 496, 331, 189, 75, 3, 3.200 4 -30, -123, -281, -350, -378, -405/ 3.200 DATA KTAB17/ 3.400 1-2979,-2773,-2540,-2321,-2149,-2044,-1999,-1987,-1926,-1753, 3.400 2-1502,-1224, -942, -645, -342, -29, 293, 619, 928, 1201, 3.400 3 1414, 1564, 1394, 1117, 860, 652, 472, 317, 186, 94, 3.400 4 46, -41, -233, -331, -371, -400/ 3.400 DATA KTAB18/ 3.600 1-2834,-2641,-2417,-2195,-2012,-1892,-1833,-1817,-1778,-1634, 3.600 2-1398,-1131, -857, -566, -272, 30, 344, 662, 969, 1248, 3.600 3 1480, 1697, 1575, 1305, 1035, 817, 624, 459, 312, 202, 3.600 4 136, 53, -172, -304, -361, -395/ 3.600 DATA KTAB19/ 3.800 1-2687,-2506,-2291,-2070,-1879,-1745,-1671,-1647,-1622,-1505, 3.800 2-1291,-1036, -769, -484, -200, 92, 398, 707, 1010, 1292, 3.800 3 1537, 1811, 1748, 1497, 1222, 993, 790, 613, 452, 324, 3.800 4 242, 159, -96, -269, -347, -388/ 3.800 DATA KTAB20/ 4.000 1-2539,-2367,-2163,-1945,-1749,-1601,-1513,-1477,-1457,-1369, 4.000 2-1180, -938, -677, -400, -125, 158, 456, 755, 1052, 1334, 4.000 3 1586, 1909, 1912, 1689, 1414, 1178, 971, 784, 613, 469, 4.000 4 367, 277, -5, -223, -327, -378/ 4.000 DATA KTAB21/ 4.200 1-2390,-2225,-2033,-1821,-1621,-1462,-1358,-1309,-1289,-1226, 4.200 2-1064, -838, -582, -314, -48, 228, 516, 805, 1096, 1375, 4.200 3 1631, 1992, 2063, 1878, 1609, 1366, 1157, 964, 787, 632, 4.200 4 515, 407, 104, -164, -302, -365/ 4.200 DATA KTAB22/ 4.400 1-2241,-2081,-1900,-1696,-1495,-1327,-1208,-1146,-1120,-1076, 4.400 2 -942, -732, -484, -226, 31, 302, 580, 859, 1141, 1417, 4.400 3 1673, 2063, 2198, 2061, 1805, 1556, 1345, 1149, 969, 808, 4.400 4 677, 548, 234, -86, -266, -348/ 4.400 DATA KTAB23/ 4.600 1-2094,-1935,-1763,-1569,-1371,-1195,-1063, -986, -953, -920, 4.600 2 -815, -620, -384, -136, 113, 377, 646, 914, 1189, 1459, 4.600 3 1714, 2124, 2317, 2236, 1999, 1747, 1534, 1338, 1157, 992, 4.600 4 852, 697, 381, 7, -217, -325/ 4.600 DATA KTAB24/ 4.800 1-1947,-1789,-1625,-1441,-1247,-1067, -923, -832, -788, -761, 4.800 2 -679, -504, -282, -44, 199, 456, 715, 973, 1240, 1503, 4.800 3 1754, 2177, 2417, 2397, 2192, 1943, 1726, 1529, 1350, 1182, 4.800 4 1035, 855, 543, 117, -156, -295/ 4.800 DATA KTAB25/ 5.000 1-1803,-1643,-1484,-1311,-1122, -940, -787, -682, -627, -599, 5.000 2 -535, -383, -176, 49, 287, 536, 786, 1034, 1293, 1550, 5.000 3 1795, 2225, 2500, 2544, 2381, 2143, 1926, 1732, 1551, 1381, 5.000 4 1227, 1023, 718, 244, -82, -256/ 5.000 DATA KTAB26/ 5.200 1-1660,-1498,-1343,-1178, -997, -815, -655, -539, -473, -438, 5.200 2 -385, -257, -67, 146, 377, 619, 860, 1098, 1349, 1598, 5.200 3 1838, 2267, 2571, 2675, 2563, 2343, 2126, 1935, 1756, 1586, 5.200 4 1431, 1203, 904, 387, 6, -206/ 5.200 DATA KTAB27/ 5.400 1-1521,-1354,-1200,-1044, -870, -690, -527, -404, -324, -278, 5.400 2 -232, -125, 45, 246, 470, 705, 936, 1166, 1409, 1649, 5.400 3 1882, 2307, 2632, 2789, 2734, 2540, 2325, 2137, 1961, 1793, 5.400 4 1639, 1393, 1101, 550, 115, -145/ 5.400 DATA KTAB28/ 5.600 1-1383,-1212,-1058, -907, -742, -566, -405, -273, -180, -122, 5.600 2 -76, 12, 161, 348, 566, 792, 1013, 1236, 1471, 1704, 5.600 3 1928, 2346, 2686, 2888, 2891, 2733, 2525, 2338, 2165, 2001, 5.600 4 1848, 1589, 1302, 727, 245, -66/ 5.600 DATA KTAB29/ 5.800 1-1250,-1073, -916, -769, -611, -443, -284, -146, -40, 29, 5.800 2 79, 154, 278, 454, 663, 882, 1092, 1308, 1536, 1761, 5.800 3 1975, 2386, 2735, 2973, 3034, 2918, 2723, 2537, 2369, 2208, 5.800 4 2058, 1789, 1503, 913, 393, 30/ 5.800 DATA KTAB30/ 6.000 1-1119, -936, -776, -629, -478, -319, -164, -21, 94, 177, 6.000 2 235, 292, 398, 563, 764, 973, 1174, 1384, 1604, 1821, 6.000 3 2024, 2427, 2781, 3047, 3159, 3092, 2918, 2734, 2570, 2415, 6.000 4 2267, 1993, 1704, 1107, 557, 145/ 6.000 DATA ISTART/0/ EXP10(X)=EXP(X*2.30258509299405E0) IF(ISTART.EQ.1)GO TO 19 ISTART=1 DO 13 IP=1,NP DO 13 IT=1,NT 13 TABKAP(IT,IP)=DBLE(KTAB(IT,IP))/1000. 19 DLGTAU= LOG(TAU(2)/TAU(1)) PLOG3=0. PLOG2=0. PLOG1=0. DPLOG2=0. DPLOG1=0. C ASSUME CONSTANT OPACITY NEAR SURFACE. FIRST GUESS=.1 ABSTD(1)=.1 IF(PRAD(1).GT.0.)ABSTD(1)=MIN(.1D0,GRAV*TAU(1)/PRAD(1)/2.) C TO FIX PROBLEM WITH TEMPERATURE DROP AT FIRST POINT T1=T(1) T(1)=T(2) DO 22 J=1,NUMTAU DO 24 IP=1,NP IDUM=MAP1(TABT,TABKAP(1,IP),NT, LOG10(T(J)),PKAP(IP),1) 24 CONTINUE IF(J.EQ.1)PLOG= LOG(GRAV/ABSTD(1)*TAU(1)) IF(J.GT.1.AND.J.LE.4)PLOG=PLOG1+DPLOG1 IF(J.GT.4)PLOG=(3.*PLOG4+8.*DPLOG1-4.*DPLOG2+8.*DPLOG3)/3. ERROR=1. N=1 GO TO 21 20 IF(J.EQ.1)PNEW= LOG(GRAV/ABSTD(1)*TAU(1)) IF(J.GT.1.AND.J.LE.4)PNEW=(PLOG+2.*PLOG1+DPLOG+DPLOG1)/3. IF(J.GT.4)PNEW=(126.*PLOG1-14.*PLOG3+9.*PLOG4+42.*DPLOG+ 1 108.*DPLOG1-54.*DPLOG2+24.*DPLOG3)/121. ERROR=ABS(PNEW-PLOG) PLOG=(PNEW+PLOG)/2. 21 PTOTAL(J)=EXP(PLOG) C P(J)=PTOTAL(J)-PRAD(J)-PTURB(J) P(J)=PTOTAL(J)+(PRAD(1)-PRAD(J))-PTURB(J) IF(P(J).LE.0.)GO TO 25 IDUM=MAP1(TABP,PKAP,NP, LOG10(P(J)),ABSTD(J),1) ABSTD(J)=EXP10(ABSTD(J)) DPLOG=GRAV/ABSTD(J)*TAU(J)/PTOTAL(J)*DLGTAU N=N+1 IF(N.GT.1000)GO TO 25 IF(ERROR.GT..00005)GO TO 20 PLOG4=PLOG3 PLOG3=PLOG2 PLOG2=PLOG1 PLOG1=PLOG DPLOG3=DPLOG2 DPLOG2=DPLOG1 DPLOG1=DPLOG 22 CONTINUE T(1)=T1 RETURN 25 CONTINUE CALL W(6HJ ,DBLE(J),1) CALL W(6HP ,P,J) CALL W(6HPTOTAL,PTOTAL,J) CALL W(6HPRAD ,PRAD,J) CALL W(6HPTURB ,PTURB,J) CALL W(6HABSTD ,ABSTD,J) CALL W(6HERROR ,ERROR,1) CALL EXIT END SUBROUTINE BLOCKE IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99) C Grevesse,N. and Anders, E. 1988. presented at the workshop C on the "Solar Interior and Atmosphere", Tucson, Nov 15-18. C Anders, E. and Grevesse, N. 1989 Geochimica et Cosmochimica Acta, C vol. 53, pp. 197-214. C H has been defined to be -.04 instead of 12 C 1H 2HE DATA ABUND/ 0.911,0.089, C 3LI 4BE 5B 6C 7N 8O 9F 10NE 1-10.88,-10.89, -9.44, -3.48, -3.99, -3.11, -7.48, -3.95, C 11NA 12MG 13AL 14SI 15P 16S 17CL 18AR 2 -5.71, -4.46, -5.57, -4.49, -6.59, -4.83, -6.54, -5.48, C 19K 20CA 21SC 22TI 23V 24CR 25MN 26FE 3 -6.92, -5.68, -8.94, -7.05, -8.04, -6.37, -6.65, -4.37, C 27CO 28NI 29CU 30ZN 31GA 33GE 33AS 34SE 4 -7.12, -5.79, -7.83, -7.44, -9.16, -8.63, -9.67, -8.69, C 35BR 36KR 37RB 38SR 39Y 40ZR 41NB 42MO 5 -9.41, -8.81, -9.44, -9.14, -9.80, -9.44,-10.62,-10.12, C 43TC 44RU 45RH 46PD 47AG 48CD 49IN 50SN 6-20.00,-10.20,-10.92,-10.35,-11.10,-10.18,-10.38,-10.04, C 51SB 52TE 53I 54XE 55CS 56BA 57LA 58CE 7-11.04, -9.80,-10.53, -9.81,-10.92, -9.91,-10.82,-10.49, C 59PR 60ND 61PM 62SM 63EU 64GD 65TB 66DY 8-11.33,-10.54,-20.00,-11.04,-11.53,-10.92,-12.14,-10.94, C 67HO 68ER 69TM 70YB 71LU 72HF 73TA 74W 9-11.78,-11.11,-12.04,-10.96,-11.28,-11.16,-11.91,-10.93, C 75RE 76OS 77IR 78PT 79AU 80HG 81TL 82PB T-11.77,-10.59,-10.69,-10.24,-11.03,-10.95,-11.14,-10.19, C 83BI 84PO 85AT 86RN 87FR 88RA 89AC 90TH 1-11.33,-20.00,-20.00,-20.00,-20.00,-20.00,-20.00,-11.92, C 91PA 92U 93NP 94PU 95AM 96CM 97BK 98CF 99ES 2-20.00,-12.51,-20.00,-20.00,-20.00,-20.00,-20.00,-20.00,-20.00/ DATA ATMASS/ 1.008,4.003, 1 6.939,9.013,10.81,12.01,14.01,16.00,19.00,20.18,22.99,24.31, 2 26.98,28.09,30.98,32.07,35.45,39.95,39.10,40.08,44.96,47.90, 3 50.94,52.00,54.94,55.85,58.94,58.71,63.55,65.37,69.72,72.60, 4 74.92,78.96,79.91,83.80,85.48,87.63,88.91,91.22,92.91,95.95, 5 99.00,101.1,102.9,106.4,107.9,112.4,114.8,118.7,121.8,127.6, 6 126.9,131.3,132.9,137.4,138.9,140.1,140.9,144.3,147.0,150.4, 7 152.0,157.3,158.9,162.5,164.9,167.3,168.9,173.0,175.0,178.5, 8 181.0,183.9,186.3,190.2,192.2,195.1,197.0,200.6,204.4,207.2, 9 209.0,210.0,211.0,222.0,223.0,226.1,227.1,232.0,231.0,238.0, T 237.0,244.0,243.0,247.0,247.0,251.0,254.0/ DATA ELEM/ 2HH , 2HHE, 1 2HLI, 2HBE, 2HB , 2HC , 2HN , 2HO , 2HF , 2HNE, 2HNA, 2HMG, 2 2HAL, 2HSI, 2HP , 2HS , 2HCL, 2HAR, 2HK , 2HCA, 2HSC, 2HTI, 3 2HV , 2HCR, 2HMN, 2HFE, 2HCO, 2HNI, 2HCU, 2HZN, 2HGA, 2HGE, 4 2HAS, 2HSE, 2HBR, 2HKR, 2HRB, 2HSR, 2HY , 2HZR, 2HNB, 2HMO, 5 2HTC, 2HRU, 2HRH, 2HPD, 2HAG, 2HCD, 2HIN, 2HSN, 2HSB, 2HTE, 6 2HI , 2HXE, 2HCS, 2HBA, 2HLA, 2HCE, 2HPR, 2HND, 2HPM, 2HSM, 7 2HEU, 2HGD, 2HTB, 2HDY, 2HHO, 2HER, 2HTM, 2HYB, 2HLU, 2HHF, 8 2HTA, 2HW , 2HRE, 2HOS, 2HIR, 2HPT, 2HAU, 2HHG, 2HTL, 2HPB, 9 2HBI, 2HPO, 2HAT, 2HRN, 2HFR, 2HRA, 2HAC, 2HTH, 2HPA, 2HU , T 2HNP, 2HPU, 2HAM, 2HCM, 2HBK, 2HCF, 2HES/ RETURN END SUBROUTINE BLOCKR IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BB/BB1(kw,7),XNFPB(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2) COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /BK/BK1(kw,8),XNFPK(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1) COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw), 1 GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH, 2 IFCONV REAL*8 MIXLTH COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw) COMMON /FRESET/FRESET(500),RCOSET(500),NULO,NUHI,NUMNU,IFWAVE, 1 WBEGIN,DELTAW COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /ITER/ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /JUNK/TITLE(74),FREQID(6),WLTE,XSCALE COMMON /MUS/ANGLE(20),SURFI(20),NMU COMMON /RAD/ACCRAD(kw),PRAD(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /TEFF/TEFF,GRAV,GLOG COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB DATA BAL1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BAL2/kw*1./ DATA BB1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BC1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 1 kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BC2/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BCA1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BCA2/kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BFE1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 1 kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BHE1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 1 kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 2 kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BHE2/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BHYD/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BMIN/kw*1./ DATA XNFPH/kw*0.,kw*0./ DATA XNFPHE/kw*0.,kw*0.,kw*0./ DATA BK1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BMG1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 1 kw*1.,kw*1./ DATA BMG2/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BNA1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1./ DATA BO1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 1 kw*1.,kw*1.,kw*1.,kw*1./ DATA BO2/kw*1.,kw*1.,kw*1.,kw*1./ DATA BSI1/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 1 kw*1.,kw*1./ DATA BSI2/kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1.,kw*1., 1 kw*1./ DATA DLTDLP,HEATCP,DLRDLT,VELSND,GRDADB,HSCALE,FLXCNV,VCONV/ 1 kw*0.,kw*0.,kw*0.,kw*0.,kw*0.,kw*0.,kw*0.,kw*0./ DATA IFCONV,MIXLTH/0,1./ DATA FLUX/0./ DATA FLXERR,FLXDRV/kw*0.,kw*0./ DATA NUMNU/0/ DATA IFWAVE/0/ DATA IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL/1,1,0,1,0/ DATA NLTEON/0/ DATA IFOP/1,1,1,1,1,1,0,0,1,0,0,1,0,0,0,0,0,0,0,0/ DATA IFPRNT/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ DATA IFPNCH/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ DATA NUMITS/0/ DATA TITLE/74*1H / DATA WLTE/4HLTE / DATA XSCALE/1./ DATA SURFI/20*0./,NMU/1/ DATA ACCRAD/kw*0./,PRAD/kw*0./ DATA NRHOX/0/ DATA TEFF/0./ DATA GRAV/0./ DATA VTURB/kw*0./ DATA PTURB/kw*0./ DATA IFTURB,TRBFDG,TRBPOW,TRBSND,TRBCON/0,0.,0.,0.,0./ END SUBROUTINE POPS(CODE,MODE,NUMBER) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION NUMBER(kw,1) REAL*8 NUMBER COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DATA ITEMP1/0/ IF(IFMOL.EQ.1)GO TO 200 IF(IFPRES.EQ.1.AND.ITEMP.NE.ITEMP1)CALL NELECT ITEMP1=ITEMP IF(CODE.EQ.0.)RETURN IF(CODE.LT.1.D2)GO TO 110 WRITE(6,106) 106 FORMAT(14H1MOLECULES OFF) CALL EXIT 110 IZ=CODE NION=(CODE-DBLE(IZ))*100.+1.5 DO 115 J=1,NRHOX CALL PFSAHA(J,IZ,NION,MODE,NUMBER) C PFSAHA RETURNS IONIZATION FRACTIONS OR IONIZATION FRACTIONS/ C PARTITION FUNCTIONS SO CONVERT TO NUMBER DENSITIES NNNN=NION IF(MODE.LT.10)NNNN=1 DO 115 ION=1,NNNN 115 NUMBER(J,ION)=NUMBER(J,ION)*XNATOM(J)*XABUND(IZ) RETURN 200 IF(IFPRES.EQ.1.AND.ITEMP.NE.ITEMP1)CALL NMOLEC(MODE) ITEMP1=ITEMP IF(CODE.EQ.0.)RETURN CALL MOLEC(CODE,MODE,NUMBER) RETURN END SUBROUTINE NELECT IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /ITER/ ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION ELEC(kw),E(10),X(10),MASK(10),NELEMZ(10),NIONZ(10) DATA NELEMZ/1,2,6,11,12,13,14,19,20,26/ DATA NIONZ/1,2,2,2,2,2,2,2,2,2/,NZ/10/ IF(ITER.LT.NUMITS)GO TO 406 DO 401 I=1,NZ NELEM=NELEMZ(I) 401 E(I)=ELEM(NELEM) WRITE(6,402)(E(I),I=1,NZ),(E(I),I=1,NZ) 402 FORMAT(1H1////50X22HELECTRON CONTRIBUTIONS/2X,20(4X,A2)) 406 XNE(1)=P(1)/TK(1)/2. DO 500 J=1,NRHOX IF(J.GT.1)XNE(J)=XNE(J-1)*P(J)/P(J-1) XNTOT=P(J)/TK(J) XNATOM(J)=XNTOT-XNE(J) DO 1 I=1,NZ 1 MASK(I)=1 DO 20 L=1,200 XNENEW=0. DO 11 I=1,NZ IF(MASK(I).EQ.0)GO TO 11 IZ=NELEMZ(I) NION=NIONZ(I) CALL PFSAHA(J,IZ,NION,4,ELEC) E(I)=ELEC(J) X(I)=ELEC(J)*XNATOM(J)*XABUND(IZ) XNENEW=XNENEW+X(I) 11 CONTINUE XNENEW=(XNENEW+XNE(J))/2. ERROR=ABS((XNE(J)-XNENEW)/XNENEW) XNE(J)=XNENEW XNATOM(J)=XNTOT-XNE(J) IF(ERROR.LT..0005)GO TO 400 IF(J.EQ.1)GO TO 20 X1=.00001*XNE(J) IF(ERROR.LT..05)X1=X1*10. DO 12 I=1,NZ IF(X(I).LT.X1)MASK(I)=0 12 CONTINUE 20 CONTINUE WRITE(6,250) 250 FORMAT(22H XNE DOES NOT CONVERGE) CALL EXIT 400 RHO(J)=XNATOM(J)*WTMOLE*1.660E-24 IF(ITER.LT.NUMITS)GO TO 500 DO 403 I=1,NZ 403 X(I)=X(I)/XNE(J) WRITE(6,404)J,(X(I),I=1,NZ),(E(I),I=1,NZ) 404 FORMAT(I3,20F6.3) 500 CONTINUE RETURN END SUBROUTINE PFSAHA(J,IZ,NION,MODE,ANSWER) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C MODE 1 RETURNS IONIZATION FRACTION /PARTITION FUNCTION C MODE 2 RETURNS IONIZATION FRACTION C MODE 3 RETURNS PARTITION FUNCTION C MODE 4 RETURNS NUMBER OF ELECTRONS PRODUCED C MODE + 10 RETURN ALL IONS TO NION. MODE ALONE RETURN NION ONLY. COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BB/BB1(kw,7),XNFPB(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /BK/BK1(kw,8),XNFPK(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1) COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION ANSWER(kw,6),F(6),IP(6),PART(6),POTLO(6),LOCZ(29) DIMENSION FSAVE(6) REAL*8 IP DIMENSION SCALE(4) DIMENSION EHYD(6),EHE1(29),EHE2(6),EC1(14),EMG1(11),EAL1(9), 1ESI1(11),EC2(6),EMG2(6),EAL2(1),ESI2(6),ECA1(8),ECA2(5),ENA1(8), 2EO1(13),EB1(7),EK1(8) DIMENSION GHYD(6),GHE1(29),GHE2(6),GC1(14),GMG1(11),GAL1(9), 1GSI1(11),GC2(6),GMG2(6),GAL2(1),GSI2(6),GCA1(8),GCA2(5),GNA1(8), 2GO1(13),GB1(7),GK1(8) DIMENSION NNN(6,365) DIMENSION NNN01(54),NNN02(54),NNN03(54),NNN04(54),NNN05(54) DIMENSION NNN06(54),NNN07(54),NNN08(54),NNN09(54),NNN10(54) DIMENSION NNN11(54),NNN12(54),NNN13(54),NNN14(54),NNN15(54) DIMENSION NNN16(54),NNN17(54),NNN18(54),NNN19(54),NNN20(54) DIMENSION NNN21(54),NNN22(54),NNN23(54),NNN24(54),NNN25(54) DIMENSION NNN26(54),NNN27(54),NNN28(54),NNN29(54),NNN30(54) DIMENSION NNN31(54),NNN32(54),NNN33(54),NNN34(54),NNN35(54) DIMENSION NNN36(54),NNN37(54),NNN38(54),NNN39(54),NNN40(12) EQUIVALENCE (NNN( 1),NNN01(1)),(NNN( 55),NNN02(1)) EQUIVALENCE (NNN( 109),NNN03(1)),(NNN( 163),NNN04(1)) EQUIVALENCE (NNN( 217),NNN05(1)),(NNN( 271),NNN06(1)) EQUIVALENCE (NNN( 325),NNN07(1)),(NNN( 379),NNN08(1)) EQUIVALENCE (NNN( 433),NNN09(1)),(NNN( 487),NNN10(1)) EQUIVALENCE (NNN( 541),NNN11(1)),(NNN( 595),NNN12(1)) EQUIVALENCE (NNN( 649),NNN13(1)),(NNN( 703),NNN14(1)) EQUIVALENCE (NNN( 757),NNN15(1)),(NNN( 811),NNN16(1)) EQUIVALENCE (NNN( 865),NNN17(1)),(NNN( 919),NNN18(1)) EQUIVALENCE (NNN( 973),NNN19(1)),(NNN(1027),NNN20(1)) EQUIVALENCE (NNN(1081),NNN21(1)),(NNN(1135),NNN22(1)) EQUIVALENCE (NNN(1189),NNN23(1)),(NNN(1243),NNN24(1)) EQUIVALENCE (NNN(1297),NNN25(1)),(NNN(1351),NNN26(1)) EQUIVALENCE (NNN(1405),NNN27(1)),(NNN(1459),NNN28(1)) EQUIVALENCE (NNN(1513),NNN29(1)),(NNN(1567),NNN30(1)) EQUIVALENCE (NNN(1621),NNN31(1)),(NNN(1675),NNN32(1)) EQUIVALENCE (NNN(1729),NNN33(1)),(NNN(1783),NNN34(1)) EQUIVALENCE (NNN(1837),NNN35(1)),(NNN(1891),NNN36(1)) EQUIVALENCE (NNN(1945),NNN37(1)),(NNN(1999),NNN38(1)) EQUIVALENCE (NNN(2053),NNN39(1)),(NNN(2107),NNN40(1)) DIMENSION NNN67(72) EQUIVALENCE (NNN(2119),NNN67(1)) C ( 1)( 2) ( 3)( 4) ( 5)( 6) ( 7)( 8) ( 9)(10) ( IP ) G REF DATA NNN01/ 1 200020001, 200020011, 201620881, 231228281, 378953411, 1359502, D+F 1.00 2 100010001, 100010001, 100010001, 100010001, 100010001, 1359500, G 1.01 3 100010001, 100010011, 102111241, 145022061, 363059451, 2458104, D+F 2.00 4 200020001, 200020071, 208524971, 382669341, 128222452, 5440302, D+F 2.01 5 100010001, 100010001, 100010001, 100010001, 100010001, 5440300, G 2.02 6 200020011, 201220481, 212922881, 258731081, 394251691, 538901, D+F 3.00 7 100010001, 100010201, 126225521, 67216512, 351165562, 7561907, D+F 3.01 8 200020001, 200020211, 227936571, 69610342, 137217102, 12241800, D+F 3.02 9 100010001, 100010001, 100010001, 100010001, 100010001, 12241800/ G 3.03 DATA NNN02/ 1 100010051, 104311441, 131615641, 190623681, 298037691, 931900, AEL 4.00 2 200120231, 211422771, 249627631, 309034911, 398545051, 1820600, AEL 4.01 3 100010001, 100010201, 126225521, 67216512, 351165562, 15385000, AEL 4.02 4 200020001, 200020011, 201220661, 223426161, 332644691, 21765700, AEL 4.03 5 600060001, 600560281, 608761991, 637466191, 693973361, 829500, AEL 5.00 6 100310831, 132016901, 214226411, 315736741, 419147071, 2514900, AEL 5.01 7 200721061, 233526401, 297533311, 369040481, 440747651, 3792000, AEL 5.02 8 100010001, 100010001, 100010001, 100010001, 100010001, 25929800, G 5.03 9 893292271, 96110042, 105311262, 126315202, 196126432, 1125508/ D+F 6.00 DATA NNN03/ 1 595060251, 620865751, 713280191, 95712292, 167623542, 2437501, D+F 6.01 2 105513201, 180324851, 341851341, 88416332, 296550722, 4787101, D+F 6.02 3 204922771, 262630421, 350941931, 494556971, 644872001, 6447600, D+F 6.03 4 403141851, 457051681, 594071181, 92913362, 203331152, 1452915, D+F 7.00 5 919899541, 107211512, 124914302, 182526232, 403762662, 2959202, D+F 7.01 6 596862721, 684177081, 88110342, 128317062, 239334312, 4742501, D+F 7.02 7 112816481, 240733751, 462068491, 116419932, 283736822, 7744900, D+F 7.03 8 210124681, 293634211, 391145791, 539862151, 703178471, 9786200, D+F 7.04 9 874789691, 924795711, 99410492, 115213492, 169022242, 1361307/ D+F 8.00 DATA NNN04/ 1 424151091, 622874781, 91312832, 221842502, 79914013, 3510711, D+F 8.01 2 95610702, 118113032, 149619922, 329761642, 101914173, 5488500, D+F 8.02 3 603567171, 775391141, 106612482, 143716252, 181420032, 7739300, D+F 8.03 4 124420321, 306943181, 606281181, 101712232, 142916342, 11387300, D+F 8.04 5 215026541, 323137551, 421546491, 508255151, 594863811, 13807900, AEL 8.05 6 575958511, 589859231, 595860671, 636470031, 815199581, 1741802, D+F 9.00 7 900296401, 102610802, 113912542, 152921152, 318348952, 3498003, D+F 9.01 8 469162651, 791295541, 121419552, 402686872, 154822203, 6264500, D+F 9.02 9 99511422, 129214572, 170523002, 320140922, 498458762, 8713900/ D+F 9.03 DATA NNN05/ 1 615472711, 87710602, 127215002, 172919582, 218624152, 11421300, D+F 9.04 2 135324181, 377252001, 661580261, 94410852, 122613672, 15711700, AEL 9.05 3 100010001, 100010051, 105313051, 210239461, 74013022, 2155808, D+F10.00 4 580158751, 591759741, 642687101, 159332652, 64111533, 4106907, D+F10.01 5 93510272, 110411662, 127116062, 257647882, 75110223, 6350000, D+F10.02 6 529774371, 94611322, 135816202, 188221442, 240626682, 9701900, D+F10.03 7 103312152, 140616092, 181320182, 222224262, 263128352, 12630000, AEL10.04 8 629178711, 98311802, 136715512, 173619202, 210422892, 15790900, AEL10.05 9 200020001, 200320211, 207322131, 253031421, 417657451, 513802/ D+F11.00 DATA NNN06/ 1 100010001, 100010161, 119621261, 50711872, 246445382, 4728901, D+F11.01 2 580158751, 591860351, 71813142, 321968812, 106014333, 7165000, D+F11.02 3 96910772, 116012242, 130714232, 153916552, 177118872, 9888000, D+F11.03 4 601386081, 108812932, 148916832, 187820722, 226624612, 13836900, AEL11.04 5 105712442, 144616652, 189221182, 234425702, 279630222, 17209000, AEL11.05 6 100010011, 101410621, 118414581, 204831781, 509479731, 764404, D+F12.00 7 200120051, 202921001, 226926901, 368457091, 92814872, 1503101, D+F12.01 8 100010001, 100110611, 177455431, 176546012, 99718753, 8011905, D+F12.02 9 579758751, 591459501, 600560591, 611461681, 622362781, 10928900/ AEL12.03 DATA NNN07/ 1 100611232, 120612752, 134214102, 147815462, 161416822, 14122900, AEL12.04 2 674896701, 121814462, 167018942, 211723412, 256527892, 18648900, AEL12.05 3 558857701, 583558761, 593260591, 635969541, 796790971, 598400, D+F13.00 4 100310211, 110313021, 172828201, 55311252, 215637942, 1882203, D+F13.01 5 200320201, 208622331, 250530971, 410251081, 611571211, 2844000, D+F13.02 6 100010001, 100210881, 207436531, 523168101, 838999681, 11996000, D+F13.03 7 577758651, 591259631, 604461351, 622563161, 640764981, 15377000, AEL13.04 8 103511582, 124713242, 140014772, 155316292, 170517812, 19042000, AEL13.05 9 825189211, 95210052, 106211532, 134317202, 237934082, 814913/ D+F14.00 DATA NNN08/ 1 563057761, 588160311, 631768671, 791097651, 127817282, 1634000, D+F14.01 2 101110771, 126716471, 232438081, 71914052, 262045302, 3346001, D+F14.02 3 200720521, 217224081, 284439171, 551370951, 86810262, 4513000, D+F14.03 4 100010001, 100210881, 207436531, 523168101, 838999681, 16672900, FAK14.04 5 575458521, 591459851, 610063201, 672674071, 843698661, 20510900, AEL14.05 6 402643441, 496757481, 658274401, 833492941, 103511532, 1048300, AEL15.00 7 874497931, 106011282, 119812802, 138415142, 164717802, 1972000, AEL15.01 8 564058061, 604164611, 709579551, 90410172, 112912422, 3015500, AEL15.02 9 100811411, 149720221, 280936121, 441552181, 602168241, 5135400/ AEL15.03 DATA NNN09/ 1 200420781, 227025361, 281430911, 336936471, 392542021, 6500700, AEL15.04 2 100010001, 100010001, 100010001, 100010001, 100010001, 22041300, G 15.05 3 822887891, 930697831, 102610932, 121614492, 185124742, 1035708, D+F16.00 4 443056011, 694982961, 96911522, 144218572, 227326892, 2339900, D+F16.01 5 91610392, 113512242, 136416942, 233429882, 364242962, 3500000, D+F16.02 6 560058861, 633871081, 82410062, 123314602, 168619132, 4728900, D+F16.03 7 104512901, 177025421, 375163021, 122420462, 286036742, 7250000, D+F16.04 8 202321571, 241428261, 358355061, 78310152, 124814802, 8802800, D+F16.05 9 538155931, 571657911, 598067191, 89013782, 227737172, 1300916/ D+F17.00 DATA NNN10/ 1 873396771, 104411072, 118513532, 175525872, 406763932, 2379903, D+F17.01 2 506569571, 87610522, 134421682, 439092662, 182132573, 3990006, D+F17.02 3 95110872, 120013232, 154921252, 345149322, 641378942, 5350000, D+F17.03 4 558960371, 677779341, 95311692, 138816082, 182720472, 6780000, D+F17.04 5 100010001, 100010051, 106913911, 240147261, 90716112, 1575411, D+F18.00 6 550256831, 578158781, 636585461, 151530162, 58010303, 2762007, D+F18.01 7 92110362, 112412002, 133216772, 254443722, 76512833, 4090003, D+F18.02 8 582082081, 103112292, 149920212, 309750502, 720793642, 5978900, D+F18.03 9 97111072, 123213982, 172625622, 463976582, 106413633, 7500000/ D+F18.04 DATA NNN11/ 1 200020011, 200720361, 211923291, 280137141, 525575741, 433803, D+F19.00 2 100010001, 100110341, 135929551, 79119282, 405274892, 3180905, D+F19.01 3 554657081, 581260301, 73012702, 285363872, 129023363, 4600005, D+F19.02 4 96010862, 118413212, 180836632, 90321023, 416863253, 6090000, D+F19.03 5 657793361, 119515082, 195826322, 352944302, 533162332, 8259900, D+F19.04 6 100110061, 104311741, 145919971, 294345051, 69010322, 611003, D+F20.00 7 205822781, 279234761, 427553061, 688994901, 136319772, 1186701, D+F20.01 8 100010001, 100510821, 168744821, 130232522, 69012813, 5121003, D+F20.02 9 555157161, 585662471, 82816862, 42510013, 168423663, 6700000/ D+F20.03 DATA NNN12/ 1 99411262, 123814062, 182930402, 484766392, 84310223, 8438900, D+F20.04 2 924696691, 105212282, 151219062, 240530032, 368944512, 653900, AEL21.00 3 190424662, 297634542, 391743752, 482952832, 573761912, 1280000, AEL21.01 4 976799291, 101110322, 105810882, 111911502, 118112122, 2475000, AEL21.02 5 100010001, 100510821, 168744821, 130232522, 69012813, 7390000, FAK21.03 6 555157161, 585662471, 82816862, 42510013, 168423663, 9200000, FAK21.04 7 181021172, 260333222, 430155582, 710089242, 110213293, 681900, D+F22.00 8 474659872, 721284672, 98211413, 134515623, 177919963, 1356900, D+F22.01 9 228327012, 308134272, 381143862, 534563472, 734983512, 2747000/ D+F22.02 DATA NNN13/ 1 971498311, 99210032, 102610572, 108711172, 114711782, 4324000, D+F22.03 2 100010001, 100510821, 168744821, 130232522, 69012813, 9980000, FAK22.04 3 272835172, 425851532, 632278322, 97212013, 146817723, 674000, AEL23.00 4 373954132, 743597002, 121414713, 173920143, 229225713, 1464900, AEL23.01 5 323142642, 519660272, 679975352, 824789522, 96610363, 2930900, AEL23.02 6 248329302, 324234952, 373439752, 421744582, 469949412, 4800000, AEL23.03 7 970698231, 990699881, 100710152, 102410322, 104010482, 6500000, AEL23.04 8 717277611, 92911652, 152620872, 295141952, 550468122, 676400, D+F24.00 9 71611552, 205635512, 558281952, 115315823, 205625293, 1649000/ D+F24.01 DATA NNN14/ 1 280639822, 538369722, 87610823, 129115003, 170919183, 3095000, D+F24.02 2 377150952, 616070292, 791788382, 97610683, 116012523, 5000000, D+F24.03 3 264730962, 341436462, 394042872, 463549832, 533056782, 7300000, D+F24.04 4 600060321, 629270891, 86911302, 151020222, 267534752, 743100, AEL25.00 5 739594821, 139921212, 309342852, 567372412, 97112553, 1563600, AEL25.01 6 98417472, 265535782, 454754842, 641973532, 828792212, 3369000, AEL25.02 7 328847052, 586668342, 771785912, 94710343, 112112093, 5300000, AEL25.03 8 422055132, 636770792, 779285062, 921999322, 106411363, 7600000, AEL25.04 9 197023222, 274433302, 416753952, 723799822, 139419053, 787038/ D+F26.00 DATA NNN15/ 1 409453722, 686687452, 110213823, 174322233, 286437043, 1617902, D+F26.01 2 262136422, 501167232, 87911303, 138916483, 190721673, 3064300, D+F26.02 3 98723522, 420363072, 87011423, 145117913, 215925463, 5700000, AEL26.03 4 388854482, 666275742, 846693572, 102511143, 120312923, 7900000, D+F26.04 5 199427202, 335740022, 474957182, 708090462, 118315403, 786000, D+F27.00 6 279739202, 490858232, 684582472, 104713233, 159818733, 1704900, D+F27.01 7 279836622, 461857562, 720693022, 124915873, 192522633, 3349000, D+F27.02 8 262136422, 501167232, 87911303, 138916483, 190821673, 5300000, FAK27.03 9 98723522, 420363072, 87011423, 145117913, 215925463, 8300000/ FAK27.04 DATA NNN16/ 1 227027622, 306233052, 356839222, 446052912, 652382292, 763314, D+F28.00 2 108416342, 222428472, 353944332, 577378932, 110314303, 1814900, D+F28.01 3 198724282, 293236452, 468362702, 86511123, 136016073, 3516000, D+F28.02 4 279836622, 461857562, 720693022, 124915873, 192522633, 5600000, FAK28.03 5 262136422, 501167232, 87911303, 138916483, 190721673, 7900000, FAK28.04 6 201620781, 231026761, 314737361, 450555381, 692386911, 772301, D+F29.00 7 109415761, 247938311, 58910042, 190937022, 68311693, 2028903, D+F29.01 8 897195961, 107212972, 165021182, 260230862, 356940532, 3682900, D+F29.02 9 100010001, 100410231, 108712611, 167124841, 388460411, 939102/ D+F30.00 DATA NNN17/ 1 200020021, 201620761, 223726341, 351352061, 80812472, 1796001, D+F30.01 2 100610471, 122617301, 300566361, 149924112, 332342352, 3970000, D+F30.02 3 403245601, 493151431, 529654331, 559358091, 611065171, 600000, AEL31.00 4 99710051, 104511541, 135016501, 208226431, 321837921, 2050900, AEL31.01 5 199820071, 204521391, 229124761, 266028451, 302932131, 3070000, AEL31.02 6 502665261, 755183501, 901496201, 102410942, 117912812, 787900, AEL32.00 7 422848161, 512153401, 557458941, 636270361, 794489061, 1593000, AEL32.01 8 100010261, 114613921, 175221251, 249828711, 324436181, 3421000, AEL32.02 9 403143241, 491856701, 649173781, 840396751, 113013392, 981000/ AEL33.00 DATA NNN18/ 1 593676641, 884697521, 105911572, 129515012, 180322212, 1858700, AEL33.01 2 484470541, 91510972, 125614082, 157017612, 199722912, 2829900, AEL33.02 3 630172361, 799686381, 919797221, 102810942, 117712832, 975000, AEL34.00 4 438055511, 691582151, 94510732, 121413672, 152016732, 2150000, AEL34.01 5 651982921, 94610382, 113212492, 139515462, 169718482, 3200000, AEL34.02 6 437347431, 498951671, 538559501, 74710812, 169126672, 1183910, D+F35.00 7 705183611, 93510092, 111614162, 222932532, 427652992, 2160000, D+F35.01 8 510869921, 87410312, 123116552, 236530712, 377744832, 3590000, D+F35.02 9 100010001, 100010051, 105012781, 198535971, 65911422, 1399507/ D+F36.00 DATA NNN19/ 1 461049811, 522254261, 609088131, 168935052, 68612253, 2455908, D+F36.01 2 759990901, 101911142, 129017782, 302856642, 99414333, 3690000, D+F36.02 3 200020011, 200720361, 211523021, 269434141, 459163351, 417502, D+F37.00 4 100010001, 100110321, 129524961, 61014202, 291753192, 2750004, D+F37.01 5 473650891, 533156051, 66810932, 232950852, 99915303, 4000000, D+F37.02 6 100110041, 104111741, 146019721, 281941411, 607785251, 569202, D+F38.00 7 202621931, 255331271, 384347931, 624085761, 122417632, 1102600, D+F38.01 8 100010001, 100110321, 129524961, 61014202, 291753192, 4300000, FAK38.02 9 791587851, 100012192, 155119942, 254031782, 389946932, 637900/ AEL39.00 DATA NNN20/ 1 118217102, 220827002, 319036792, 416646512, 513256072, 1223000, AEL39.01 2 92510012, 104710862, 112311612, 120212472, 132814282, 2050000, AEL39.02 3 141320802, 291439702, 531170262, 92712273, 162521053, 684000, D+F40.00 4 354454352, 724689652, 107212643, 148517093, 193321573, 1312900, D+F40.01 5 209727032, 324537052, 415446282, 510255752, 604965222, 2298000, D+F40.02 6 256636022, 465759302, 749693962, 116514243, 171520333, 687900, AEL41.00 7 335157222, 84511463, 147718363, 221826083, 299933893, 1431900, AEL41.01 8 223725352, 280830972, 340937362, 406844002, 473150632, 2503900, AEL41.02 9 703972941, 82610822, 154822682, 327244912, 571469372, 709900/ D+F42.00 DATA NNN21/ 1 75714552, 274347322, 718897632, 123414913, 174920063, 1614900, D+F42.01 2 267645462, 669890262, 115514323, 173620673, 242528083, 2714900, AEL42.02 3 90613732, 184823562, 291735332, 419949102, 565764332, 728000, AEL43.00 4 131318312, 227126932, 311735452, 397644072, 483852692, 1525900, AEL43.01 5 204721673, 234725733, 284031463, 348738613, 426546943, 3000000, AEL43.02 6 176824122, 318941082, 515263202, 761790472, 106112303, 736400, AEL44.00 7 221934642, 501968372, 88911173, 136316243, 189221613, 1675900, AEL44.01 8 210622722, 241025422, 267928262, 297731272, 327834282, 2846000, AEL44.02 9 148520202, 255230902, 364942462, 489656082, 638872352, 746000/ AEL45.00 DATA NNN22/ 1 153421292, 288137912, 484660322, 720187062, 101011483, 1807000, AEL45.01 2 254537212, 492362292, 770592182, 107312243, 137615273, 3104900, AEL45.02 3 115919651, 320746011, 607576761, 95011642, 141817172, 832900, AEL46.00 4 755087211, 105913442, 173122222, 282034722, 412247732, 1941900, AEL46.01 5 180223462, 289735212, 414247632, 538460052, 662672472, 3292000, AEL46.02 6 200020001, 200220141, 206422141, 257633021, 455164681, 757403, D+F47.00 7 100810581, 125817401, 260641031, 66210072, 135316982, 2148000, D+F47.01 8 795887491, 97711762, 156620252, 248329422, 340038582, 3481900, D+F47.02 9 100010001, 100410241, 109212891, 176827421, 444268771, 899003/ D+F48.00 DATA NNN23/ 1 200020021, 201720921, 233329881, 451475371, 127520782, 1690301, D+F48.01 2 100310281, 114815371, 246138311, 519265531, 791492761, 3747000, D+F48.02 3 252431921, 368440461, 433746521, 512259221, 723389021, 578400, D+F49.00 4 100110071, 104611651, 146118581, 225426511, 304734431, 1886000, D+F49.01 5 200120111, 205021611, 243628031, 317035371, 390442701, 2802900, D+F49.02 6 232637101, 488058571, 669074381, 816189091, 97210632, 734200, AEL50.00 7 286335941, 408144471, 479351961, 571862901, 686274341, 1462700, AEL50.01 8 100010251, 114013811, 175321601, 256829751, 338337901, 3049000, AEL50.02 9 404043481, 494656811, 646772781, 813490751, 101411372, 863900/ AEL51.00 DATA NNN24/ 1 303147981, 618472951, 827392621, 103711702, 131214532, 1650000, AEL51.01 2 313037601, 429347901, 536260591, 689477591, 862494881, 2529900, AEL51.02 3 526258801, 657372351, 784284071, 897095741, 102711082, 900900, AEL52.00 4 440855541, 686481251, 93810792, 125414792, 176321132, 1860000, AEL52.01 5 349054751, 699883081, 96611302, 134216202, 197724212, 2800000, AEL52.02 6 405342041, 438645621, 475751071, 587974491, 102214572, 1045404, D+F53.00 7 568567471, 773485861, 94510362, 112712182, 130914002, 1909000, D+F53.01 8 514269581, 86910562, 130716652, 215327742, 351843662, 3200000, AEL53.02 9 100010001, 100010091, 109515351, 291060661, 119621482, 1212716/ D+F54.00 DATA NNN25/ 1 414844131, 465649111, 538464651, 87112232, 158019362, 2120000, D+F54.01 2 615475101, 867797531, 112213462, 157618062, 203622662, 3209900, D+F54.02 3 200020001, 201020501, 215623871, 283536181, 462756261, 389300, D+F55.00 4 100010001, 100310371, 119016501, 269146361, 77912412, 2510000, D+F55.01 5 424445601, 481750061, 516953311, 549356551, 581759791, 3500000, D+F55.02 6 101210791, 135119351, 282340571, 574580391, 111015062, 521002, D+F56.00 7 262638611, 504160621, 698579371, 91010692, 129115952, 1000000, D+F56.01 8 100010001, 100310351, 118416321, 264945521, 76512182, 3700000, FAK56.02 9 71111992, 172323592, 312540402, 510763182, 765791012, 558000/ AEL57.00 DATA NNN26/ 1 204529582, 383647882, 582469262, 807992692, 104911723, 1106000, AEL57.01 2 94712552, 148416582, 179819212, 203621522, 227424042, 1916900, AEL57.02 3 295959132, 103515693, 215527593, 335939413, 449650223, 565000, AEL58.00 4 79718153, 289639443, 495159253, 686877533, 863794813, 1085000, AEL58.01 5 298640242, 475053692, 596965912, 725379692, 872094692, 2008000, AEL58.02 6 460693672, 158523823, 327242303, 519661563, 709379783, 541900, FAK59.00 7 455480232, 114014653, 178521013, 240927073, 299232633, 1055000, AEL59.01 8 46410533, 183826893, 354443773, 518459633, 674375243, 2320000, AEL59.02 9 139623042, 364860002, 96114603, 209828633, 373446973, 549000/ AEL60.00 DATA NNN27/ 1 460493692, 158523823, 327142303, 519661563, 709279783, 1073000, AEL60.01 2 455480232, 114014653, 178521013, 240927073, 299232633, 2000000, FAK60.02 3 131720482, 280535692, 441254492, 676583972, 103412583, 555000, AEL61.00 4 139623042, 364860002, 96114603, 209828633, 373446973, 1089900, FAK61.01 5 460493682, 158523823, 327142303, 519661563, 709279783, 2000000, FAK61.02 6 92915672, 222431062, 444763802, 89612173, 159520253, 562900, AEL62.00 7 315059662, 97114563, 204627093, 342541693, 490556383, 1106900, AEL62.01 8 269037812, 520270372, 91111273, 133915483, 172719093, 2000000, AEL62.02 9 800080571, 851699301, 127617362, 240433032, 444958442, 568000/ AEL63.00 DATA NNN28/ 1 125416052, 211828182, 375549622, 644381732, 101112213, 1125000, AEL63.01 2 800080571, 851699301, 127617362, 240433032, 444958442, 2000000, FAK63.02 3 240432982, 427555202, 708489962, 112613853, 167319843, 615900, AEL64.00 4 534793262, 139219123, 247730843, 371043333, 495055893, 1210000, AEL64.01 5 364145232, 514756362, 604864112, 673870372, 732276072, 2000000, AEL64.02 6 480767202, 89011393, 144118243, 230028753, 354142883, 584900, AEL65.00 7 480767192, 89011393, 144118243, 230028753, 354142883, 1151900, FAK65.01 8 480767202, 89011393, 144118243, 230028753, 354142883, 2000000, FAK65.02 9 343147532, 645887152, 115314793, 183322063, 257729373, 593000/ FAK66.00 DATA NNN29/ 1 343147532, 645887142, 115314793, 183322063, 257729373, 1167000, AEL66.01 2 343147532, 645887142, 115314793, 183322063, 257729373, 2000000, FAK66.02 3 222635002, 542276772, 100312353, 145716713, 187020703, 602000, FAK67.00 4 222635002, 542276772, 100312353, 145716713, 187020703, 1180000, FAK67.01 5 222635002, 542276772, 100312353, 145716713, 187020703, 2000000, AEL67.02 6 133715382, 209130152, 429859382, 79410293, 129815983, 609900, AEL68.00 7 265934782, 497877532, 120517733, 245032063, 400448073, 1193000, AEL68.01 8 265934782, 497877532, 120517733, 245032063, 400448073, 2000000, FAK68.02 9 800381111, 87510702, 147621462, 310343462, 585475982, 618000/ AEL69.00 DATA NNN30/ 1 156718872, 279244452, 678196342, 128316243, 197823443, 1205000, AEL69.01 2 93517192, 364666132, 103414613, 192624193, 293334613, 2370000, AEL69.02 3 100010011, 101310651, 118613951, 169120661, 250629971, 625000, AEL70.00 4 200120901, 270345231, 81714042, 223533112, 461959862, 1217000, AEL70.01 5 100312561, 250851931, 91914182, 198626022, 323638692, 2000000, AEL70.02 6 514664441, 759086851, 99211442, 133315612, 182721252, 609900, AEL71.00 7 125924831, 438667801, 98714112, 199727872, 380850742, 1389900, AEL71.01 8 323948621, 661297271, 158626482, 426865032, 93712843, 1900000, AEL71.02 9 659294081, 128016962, 222528952, 372047062, 585171462, 700000/ AEL72.00 DATA NNN31/ 1 99117882, 274638812, 520867322, 84410313, 123314453, 1489900, AEL72.01 2 187427702, 343739872, 448049452, 539358282, 625266642, 2329900, AEL72.02 3 65210892, 171325762, 373552252, 705192012, 116414343, 787900, AEL73.00 4 192837842, 600784802, 111113823, 165419233, 218524383, 1620000, AEL73.01 5 99117872, 274638812, 520867312, 84410313, 123314453, 2400000, FAK73.02 6 398981651, 130019172, 273438022, 516168382, 88411163, 797900, AEL74.00 7 131429482, 523279952, 111414623, 183422233, 262130233, 1770000, AEL74.01 8 192837842, 600784792, 111113823, 165419233, 218524383, 2500000, FAK74.02 9 600963001, 75910412, 150121572, 301940972, 539168952, 787000/ AEL75.00 DATA NNN32/ 1 73710852, 190731262, 464964142, 83810503, 127315053, 1660000, AEL75.01 2 131429482, 523279952, 111414623, 183422233, 262130233, 2600000, FAK75.02 3 110815502, 216829732, 398752322, 672484682, 104612673, 850000, AEL76.00 4 168225972, 362046562, 566766422, 757484612, 93010103, 1700000, AEL76.01 5 73710852, 190731262, 464964142, 83810503, 127315053, 2700000, FAK76.02 6 129117892, 239430882, 388748292, 596173252, 89510843, 910000, AEL77.00 7 110815502, 216829732, 398752322, 672484682, 104612673, 2000000, FAK77.01 8 168225972, 362046562, 566766422, 757484612, 93010103, 2800000, FAK77.02 9 158918512, 207523002, 254328242, 316335762, 407246582, 900000/ AEL78.00 DATA NNN33/ 1 98115462, 224930742, 401150612, 623475412, 89910583, 1855900, AEL78.01 2 110815502, 216829732, 398752322, 672484682, 104612673, 2900000, FAK78.02 3 203222611, 265731251, 364042301, 494958601, 702084731, 922000, AEL79.00 4 120521331, 357753801, 75310062, 130516572, 206925452, 2050000, AEL79.01 5 651780821, 108814772, 195925252, 316338622, 460853882, 3000000, AEL79.02 6 100010001, 100110111, 105211851, 152122101, 341552811, 1043002, D+F80.00 7 200320211, 210023021, 268834231, 480472341, 111416912, 1875000, D+F80.01 8 104012871, 186129471, 458664151, 82410072, 119013732, 3420000, D+F80.02 9 200420711, 222424271, 265429161, 325637371, 442853911, 610500/ AEL81.00 DATA NNN34/ 1 100010021, 101910801, 121414641, 189525811, 358949721, 2041900, AEL81.01 2 200020311, 216624611, 296337451, 489064791, 85711212, 2979900, AEL81.02 3 103411711, 147819101, 244331781, 434862751, 93113762, 741404, D+F82.00 4 204122231, 248227841, 311535621, 429153941, 651976431, 1502800, D+F82.01 5 100210131, 106812201, 154522671, 381665951, 95512512, 3192900, D+F82.02 6 400140351, 416944121, 474851591, 564362181, 690477231, 728700, AEL83.00 7 106814451, 204427341, 350744811, 586879131, 108314772, 1667900, AEL83.01 8 205523051, 264830231, 345439921, 469156001, 675281671, 2555900, AEL83.02 9 500950661, 518153561, 559058941, 628968071, 748483501, 843000/ AEL84.00 DATA NNN35/ 1 443756241, 696282451, 95411012, 128615262, 182922012, 1900000, FAK84.01 2 336953201, 682481011, 93810882, 127915272, 184622442, 2700000, FAK84.02 3 402841621, 431544771, 463148311, 520059491, 734896851, 930000, FAK85.00 4 576168741, 788387631, 96910642, 116012552, 135014462, 2000000, FAK85.01 5 490265341, 812797201, 116614322, 179622692, 285035302, 2900000, FAK85.02 6 100010001, 100010031, 102311051, 133018071, 264539391, 1074500, AEL86.00 7 402841621, 431544771, 463148311, 520059491, 734996851, 2000000, FAK86.01 8 576168741, 788387631, 96910642, 116012552, 135014462, 3000000, FAK86.02 9 200020011, 201220591, 218124481, 296538611, 488859141, 400000/ FAK87.00 DATA NNN36/ 1 100010001, 100010031, 102311051, 133018071, 264539401, 2200000, FAK87.01 2 421645151, 477449611, 511852711, 542455761, 572958821, 3300000, FAK87.02 3 100010041, 105212131, 153220271, 270435641, 460258111, 527600, AEL88.00 4 201221791, 258131471, 381645781, 546365131, 777592781, 1014400, AEL88.01 5 100010001, 100010031, 102311051, 133018071, 264539391, 3400000, FAK88.02 6 510064491, 82710872, 142718412, 232328712, 348341572, 690000, AEL89.00 7 228951571, 88513232, 183324132, 305537492, 448152402, 1210000, AEL89.01 8 723989131, 103511752, 130814352, 155416652, 177018682, 2000000, AEL89.02 9 620099241, 162725772, 391457072, 80110833, 141818023, 600000/ AEL90.00 DATA NNN37/ 1 620099241, 162725772, 391457072, 80110833, 141818023, 1200000, FAK90.01 2 620099251, 162725772, 391457072, 80110833, 141818023, 2000000, FAK90.02 3 347877992, 129318323, 240730533, 380546863, 570368573, 600000, AEL91.00 4 347877992, 129318323, 240730533, 380546863, 570368573, 1200000, FAK91.01 5 347777992, 129318323, 240730533, 380546863, 570368573, 2000000, FAK91.02 6 209530092, 450866762, 96613623, 186524763, 318839893, 600000, AEL92.00 7 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK92.01 8 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK92.02 9 209530092, 450866762, 96613623, 186524763, 318839893, 600000/ FAK93.00 DATA NNN38/ 1 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK93.01 2 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK93.02 3 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK94.00 4 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK94.01 5 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK94.02 6 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK95.00 7 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK95.01 8 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK95.02 9 209530092, 450866762, 96613623, 186524763, 318839893, 600000/ FAK96.00 DATA NNN39/ 1 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK96.01 2 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK96.02 3 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK97.00 4 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK97.01 5 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK97.02 6 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK98.00 7 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK98.01 8 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK98.02 9 209530092, 450866762, 96613623, 186524763, 318839893, 600000/ FAK99.00 DATA NNN40/ 1 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK99.01 2 209530092, 450866762, 96613623, 186524763, 318839893, 2000000/ FAK99.02 DATA NNN67/ 1 893292271, 96110042, 105311262, 126315202, 196126432, 1125508, D+F 6.00 2 595060251, 620865751, 713280191, 95712292, 167623542, 2437501, D+F 6.01 3 105513201, 180324851, 341851341, 88416332, 296550722, 4787101, D+F 6.02 4 204922771, 262630421, 350941931, 494556971, 644872001, 6447600, D+F 6.03 5 100010001, 100010001, 100010001, 100010001, 100010001, 39207700, G 6.04 6 200020001, 200020001, 200020001, 200020001, 200020001, 48998100, G 6.05 7 403141851, 457051681, 594071181, 92913362, 203331152, 1452915, D+F 7.00 8 919899541, 107211512, 124914302, 182526232, 403762662, 2959202, D+F 7.01 9 596862721, 684177081, 88110342, 128317062, 239334312, 4742501, D+F 7.02 T 112816481, 240733751, 462068491, 116419932, 283736822, 7744900, D+F 7.03 1 210124681, 293634211, 391145791, 539862151, 703178471, 9786200, D+F 7.04 2 100010001, 100010001, 100010001, 100010001, 100010001, 55205700/ G 7.05 DATA EHYD/0.,82259.105,97492.302,102823.893,105291.651,106632.160/ DATA GHYD/2.,8.,18.,32.,50.,72./ DATA EHE1/0.,159856.069,166277.546,169087.007,171135.000, 1 183236.892,184864.936,185564.694,186101.654,186105.065, 2 186209.471,190298.210,190940.331,191217.14,191444.588, 3 191446.559,191451.80,191452.08,191492.817, 4 193347.089,193663.627,193800.78,193917.245,193918.391, 5 193921.31,193921.37,193922.5,193922.5,193942.57/ DATA GHE1/1.,3.,1.,9.,3.,3.,1.,9.,15.,5.,3.,3.,1.,9.,15.,5.,21., 1 7.,3.,3.,1.,9.,15.,5.,21.,7.,27.,9.,3./ DATA EHE2/0.,329182.321,390142.359,411477.925,421353.135, 1 426717.413/ DATA GHE2/2.,8.,18.,32.,50.,72./ DATA EB1/10.17,28810.,40039.65,47856.99,48613.01,54767.74, 1 55010.08/ DATA GB1/6.,12.,2.,10.,6.,10.,2./ DATA EC1/29.60,10192.66,21648.02,33735.20,60373.00,61981.82, 1 64088.85,68856.33,69722.00,70743.95,71374.90,72610.72,73975.91, 2 75254.93/ DATA GC1/9.,5.,1.,5.,9.,3.,15.,3.,15.,3.,9.,5.,1.,9./ DATA EC2/42.48,43035.8,74931.11,96493.74,110652.10,116537.65/ DATA GC2/6.,12.,10.,2.,6.,2./ DATA EO1/77.975,15867.862,33792.583,73768.200,76794.978,86629.089, 1 88630.977,95476.728,96225.049,97420.748,97488.476,99094.065, 2 99681.051/ DATA GO1/9.,5.,1.,5.,3.,15.,9.,5.,3.,25.,15.,15.,9./ DATA ENA1/0.,16956.172,16973.368,25739.991,29172.889,29172.839, 1 30266.99,30272.58/ DATA GNA1/2.,2.,4.,2.,6.,4.,2.,4./ DATA EMG1/0.,21890.854,35051.264,41197.403,43503.333, 1 46403.065,47847.797,47957.034,49346.729,51872.526,52556.206/ DATA GMG1/1.,9.,3.,3.,1.,5.,9.,15.,3.,3.,1./ DATA EMG2/0.,35730.36,69804.95,71490.54,80639.85,92790.51/ DATA GMG2/2.,6.,2.,10.,6.,2./ DATA EAL1/74.707,25347.756,29097.11,32436.241,32960.363, 1 37689.413,38932.139,40275.903,41319.377/ DATA GAL1/6.,2.,12.,10.,6.,2.,10.,6.,14./ DATA ESI1/149.681,6298.850,15394.370,33326.053,39859.920, 1 40991.884,45303.310,47284.061,47351.554,48161.459,49128.131/ DATA GSI1/9.,5.,1.,5.,9.,3.,15.,3.,5.,15.,9./ DATA ESI2/191.55,43002.27,55319.11,65500.73,76665.61,79348.67/ DATA GSI2/6.,12.,10.,2.,2.,10./ DATA EK1/0.,12985.170,13042.876,21026.551,21534.680,21536.988, 1 24701.382,24720.139/ DATA GK1/2.,2.,4.,2.,6.,4.,2.,4./ DATA ECA1/0.,15263.089,20356.265,21849.634,23652.304,31539.495, 1 33317.264,35831.203/ DATA GCA1/1.,9.,15.,5.,3.,3.,1.,21./ DATA ECA2/0.,13686.60,25340.10,52166.93,56850.78/ DATA GCA2/2.,10.,6.,2.,10./ DATA LOCZ/1,3,6,10,14,18,22,27,33,39,45,51,57,63,69,75,81,86,91, 196,101,106,111,116,121,126,131,136,141/ DATA SCALE/.001,.01,.1,1./ C MODE1=MODE IF(MODE1.GT.10)MODE1=MODE1-10 C LOWERING OF THE IONIZATION POTENTIAL IN VOLTS FOR UNIT ZEFF CHARGE=XNE(J)*2. EXCESS=2.*XNE(J)-P(J)/TK(J) C ALLOWANCE FOR DOUBLY IONIZED HELIUM IF(EXCESS.GT.0.)CHARGE=CHARGE+2.*EXCESS IF(CHARGE.EQ.0.)CHARGE=1. DEBYE=SQRT(TK(J)/2.8965E-18/CHARGE) C DEBYE=SQRT(TK(J)/12.5664/4.801E-10**2/CHARGE) POTLOW=MIN(1.D0,1.44E-7/DEBYE) TV=TKEV(J) IF(IZ.LE.28)N=LOCZ(IZ) IF(IZ.GT.28)N=3*IZ+54 IF(IZ.LE.28)NIONS=LOCZ(IZ+1)-N IF(IZ.GT.28)NIONS=3 IF(IZ.EQ.6)N=354 IF(IZ.EQ.6)NIONS=6 IF(IZ.EQ.7)N=360 IF(IZ.EQ.7)NIONS=6 NION2=MIN0(NION+2,NIONS) N=N-1 C DO 18 ION=1,NION2 Z=ION POTLO(ION)=POTLOW*Z N=N+1 NNN100=NNN(6,N)/100 IP(ION)=DBLE(NNN100)/1000. G=NNN(6,N)-NNN100*100 IF(N.EQ.1)GO TO 1100 IF(N.EQ.3)GO TO 1110 IF(N.EQ.4)GO TO 1120 IF(N.EQ.354)GO TO 1130 IF(N.EQ.51)GO TO 1140 IF(N.EQ.57)GO TO 1150 IF(N.EQ.63)GO TO 1160 IF(N.EQ.355)GO TO 1132 IF(N.EQ.52)GO TO 1142 IF(N.EQ.64)GO TO 1162 IF(N.EQ.96)GO TO 1170 IF(N.EQ.97)GO TO 1172 IF(N.EQ.27)GO TO 1180 IF(N.EQ.45)GO TO 1190 IF(N.EQ.14)GO TO 1200 IF(N.EQ.91)GO TO 1210 T2000=IP(ION)*2000./11. IT=MAX0(1,MIN0(9, INT(T(J)/T2000-.5))) DT=T(J)/T2000-DBLE(IT)-.5 PMIN=1. I=(IT+1)/2 K1=NNN(I,N)/100000 K2=NNN(I,N)-K1*100000 K3=K2/10 KSCALE=K2-K3*10 IF(MOD(IT,2).EQ.0)GO TO 12 P1=DBLE(K1)*SCALE(KSCALE) P2=DBLE(K3)*SCALE(KSCALE) IF(DT.GE.0.)GO TO 13 IF(KSCALE.GT.1)GO TO 13 KP1=P1 IF(KP1.NE. INT(P2+.5))GO TO 13 PMIN=KP1 GO TO 13 12 P1=DBLE(K3)*SCALE(KSCALE) K1=NNN(I+1,N)/100000 KSCALE=MOD(NNN(I+1,N),10) P2=DBLE(K1)*SCALE(KSCALE) 13 PART(ION)= MAX (PMIN,P1+(P2-P1)*DT) IF(G.EQ.0..OR.POTLO(ION).LT..1.OR.T(J).LT.T2000*4.)GO TO 18 IF(T(J).GT.(T2000*11.))TV=(T2000*11.)*8.6171E-5 D1=.1/TV 14 D2=POTLO(ION)/TV PART(ION)=PART(ION)+G*EXP(-IP(ION)/TV)*(SQRT(13.595*Z*Z/TV/D2)**3* 1(1./3.+(1.-(.5+(1./18.+D2/120.)*D2)*D2)*D2)- 2SQRT(13.595*Z*Z/TV/D1)**3* 3(1./3.+(1.-(.5+(1./18.+D1/120.)*D1)*D1)*D1)) TV=TKEV(J) GO TO 18 1100 B=BHYD(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=2.*B IF(T(J).LT.9000.)GO TO 18 DO 1101 I=2,6 B=BHYD(J,I) IF(NLTEON.EQ.-1)B=1. 1101 PART(1)=PART(1)+GHYD(I)*B *EXP(-EHYD(I)*HCKT(J)) D1=109677.576/6.5/6.5*HCKT(J) GO TO 14 1110 B=BHE1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B IF(T(J).LT.15000.)GO TO 18 DO 1111 I=2,29 B=BHE1(J,I) IF(NLTEON.EQ.-1)B=1. 1111 PART(1)=PART(1)+GHE1(I)*B *EXP(-EHE1(I)*HCKT(J)) D1=109677.576/5.5/5.5*HCKT(J) GO TO 14 1120 B=BHE2(J,1) IF(NLTEON.EQ.-1)B=1. PART(2)=2.*B IF(T(J).LT.30000.)GO TO 18 DO 1121 I=2,6 B=BHE2(J,I) IF(NLTEON.EQ.-1)B=1. 1121 PART(2)=PART(2)+GHE2(I)*B *EXP(-EHE2(I)*HCKT(J)) D1=4.*109722.267/6.5/6.5*HCKT(J) GO TO 14 1130 B=BC1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B *(1.+3.*EXP(-16.42*HCKT(J))+ 1 5.*EXP(-43.42*HCKT(J))) DO 1131 I=2,14 B=BC1(J,I) IF(NLTEON.EQ.-1)B=1. 1131 PART(1)=PART(1)+GC1(I)*B *EXP(-EC1(I)*HCKT(J)) PART(1)=PART(1)+108.*EXP(-80000.*HCKT(J))+ 1 189*EXP(-84000.*HCKT(J))+247.*EXP(-87000.*HCKT(J))+ 2 231.*EXP(-88000.*HCKT(J))+190.*EXP(-89000.*HCKT(J))+ 3 300.*EXP(-90000.*HCKT(J)) GO TO 18 1132 B=BC2(J,1) IF(NLTEON.EQ.-1)B=1. PART(2)=B*(2.+4.*EXP(-63.42*HCKT(J))) DO 1133 I=2,6 B=BC2(J,I) IF(NLTEON.EQ.-1)B=1. 1133 PART(2)=PART(2)+GC2(I)*B*EXP(-EC2(I)*HCKT(J)) PART(2)=PART(2)+6.*EXP(-131731.80*HCKT(J))+ 1 4.*EXP(-142027.1*HCKT(J))+10.*EXP(-145550.13*HCKT(J))+ 2 10.*EXP(-150463.62*HCKT(J))+2.*EXP(-157234.07*HCKT(J))+ 3 6.*EXP(-162500.*HCKT(J))+42.*EXP(-168000.*HCKT(J))+ 4 56.*EXP(-178000.*HCKT(J))+102.*EXP(-183000.*HCKT(J))+ 5 400.*EXP(-188000.*HCKT(J)) GO TO 18 1140 B=BMG1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B DO 1141 I=2,11 B=BMG1(J,I) IF(NLTEON.EQ.-1)B=1. 1141 PART(1)=PART(1)+GMG1(I)*B *EXP(-EMG1(I)*HCKT(J)) PART(1)=PART(1)+5.*EXP(-53134.*HCKT(J))+15.*EXP(-54192.*HCKT(J))+ 1 28.*EXP(-54676.*HCKT(J))+9.*EXP(-57853.*HCKT(J)) G=4. D1=109734.83/4.5/4.5*HCKT(J) GO TO 14 1142 B=BMG2(J,1) IF(NLTEON.EQ.-1)B=1. PART(2)=B*2. DO 1143 I=2,6 B=BMG2(J,I) IF(NLTEON.EQ.-1)B=1. 1143 PART(2)=PART(2)+GMG2(I)*B *EXP(-EMG2(I)*HCKT(J)) PART(2)=PART(2)+10.*EXP(-93310.80*HCKT(J))+ 1 14.*EXP(-93799.70*HCKT(J))+6.*EXP(-97464.32*HCKT(J))+ 2 10.*EXP(-103419.82*HCKT(J))+14.*EXP(-103689.89*HCKT(J))+ 3 18.*EXP(-103705.66*HCKT(J)) G=2. D1=4.*109734.83/5.5/5.5*HCKT(J) GO TO 14 1150 B=BAL1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B *(2.+4.*EXP(-112.061*HCKT(J))) DO 1151 I=2,9 B=BAL1(J,I) IF(NLTEON.EQ.-1)B=1. 1151 PART(1)=PART(1)+GAL1(I)*B *EXP(-EAL1(I)*HCKT(J)) PART(1)=PART(1)+10.*EXP(-42235.*HCKT(J))+14.*EXP(-43831.*HCKT(J)) G=2. D1=109735.08/5.5/5.5*HCKT(J) GO TO 14 1160 B=BSI1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B *(1.+3.*EXP(-77.115*HCKT(J))+ 1 5.*EXP(-223.157*HCKT(J))) DO 1161 I=2,11 B=BSI1(J,I) IF(NLTEON.EQ.-1)B=1. 1161 PART(1)=PART(1)+GSI1(I)*B *EXP(-ESI1(I)*HCKT(J)) PART(1)=PART(1)+76.*EXP(-53000.*HCKT(J))+71.*EXP(-57000.*HCKT(J))+ 1 191.*EXP(-60000.*HCKT(J))+240.*EXP(-62000.*HCKT(J))+ 2 251.*EXP(-63000.*HCKT(J))+300.*EXP(-65000.*HCKT(J)) GO TO 18 1162 B=BSI2(J,1) IF(NLTEON.EQ.-1)B=1. PART(2)=B*(2.+4.*EXP(-287.32*HCKT(J))) DO 1163 I=2,6 B=BSI2(J,I) IF(NLTEON.EQ.-1)B=1. 1163 PART(2)=PART(2)+GSI2(I)*B *EXP(-ESI2(I)*HCKT(J)) PART(2)=PART(2)+6.*EXP(-81231.59*HCKT(J))+ 1 6.*EXP(-83937.08*HCKT(J))+10.*EXP(-101024.09*HCKT(J))+ 2 14.*EXP(-103556.35*HCKT(J))+10.*EXP(-108800.*HCKT(J))+ 3 42.*EXP(-115000.*HCKT(J))+6.*EXP(-121000.*HCKT(J))+ 4 38.*EXP(-125000.*HCKT(J))+34.*EXP(-132000.*HCKT(J)) G=2. D1=4.*109734.83/4.5/4.5*HCKT(J) GO TO 14 1170 B=BCA1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B DO 1171 I=2,8 B=BCA1(J,I) IF(NLTEON.EQ.-1)B=1. 1171 PART(1)=PART(1)+GCA1(I)*B *EXP(-ECA1(I)*HCKT(J)) PART(1)=PART(1)+28.*EXP(-37000.*HCKT(J))+67.*EXP(-40000.*HCKT(J))+ 1 21.*EXP(-43000.*HCKT(J))+34.*EXP(-48000.*HCKT(J)) G=4. D1=109734.82/4.5/4.5*HCKT(J) GO TO 14 1172 B=BCA2(J,1) IF(NLTEON.EQ.-1)B=1. PART(2)=B*2. DO 1173 I=2,5 B=BCA2(J,I) IF(NLTEON.EQ.-1)B=1. 1173 PART(2)=PART(2)+GCA2(I)*B *EXP(-ECA2(I)*HCKT(J)) PART(2)=PART(2)+12.*EXP(-68000.*HCKT(J)) G=2. D1=109734.83/4.5/4.5*HCKT(J) GO TO 14 1180 B=BO1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B*(5.+3.*EXP(-158.265*HCKT(J))+EXP(-226.977*HCKT(J))) DO 1181 I=2,13 B=BO1(J,I) IF(NLTEON.EQ.-1)B=1. 1181 PART(1)=PART(1)+GO1(I)*B*EXP(-EO1(I)*HCKT(J)) PART(1)=PART(1)+15.*EXP(-101140.*HCKT(J))+ 1 131.*EXP(-103000.*HCKT(J))+128.*EXP(-105000.*HCKT(J))+ 2 600.*EXP(-107000.*HCKT(J)) GO TO 18 1190 B=BNA1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B*2. DO 1191 I=2,8 B=BNA1(J,I) IF(NLTEON.EQ.-1)B=1. 1191 PART(1)=PART(1)+GNA1(I)*B*EXP(-ENA1(I)*HCKT(J)) PART(1)=PART(1)+10.*EXP(-34548.745*HCKT(J))+ 1 14.*EXP(-34586.96*HCKT(J)) G=2. D1=109734.83/4.5/4.5*HCKT(J) GO TO 14 1200 B=BB1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B*(2.+4.*EXP(-15.25*HCKT(J))) DO 1201 I=2,7 B=BB1(J,I) IF(NLTEON.EQ.-1)B=1. 1201 PART(1)=PART(1)+GB1(I)*B*EXP(-EB1(I)*HCKT(J)) PART(1)=PART(1)+6.*EXP(-57786.80*HCKT(J))+ 1 10.*EXP(-59989.*HCKT(J))+14.*EXP(-60031.03*HCKT(J))+ 2 2.*EXP(-63561.*HCKT(J)) G=2. D1=109734.83/4.5/4.5*HCKT(J) GO TO 14 1210 B=BK1(J,1) IF(NLTEON.EQ.-1)B=1. PART(1)=B*2. DO 1211 I=2,8 B=BK1(J,I) IF(NLTEON.EQ.-1)B=1. 1211 PART(1)=PART(1)+GK1(I)*B*EXP(-EK1(I)*HCKT(J)) PART(1)=PART(1)+10.*EXP(-27397.077*HCKT(J))+ 1 14.*EXP(-28127.85*HCKT(J)) G=2. D1=109734.83/5.5/5.5*HCKT(J) GO TO 14 18 CONTINUE C 19 IF(MODE1.EQ.3)GO TO 35 C N=N-NION2 CF=2.*2.4148D15*T(J)*SQRT(T(J))/XNE(J) DO 20 ION=2,NION2 N=N+1 C THE AMIN IS FOR ANY UNFORTUNATE WHO HAS A 360 20 F(ION)=CF*PART(ION)/PART(ION-1)* 1EXP(-MIN((IP(ION-1)-POTLO(ION-1))/TV,75.D0)) F(1)=1. IF(NION2.LT.9)GO TO 1050 FMAX=1. FSAVE(1)=1. DO 1022 ION=2,NION2 FSAVE(ION)=F(ION) 1022 FMAX=MAX(FMAX,F(ION)) DO 1023 IMAX=1,NION2 IF(F(IMAX).EQ.FMAX)GO TO 1024 1023 CONTINUE 1024 IF(IMAX.EQ.1)GO TO 1050 IF(NION2.EQ.2)GO TO 1050 SUM=0. DO 1026 ION=1,NION2 PROD=1. DO 1025 JION=1,NION2 IEX=1 IF(JION.GT.ION.AND.JION.GT.IMAX)GO TO 1025 IF(ION.LE.IMAX)GO TO 1025 IF(JION.LE.IMAX)IEX=-1 IF(IEX.EQ.1)PROD=PROD*F(JION) IF(IEX.EQ.-1)PROD=PROD/F(JION) 1025 CONTINUE 1026 SUM=SUM+PROD F(IMAX)=1./SUM DO 1027 ION=2,IMAX L=IMAX-ION+2 1027 F(L-1)=F(L)/FSAVE(L) IF(IMAX.EQ.NION2)GO TO 35 DO 1028 ION=IMAX+1,NION2 1028 F(ION)=F(ION-1)*FSAVE(ION) GO TO 35 1050 L=NION2+1 DO 21 ION=2,NION2 L=L-1 21 F(1)=1.+F(L)*F(1) F(1)=1./F(1) DO 22 ION=2,NION2 22 F(ION)=F(ION-1)*F(ION) C 35 IF(MODE.LT.10)GO TO 40 GO TO(23,25,27,29),MODE1 23 DO 24 ION=1,NION 24 ANSWER(J,ION)=F(ION)/PART(ION) RETURN 25 DO 26 ION=1,NION 26 ANSWER(J,ION)=F(ION) RETURN 27 DO 28 ION=1,NION 28 ANSWER(J,ION)=PART(ION) RETURN 29 ANSWER(J,1)=0. DO 30 ION=2,NION2 30 ANSWER(J,1)=ANSWER(J,1)+F(ION)*DBLE(ION-1) RETURN 40 GO TO(41,42,43,29),MODE1 41 ANSWER(J,1)=F(NION)/PART(NION) RETURN 42 ANSWER(J,1)=F(NION) RETURN 43 ANSWER(J,1)=PART(NION) RETURN END SUBROUTINE MOLEC(CODOUT,MODE,NUMBER) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION NUMBER(kw,1) REAL*8 NUMBER COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) COMMON /XNMOL/NUMMOL,CODE(160),XNMOL(kw,160) DATA IREAD/0/ IF(IREAD.EQ.1)GO TO 200 IF(IFPRES.EQ.1)GO TO 200 READ(5,151)NUMMOL 151 FORMAT(I5) DO 155 JMOL=1,NUMMOL READ(5,152)CODE(JMOL) 152 FORMAT(F20.2) READ(5,153)(XNMOL(J,JMOL),J=1,NRHOX) 153 FORMAT(1P8E10.3) C 153 FORMAT(0P8E10.3) WRITE(6,154)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX) 154 FORMAT(F20.2/(1P8E10.3)) C 154 FORMAT(F20.2/(0P8E10.3)) 155 CONTINUE READ(5,158) READ(5,158)(XNATOM(J),RHO(J),J=1,NRHOX) WRITE(6,158)(XNATOM(J),RHO(J),J=1,NRHOX) 158 FORMAT(1P8E10.3) C 158 FORMAT(0P8E10.3) C******** READ(5,158) READ(5,158,END=159)(XNE(J),J=1,NRHOX) WRITE(6,158)(XNE(J),J=1,NRHOX) 159 CONTINUE C******** IREAD=1 200 IF(CODOUT.LT.100.)GO TO 300 DO 201 JMOL=1,NUMMOL IF(CODE(JMOL).EQ.CODOUT)GO TO 203 201 CONTINUE DO 207 J=1,NRHOX 207 NUMBER(J,1)=0. RETURN C WRITE(6,202)CODOUT C 202 FORMAT(22H1BETTER LUCK NEXT TIMEF20.2) C CALL EXIT 203 DO 204 J=1,NRHOX C 204 NUMBER(J,ION)=XNMOL(J,JMOL) 204 NUMBER(J,1)=XNMOL(J,JMOL) RETURN 300 C=CODOUT NN=1 IF(MODE.EQ.11)NN=(C-DBLE( INT(C)))*100.+1.5 DO 321 I=1,NN DO 301 JMOL=1,NUMMOL ION=NN-I+1 IF(CODE(JMOL)+.001.GT.C.AND.CODE(JMOL)-.001.LT.C)GO TO 303 301 CONTINUE GO TO 305 303 DO 304 J=1,NRHOX 304 NUMBER(J,ION)=XNMOL(J,JMOL) GO TO 321 305 ID=CODOUT DO 311 JMOL=1,NUMMOL IF( INT(CODE(JMOL)).EQ.ID)GO TO 313 311 CONTINUE GO TO 400 313 DO 314 J=1,NRHOX 314 NUMBER(J,ION)=0. 321 C=C-.01 RETURN 400 ION=(CODOUT-DBLE(ID))*100.+1.5 NN=ION IF(MODE.EQ.1)NN=1 DO 401 J=1,NRHOX CALL PFSAHA(J,ID,ION,MODE,NUMBER) DO 401 I=1,NN 401 NUMBER(J,I)=NUMBER(J,I)*XNATOM(J)*XABUND(ID) RETURN END SUBROUTINE NMOLEC(MODE) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BB/BB1(kw,7),XNFPB(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /BK/BK1(kw,8),XNFPK(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1) COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /ITER/ ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) C JSTART IS USED BY MOLDECK. COMMON /JSTART/JSTART DIMENSION EQUILJ(160),LOCJ(161),KCOMPS(450) DIMENSION XNZ(kw,25) DIMENSION IFEQUA(101) DIMENSION EQUIL(7,160) DIMENSION EQ(25),XN(25),XAB(25),DTERM(25),DEQ(625) DIMENSION FRAC(kw,6) EQUIVALENCE (FRAC(1),DEQ(1)) DIMENSION EQOLD(25) DIMENSION IDEQUA(25) DIMENSION XCODE(8) COMMON /XNMOL/NUMMOL,CODE(160),XNMOL(kw,160) DATA MAXMOL,MAX1,MAXEQ,MAXLOC/160,161,25,450/ C EQUILJ(MAXMOL),LOCJ(MAX1),KCOMPS(MAXLOC) C XNZ(kw,MAXEQ) C EQUIL(6,MAXMOL) C EQ(MAXEQ),XN(MAXEQ),XAB(MAXEQ),DTERM(MAXEQ),DEQ(MAXEQ,MAXEQ) C EQOLD(MAXEQ) C IDEQUA(MAXEQ) C CODE(MAXMOL),XNMOL(kw,MAXMOL) DATA XCODE/1.E14,1.E12,1.E10,1.E8,1.E6,1.E4,1.E2,1.E0/ DATA JSTART/1/ DATA IREAD/0/ C MAKE TABLE OF ALL COMPONENTS OF ALL MOLECULES C SAMPLE CODES FOR ATOMS AND MOLECULES C EXTERNAL CODE INTERNAL COMPONENTS C CARBON DIOXIDE 60808. 6,8,8 C HMINUS 100. 1,100 C NEUTRAL IRON 26. 26 C H2PLUS 101.01 1,1,101 C HYDROGEN ION 1.01 1,101 C SILICON 3+ 14.03 14,101,101,101 IF(IREAD.EQ.1)GO TO 30 IREAD=1 DO 1 JMOL=1,MAXMOL CODE(JMOL)=0. DO 1 J=1,NRHOX 1 XNMOL(J,JMOL)=0. WRITE(6,10) 10 FORMAT(16H1MOLECULES INPUT) DO 11 I=1,101 11 IFEQUA(I)=0 C IF IFEQUA=1 AN EQUATION MUST BE SET UP FOR ELEMENT I KLOC=1 LOCJ(1)=1 DO 20 JMOL=1,MAX1 IF(KLOC.GT.MAXLOC)WRITE(6,199) READ(5,13)C,E1,E2,E3,E4,E5,E6,E7 13 FORMAT(F18.2,F7.3,6E11.4) IF(C.EQ.0.)GO TO 23 WRITE(6,14)JMOL,C,E1,E2,E3,E4,E5,E6,E7 14 FORMAT(I5,F18.2,F7.3,1P6E11.4) DO 15 II=1,8 IF(C.GE.XCODE(II))GO TO 16 15 CONTINUE CALL EXIT 16 X=C DO 17 I=II,8 ID=X/XCODE(I) X=X-DBLE(ID)*XCODE(I) IF(ID.EQ.0)ID=100 IFEQUA(ID)=1 KCOMPS(KLOC)=ID 17 KLOC=KLOC+1 ION=X*100.+.5 IF(ION.LT.1)GO TO 19 IFEQUA(100)=1 IFEQUA(101)=1 DO 18 I=1,ION KCOMPS(KLOC)=101 18 KLOC=KLOC+1 19 LOCJ(JMOL+1)=KLOC CODE(JMOL)=C EQUIL(1,JMOL)=E1 EQUIL(2,JMOL)=E2 EQUIL(3,JMOL)=E3 EQUIL(4,JMOL)=E4 EQUIL(5,JMOL)=E5 EQUIL(6,JMOL)=E6 20 EQUIL(7,JMOL)=E7 WRITE(6,199) 199 FORMAT(19H1TOO MANY MOLECULES) 23 NUMMOL=JMOL-1 NLOC=KLOC-1 C ASSIGN AN EQUATION NUMBER TO EACH COMPONENT C THE FIRST EQUATION IS FOR THE TOTAL NUMBER OF PARTICLES C THE FIRST VARIABLE IS XNATOM C IF ANY COMPONENT IS 100 OR 101 VARIABLE NEQUA IS XNE C AND EQUATION NEQUA IS CHARGE CONSERVATION C FOR PROGRAMMING CONVENIENCE VARIABLE NEQUA1 IS INVERSE XNE C DIMENSIONS ARE SET FOR A MAXIMUM 25 EQUATIONS IEQUA=1 DO 25 I=1,100 IF(IFEQUA(I).EQ.0)GO TO 25 IEQUA=IEQUA+1 IFEQUA(I)=IEQUA IDEQUA(IEQUA)=I 25 CONTINUE NEQUA=IEQUA NEQUA1=NEQUA+1 IFEQUA(101)=NEQUA1 NEQNEQ=NEQUA**2 DO 28 KLOC=1,NLOC ID=KCOMPS(KLOC) 28 KCOMPS(KLOC)=IFEQUA(ID) WRITE(6,29) NUMMOL,MAXMOL,NLOC,MAXLOC,NEQUA,MAXEQ 29 FORMAT(16H MOLECULES USED,I4,5H MAX,I4/ 1 16H COMPONENTS USED,I4,5H MAX,I4/ 2 16H EQUATIONS USED,I4,5H MAX,I4) C 30 DO 31 K=2,NEQUA ID=IDEQUA(K) IF(ID.LT.100)XAB(K)= MAX (XABUND(ID),1.D-20) 31 CONTINUE IF(ID.EQ.100)XAB(NEQUA)=0. XNTOT=P(JSTART)/TK(JSTART) XN(1)=XNTOT/2. X=XN(1)/10. DO 32 K=2,NEQUA 32 XN(K)=X*XAB(K) IF(ID.EQ.100)XN(NEQUA)=X XNE(1)=X DO 110 J=JSTART,NRHOX C C CORRECTIONS TO THE EQUILIBRIUM CONSTANTS FOR NON-LTE NLTEON=-1 CALL PFSAHA(J, 1,1,3,FRAC) PFH =FRAC(J,1) CALL PFSAHA(J, 6,1,3,FRAC) PFC =FRAC(J,1) CALL PFSAHA(J, 8,1,3,FRAC) PFO =FRAC(J,1) CALL PFSAHA(J,12,1,3,FRAC) PFMG=FRAC(J,1) CALL PFSAHA(J,13,1,3,FRAC) PFAL=FRAC(J,1) CALL PFSAHA(J,14,1,3,FRAC) PFSI=FRAC(J,1) CALL PFSAHA(J,20,1,3,FRAC) PFCA=FRAC(J,1) NLTEON=0 CALL PFSAHA(J, 1,1,3,FRAC) BPFH =FRAC(J,1) CALL PFSAHA(J, 6,1,3,FRAC) BPFC =FRAC(J,1) CALL PFSAHA(J, 8,1,3,FRAC) BPFO =FRAC(J,1) CALL PFSAHA(J,12,1,3,FRAC) BPFMG=FRAC(J,1) CALL PFSAHA(J,13,1,3,FRAC) BPFAL=FRAC(J,1) CALL PFSAHA(J,14,1,3,FRAC) BPFSI=FRAC(J,1) CALL PFSAHA(J,20,1,3,FRAC) BPFCA=FRAC(J,1) CPFH =PFH /BPFH *BHYD(J,1) CPFC =PFC /BPFC *BC1(J,1) CPFO =PFO /BPFO *BO1(J,1) CPFMG=PFMG/BPFMG*BMG1(J,1) CPFAL=PFAL/BPFAL*BAL1(J,1) CPFSI=PFSI/BPFSI*BSI1(J,1) CPFCA=PFCA/BPFCA*BCA1(J,1) C XNTOT=P(J)/TK(J) IF(J.EQ.1)GO TO 34 RATIO=P(J)/P(J-1) XNE(J)=XNE(J-1)*RATIO DO 33 K=1,NEQUA 33 XN(K)=XN(K)*RATIO 34 DO 37 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) IF(EQUIL(1,JMOL).EQ.0.)GO TO 35 ION=(CODE(JMOL)-DBLE( INT(CODE(JMOL))))*100.+.5 EQUILJ(JMOL)=0. IF(T(J).GT.10000.)GO TO 37 EQUILJ(JMOL)=EXP(EQUIL(1,JMOL)/TKEV(J)-EQUIL(2,JMOL)+ 1(EQUIL(3,JMOL)+(-EQUIL(4,JMOL)+(EQUIL(5,JMOL)+(-EQUIL(6,JMOL)+ 2+EQUIL(7,JMOL)* 3T(J))*T(J))*T(J))*T(J))*T(J)-1.5*(DBLE(NCOMP-ION-ION-1))*TLOG(J)) LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 1037 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) ID=IDEQUA(K) IF(ID.EQ. 1)EQUILJ(JMOL)=EQUILJ(JMOL)*CPFH IF(ID.EQ. 6)EQUILJ(JMOL)=EQUILJ(JMOL)*CPFC IF(ID.EQ. 8)EQUILJ(JMOL)=EQUILJ(JMOL)*CPFO IF(ID.EQ.12)EQUILJ(JMOL)=EQUILJ(JMOL)*CPFMG IF(ID.EQ.13)EQUILJ(JMOL)=EQUILJ(JMOL)*CPFAL IF(ID.EQ.14)EQUILJ(JMOL)=EQUILJ(JMOL)*CPFSI IF(ID.EQ.20)EQUILJ(JMOL)=EQUILJ(JMOL)*CPFCA 1037 CONTINUE GO TO 37 35 IF(NCOMP.GT.1)GO TO 36 EQUILJ(JMOL)=1. GO TO 37 36 ID=CODE(JMOL) ION=NCOMP-1 CALL PFSAHA(J,ID,NCOMP,12,FRAC) EQUILJ(JMOL)=FRAC(J,NCOMP)/FRAC(J,1)*XNE(J)**ION 37 CONTINUE DO 48 K=1,NEQUA 48 EQOLD(K)=0. C C SET UP 1ST ORDER EQUATIONS FOR THE CHANGE IN NUMBER DENSITY OF C EACH ELEMENT. 50 DO 60 KL=1,NEQNEQ 60 DEQ(KL)=0. EQ(1)=-XNTOT K1=1 KK=1 DO 61 K=2,NEQUA EQ(1)=EQ(1)+XN(K) K1=K1+NEQUA C K1 IS ACTUALLY 1K DEQ(K1)=1. EQ(K)=XN(K)-XAB(K)*XN(1) KK=KK+NEQUA1 DEQ(KK)=1. 61 DEQ(K)=-XAB(K) IF(IDEQUA(NEQUA).LT.100)GO TO 62 EQ(NEQUA)=-XN(NEQUA) DEQ(NEQNEQ)=-1. 62 CONTINUE DO 99 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) IF(NCOMP.EQ.1)GO TO 99 TERM=EQUILJ(JMOL) LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 80 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.EQ.NEQUA1)GO TO 79 TERM=TERM*XN(K) GO TO 80 79 TERM=TERM/XN(NEQUA) 80 CONTINUE EQ(1)=EQ(1)+TERM DO 85 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.LT.NEQUA1)GO TO 81 K=NEQUA D=-TERM/XN(K) GO TO 82 81 D=TERM/XN(K) 82 EQ(K)=EQ(K)+TERM NEQUAK=NEQUA*K-NEQUA K1=NEQUAK+1 DEQ(K1)=DEQ(K1)+D DO 83 LOCM=LOCJ1,LOCJ2 M=KCOMPS(LOCM) IF(M.EQ.NEQUA1)M=NEQUA MK=M+NEQUAK 83 DEQ(MK)=DEQ(MK)+D 85 CONTINUE C C CORRECTION TO CHARGE EQUATION FOR NEGATIVE IONS K=KCOMPS(LOCJ2) IF(IDEQUA(K).NE.100)GO TO 99 DO 95 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) D=TERM/XN(K) IF(K.EQ.NEQUA)EQ(K)=EQ(K)-TERM-TERM NEQUAK=NEQUA*K-NEQUA DO 93 LOCM=LOCJ1,LOCJ2 M=KCOMPS(LOCM) IF(M.NE.NEQUA)GO TO 93 MK=M+NEQUAK DEQ(MK)=DEQ(MK)-D-D 93 CONTINUE 95 CONTINUE C 99 CONTINUE C CALL SOLVIT(DEQ,NEQUA,EQ,DTERM) IFERR=0 SCALE=100. DO 105 K=1,NEQUA RATIO=ABS(EQ(K)/XN(K)) IF(RATIO.GT..001)IFERR=1 IF(EQOLD(K)*EQ(K).LT.0.)EQ(K)=EQ(K)*.69 XNEQ=XN(K)-EQ(K) XN100=XN(K)/100. IF(XNEQ.LT.XN100)GO TO 101 XN100=XN(K)*100. C IF(XNEQ.GT.XN100)GO TO 102 XN(K)=XNEQ GO TO 105 101 XN(K)=XN(K)/SCALE IF(EQOLD(K)*EQ(K).LT.0.)SCALE=SQRT(SCALE) GO TO 105 102 XN(K)=XN100 105 EQOLD(K)=EQ(K) IF(IFERR.EQ.1)GO TO 50 C DO 107 K=1,NEQUA 107 XNZ(J,K)=XN(K) XNATOM(J)=XN(1) RHO(J)=XNATOM(J)*WTMOLE*1.660E-24 IF(IDEQUA(NEQUA).EQ.100)XNE(J)=XN(NEQUA) DO 109 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) XNMOL(J,JMOL)=EQUILJ(JMOL) LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 109 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.EQ.NEQUA1)GO TO 108 XNMOL(J,JMOL)=XNMOL(J,JMOL)*XN(K) GO TO 109 108 XNMOL(J,JMOL)=XNMOL(J,JMOL)/XN(NEQUA) 109 CONTINUE 110 CONTINUE IF(ITER.LT.NUMITS)GO TO 120 WRITE(6,112)(J,RHOX(J),T(J),P(J),XNE(J),XNATOM(J),RHO(J), 1J=1,NRHOX) 112 FORMAT(1H1////11X4HRHOX,9X1HT,11X1HP,10X3HXNE,8X6HXNATOM,8X3HRHO/ 1(I5,1P6E12.3)) C 1(I5,0P6E12.3)) NN=(NUMMOL/10)*10 IF(NN.LT.NUMMOL)NN=NN+10 DO 111 JMOL1=1,NN,10 JMOL10=JMOL1+9 111 WRITE(6,113)(CODE(JMOL),JMOL=JMOL1,JMOL10),(J,(XNMOL(J,JMOL), 1JMOL=JMOL1,JMOL10),J=1,NRHOX) 113 FORMAT(1H1////50X26HMOLECULAR NUMBER DENSITIES/5X10F12.2/ 1(I5,1P10E12.3)) C 1(I5,0P10E12.3)) 120 IF(MODE.EQ.2.OR.MODE.EQ.12)GO TO 149 DO 125 K=2,NEQUA ID=IDEQUA(K) IF(ID.EQ.100)GO TO 122 DO 121 J=JSTART,NRHOX C CALCULATE PARTITION FUNCTIONS CALL PFSAHA(J,ID,1,3,FRAC) IF(ID.EQ. 1)FRAC(J,1)=FRAC(J,1)/BHYD(J,1) IF(ID.EQ. 6)FRAC(J,1)=FRAC(J,1)/BC1(J,1) IF(ID.EQ. 8)FRAC(J,1)=FRAC(J,1)/BO1(J,1) IF(ID.EQ.12)FRAC(J,1)=FRAC(J,1)/BMG1(J,1) IF(ID.EQ.13)FRAC(J,1)=FRAC(J,1)/BAL1(J,1) IF(ID.EQ.14)FRAC(J,1)=FRAC(J,1)/BSI1(J,1) IF(ID.EQ.20)FRAC(J,1)=FRAC(J,1)/BCA1(J,1) 121 XNZ(J,K)=XNZ(J,K)/FRAC(J,1)/1.8786E20/SQRT((ATMASS(ID)*T(J))**3) GO TO 125 122 DO 123 J=JSTART,NRHOX 123 XNZ(J,K)=XNZ(J,K)/2./2.4148D15/T(J)/SQRT(T(J)) 125 CONTINUE DO 140 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) IF(EQUIL(1,JMOL).EQ.0.)GO TO 135 DO 126 J=JSTART,NRHOX C 126 XNMOL(J,JMOL)=EXP(EQUIL(1,JMOL)/T(J)) 126 XNMOL(J,JMOL)=EXP(EQUIL(1,JMOL)/TKEV(J)) AMASS=0. LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 130 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.EQ.NEQUA1)GO TO 128 ID=IDEQUA(K) IF(ID.LT.100)AMASS=AMASS+ATMASS(ID) DO 127 J=JSTART,NRHOX 127 XNMOL(J,JMOL)=XNMOL(J,JMOL)*XNZ(J,K) GO TO 130 128 DO 129 J=JSTART,NRHOX 129 XNMOL(J,JMOL)=XNMOL(J,JMOL)/XNZ(J,NEQUA) 130 CONTINUE DO 131 J=JSTART,NRHOX 131 XNMOL(J,JMOL)=XNMOL(J,JMOL)*1.8786E20*SQRT((AMASS*T(J))**3) GO TO 140 135 ID=CODE(JMOL) DO 136 J=JSTART,NRHOX CALL PFSAHA(J,ID,NCOMP,3,FRAC) 136 XNMOL(J,JMOL)=XNMOL(J,JMOL)/FRAC(J,1) 140 CONTINUE 149 IF(IFPNCH(ITER).NE.5)RETURN WRITE(6,150) 150 FORMAT(1H120X38HNUMBER DENSITIES / PARTITION FUNCTIONS) WRITE(6,151)NUMMOL WRITE(7,151)NUMMOL 151 FORMAT(I5,10H MOLECULES) DO 155 JMOL=1,NUMMOL WRITE(6,152)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX) WRITE(7,152)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX) 152 FORMAT(F20.2/(1P8E10.3)) C 152 FORMAT(F20.2/(0P8E10.3)) 155 CONTINUE WRITE(6,158)(XNATOM(J),RHO(J),J=1,NRHOX) WRITE(7,158)(XNATOM(J),RHO(J),J=1,NRHOX) 158 FORMAT(11H XNATOM,RHO/(1P8E10.3)) C 158 FORMAT(11H XNATOM,RHO/(0P8E10.3)) RETURN END SUBROUTINE KAPP(N,NSTEPS,STEPWT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BB/BB1(kw,7),XNFPB(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2) COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /BK/BK1(kw,8),XNFPK(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1) COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /OPTOT/ACONT(kw),SCONT(kw),ALINE(kw),SLINE(kw),SIGMAC(kw), 1 SIGMAL(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DATA ITEMP1/0/ 90 STEPWT=1. NSTEPS=1 IF(N.GT.1)GO TO 200 DO 91 J=1,NRHOX AHYD(J)=0. AHMIN(J)=0. AH2P(J)=0. AHE1(J)=0. AHE2(J)=0. AHEMIN(J)=0. AC1(J)=0. AMG1(J)=0. AAL1(J)=0. ASI1(J)=0. AFE1(J)=0. ACOOL(J)=0. ALUKE(J)=0. AHOT(J)=0. AHLINE(J)=0. ALINES(J)=0. AXLINE(J)=0. AXCONT(J)=0. SIGH(J)=0. SIGH2(J)=0. SIGHE(J)=0. SIGEL(J)=0. SIGLIN(J)=0. SIGXL(J)=0. SIGX(J)=0. SHYD(J)=0. SHMIN(J)=0. SHLINE(J)=0. SHE1(J)=0. SHE2(J)=0. SC1(J)=0. SMG1(J)=0. SAL1(J)=0. SSI1(J)=0. SFE1(J)=0. SXLINE(J)=0. SXCONT(J)=0. 91 CONTINUE IF(IFOP(1).EQ.1)CALL HOP IF(IFOP(2).EQ.1)CALL H2PLOP IF(IFOP(3).EQ.1)CALL HMINOP IF(IFOP(4).EQ.1)CALL HRAYOP IF(IFOP(5).EQ.1)CALL HE1OP IF(IFOP(6).EQ.1)CALL HE2OP IF(IFOP(7).EQ.1)CALL HEMIOP IF(IFOP(8).EQ.1)CALL HERAOP IF(IFOP(9).EQ.1)CALL COOLOP IF(IFOP(10).EQ.1)CALL LUKEOP IF(IFOP(11).EQ.1)CALL HOTOP IF(IFOP(12).EQ.1)CALL ELECOP IF(IFOP(13).EQ.1)CALL H2RAOP IF(IFOP(14).EQ.1.AND.N.GT.0)CALL HLINOP IF(IFOP(15).EQ.1.AND.N.GT.0)CALL LINOP(N,NSTEPS,STEPWT) IF(IFOP(16).EQ.1.AND.N.GT.0)CALL LINSOP(N,NSTEPS,STEPWT) IF(IFOP(17).EQ.1.AND.N.GT.0)CALL XLINOP IF(IFOP(18).EQ.1.AND.N.GT.0)CALL XLISOP IF(IFOP(19).EQ.1)CALL XCONOP IF(IFOP(20).EQ.1)CALL XSOP DO 100 J=1,NRHOX A=AH2P(J)+AHEMIN(J)+ALUKE(J)+AHOT(J) ACONT(J)=A+AHYD(J)+AHMIN(J)+AXCONT(J)+AHE1(J)+AHE2(J)+AC1(J)+ 1AMG1(J)+AAL1(J)+ASI1(J)+AFE1(J) SCONT(J)=BNU(J) IF(ACONT(J).GT.0.)SCONT(J)=(A*BNU(J)+AHYD(J)*SHYD(J)+AHMIN(J)* 1SHMIN(J)+AXCONT(J)*SXCONT(J)+AHE1(J)*SHE1(J)+AHE2(J)*SHE2(J)+ 2AC1(J)*SC1(J)+AMG1(J)*SMG1(J)+AAL1(J)*SAL1(J)+ASI1(J)*SSI1(J)+ 3AFE1(J)*SFE1(J))/ACONT(J) ALINE(J)=AHLINE(J)+ALINES(J)+AXLINE(J) SLINE(J)=BNU(J) IF(ALINE(J).GT.0.)SLINE(J)=(AHLINE(J)*SHLINE(J)+ALINES(J)*BNU(J)+ 1AXLINE(J)*SXLINE(J))/ALINE(J) SIGMAC(J)=SIGH(J)+SIGHE(J)+SIGEL(J)+SIGH2(J)+SIGX(J) 100 SIGMAL(J)=SIGLIN(J)+SIGXL(J) RETURN 200 IF(IFOP(15).EQ.1)CALL LINOP(N,NSTEPS,STEPWT) IF(IFOP(16).EQ.1)CALL LINSOP(N,NSTEPS,STEPWT) DO 201 J=J1,J2 ALINE(J)=AHLINE(J)+ALINES(J)+AXLINE(J) IF(ALINE(J).GT.0.)SLINE(J)=(AHLINE(J)*SHLINE(J)+ALINES(J)*BNU(J)+ 1AXLINE(J)*SXLINE(J))/ALINE(J) 201 SIGMAL(J)=SIGLIN(J)+SIGXL(J) RETURN END SUBROUTINE HOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C REQUIRES FUNCTION COULFF COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) FREQ3=2.815E29/FREQ/FREQ/FREQ DO 100 J=1,NRHOX C LIMIT 109678.764 RYDBERG 109677.576 C N=9 TO INFINITY H=FREQ3*2./2./(109677.576*HCKT(J))* 1(EXP(-MAX(108324.719D0,109678.764D0-WAVENO)*HCKT(J))- 2EXP(-109678.764*HCKT(J)))*STIM(J) S=H*BNU(J) C N=8 IF(WAVENO.LT.1713.713)GO TO 30 X=FREQ3/32768. A=X*128.*EXP(-107965.051*HCKT(J))*STIM(J) H=H+A S=S+A*BNU(J) C N=7 IF(WAVENO.LT.2238.320)GO TO 30 X=FREQ3/16807. A=X*98.*EXP(-107440.444*HCKT(J))*STIM(J) H=H+A S=S+A*BNU(J) C N=6 IF(WAVENO.LT.3046.604)GO TO 30 X=FREQ3/7776.*(1.0986+(-2.704E13+1.229E27/FREQ)/FREQ) A=X*72.*EXP(-106632.160*HCKT(J))*(BHYD(J,6)-EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHYD(J,6)-EHVKT(J)) C N=5 IF(WAVENO.LT.4387.113)GO TO 30 X=FREQ3/3125.*(1.102+(-3.909E13+2.371E27/FREQ)/FREQ) A=X*50.*EXP(-105291.651*HCKT(J))*(BHYD(J,5)-EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHYD(J,5)-EHVKT(J)) C N=4 IF(WAVENO.LT.6854.871)GO TO 30 X=FREQ3/1024.*(1.101+(-5.765E13+4.593E27/FREQ)/FREQ) A=X*32.*EXP(-102823.893*HCKT(J))*(BHYD(J,4)-EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHYD(J,4)-EHVKT(J)) C N=3 IF(WAVENO.LT.12186.462)GO TO 30 CTYPO X=FREQ3/343.*(1.101+(-9.863E13+1.035E28/FREQ)/FREQ) X=FREQ3/243.*(1.101+(-9.863E13+1.035E28/FREQ)/FREQ) A=X*18.*EXP(- 97492.302*HCKT(J))*(BHYD(J,3)-EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHYD(J,3)-EHVKT(J)) C N=2 IF(WAVENO.LT.27419.659)GO TO 30 X=FREQ3/32.*(1.105+(-2.375E14+4.077E28/FREQ)/FREQ) A=X* 8.*EXP(- 82259.105*HCKT(J))*(BHYD(J,2)-EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHYD(J,2)-EHVKT(J)) C N=1 IF(WAVENO.LT.109678.764)GO TO 30 X=FREQ3/1.*(.9916+(2.719E13-2.268E30/FREQ)/FREQ) A=X* 2.*1. *(BHYD(J,1)-EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHYD(J,1)-EHVKT(J)) C 30 H=H*XNFPH(J,1)/RHO(J) S=S*XNFPH(J,1)/RHO(J) C FREE-FREE A=3.6919E8/SQRT(T(J))*COULFF(J,1)/FREQ*XNE(J)/FREQ*XNFPH(J,2)/ 1FREQ*STIM(J)/RHO(J) H=H+A S=S+A*BNU(J) AHYD(J)=H IF(H.GT.0.)SHYD(J)=S/H 100 CONTINUE RETURN END FUNCTION COULFF(J,NZ) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION Z4LOG(6),A(11,12) DATA Z4LOG/0.,1.20412,1.90849,2.40824,2.79588,3.11261/ DATA A/ 15.53,5.49,5.46,5.43,5.40,5.25,5.00,4.69,4.48,4.16,3.85, 24.91,4.87,4.84,4.80,4.77,4.63,4.40,4.13,3.87,3.52,3.27, 34.29,4.25,4.22,4.18,4.15,4.02,3.80,3.57,3.27,2.98,2.70, 43.64,3.61,3.59,3.56,3.54,3.41,3.22,2.97,2.70,2.45,2.20, 53.00,2.98,2.97,2.95,2.94,2.81,2.65,2.44,2.21,2.01,1.81, 62.41,2.41,2.41,2.41,2.41,2.32,2.19,2.02,1.84,1.67,1.50, 71.87,1.89,1.91,1.93,1.95,1.90,1.80,1.68,1.52,1.41,1.30, 81.33,1.39,1.44,1.49,1.55,1.56,1.51,1.42,1.33,1.25,1.17, 90.90,0.95,1.00,1.08,1.17,1.30,1.32,1.30,1.20,1.15,1.11, A0.55,0.58,0.62,0.70,0.85,1.01,1.15,1.18,1.15,1.11,1.08, B0.33,0.36,0.39,0.46,0.59,0.76,0.97,1.09,1.13,1.10,1.08, C0.19,0.21,0.24,0.28,0.38,0.53,0.76,0.96,1.08,1.09,1.09/ C ERROR CORRECTED 5AUG93 (SHOULD HAVE BEEN 13APR88) C A0.45,0.48,0.52,0.60,0.75,0.91,1.15,1.18,1.15,1.11,1.08, C C GAMLOG= LOG10(158000*Z*Z/T)*2 GAMLOG=10.39638-TLOG(J)/1.15129+Z4LOG(NZ) IGAM=MAX0(MIN0( INT(GAMLOG+7.),10),1) C HVKTLG= LOG10(HVKT)*2 HVKTLG=(FREQLG-TLOG(J))/1.15129-20.63764 IHVKT=MAX0(MIN0( INT(HVKTLG+9.),11),1) P=GAMLOG-DBLE(IGAM-7) Q=HVKTLG-DBLE(IHVKT-9) COULFF=(1.-P)*((1.-Q)*A(IGAM,IHVKT)+Q*A(IGAM,IHVKT+1))+ 1P*((1.-Q)*A(IGAM+1,IHVKT)+Q*A(IGAM+1,IHVKT+1)) RETURN END SUBROUTINE H2PLOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) IF(FREQ.GT.3.28805D15)RETURN FR=-3.0233E3+(3.7797E2+(-1.82496E1+(3.9207E-1-3.1672E-3*FREQLG)* 1FREQLG)*FREQLG)*FREQLG FREQ15=FREQ/1.E15 ES=-7.342E-3+(-2.409E-00+(1.028E-00+(-4.230E-01+(1.224E-01- 1 1.351E-02*FREQ15)*FREQ15)*FREQ15)*FREQ15)*FREQ15 DO 10 J=1,NRHOX C 10 AH2P(J)=EXP(-ES/TKEV(J)+FR)*XNFPH(J,1)*2.*BHYD(J,1)*XNFPH(J,2)/ C 1RHO(J)*STIM(J) 10 AH2P(J)=EXP(-ES/TKEV(J)+FR+LOG(XNFPH(J,1)))*2.*BHYD(J,1)* 1XNFPH(J,2)/RHO(J)*STIM(J) RETURN END SUBROUTINE HMINOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION XHMIN(kw) DIMENSION WBF(85),BF(85),FFLOG(22,11),FF(11,22) DIMENSION FFBEG(11,11),FFEND(11,11),FFTT(11),WFFLOG(22) DIMENSION THETA(kw),FFTHETA(kw),THETAFF(11),WAVEK(22) EQUIVALENCE (FF(1,1),FFBEG(1,1)),(FF(1,12),FFEND(1,1)) C FROM MATHISEN (1984), AFTER WISHART(1979) AND BROAD AND REINHARDT (1976) DATA WBF/ 18.00, 19.60, 21.40, 23.60, 26.40, 29.80, 34.30, 1 40.40, 49.10, 62.60, 111.30, 112.10, 112.67, 112.95, 113.05, 2 113.10, 113.20, 113.23, 113.50, 114.40, 121.00, 139.00, 164.00, 3 175.00, 200.00, 225.00, 250.00, 275.00, 300.00, 325.00, 350.00, 4 375.00, 400.00, 425.00, 450.00, 475.00, 500.00, 525.00, 550.00, 5 575.00, 600.00, 625.00, 650.00, 675.00, 700.00, 725.00, 750.00, 6 775.00, 800.00, 825.00, 850.00, 875.00, 900.00, 925.00, 950.00, 7 975.00,1000.00,1025.00,1050.00,1075.00,1100.00,1125.00,1150.00, 8 1175.00,1200.00,1225.00,1250.00,1275.00,1300.00,1325.00,1350.00, 9 1375.00,1400.00,1425.00,1450.00,1475.00,1500.00,1525.00,1550.00, A 1575.00,1600.00,1610.00,1620.00,1630.00,1643.91/ DATA BF/ 0.067, 0.088, 0.117, 0.155, 0.206, 0.283, 0.414, 1 0.703, 1.24, 2.33, 11.60, 13.90, 24.30, 66.70, 95.00, 2 56.60, 20.00, 14.60, 8.50, 7.10, 5.43, 5.91, 7.29, 3 7.918, 9.453, 11.08, 12.75, 14.46, 16.19, 17.92, 19.65, 4 21.35, 23.02, 24.65, 26.24, 27.77, 29.23, 30.62, 31.94, 5 33.17, 34.32, 35.37, 36.32, 37.17, 37.91, 38.54, 39.07, 6 39.48, 39.77, 39.95, 40.01, 39.95, 39.77, 39.48, 39.06, 7 38.53, 37.89, 37.13, 36.25, 35.28, 34.19, 33.01, 31.72, 8 30.34, 28.87, 27.33, 25.71, 24.02, 22.26, 20.46, 18.62, 9 16.74, 14.85, 12.95, 11.07, 9.211, 7.407, 5.677, 4.052, A 2.575, 1.302, 0.8697, 0.4974, 0.1989, 0. / C Bell and Berrington J.Phys.B,vol. 20, 801-806,1987. DATA WAVEK/.50,.40,.35,.30,.25,.20,.18,.16,.14,.12,.10,.09,.08, 1 .07,.06,.05,.04,.03,.02,.01,.008,.006/ DATA THETAFF/ 1 0.5, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.8, 3.6/ DATA FFBEG/ 1.0178,.0222,.0308,.0402,.0498,.0596,.0695,.0795,.0896, .131, .172, 1823 2.0228,.0280,.0388,.0499,.0614,.0732,.0851,.0972, .110, .160, .211, 2278 3.0277,.0342,.0476,.0615,.0760,.0908, .105, .121, .136, .199, .262, 2604 4.0364,.0447,.0616,.0789,.0966, .114, .132, .150, .169, .243, .318, 3038 5.0520,.0633,.0859, .108, .131, .154, .178, .201, .225, .321, .418, 3645 6.0791,.0959, .129, .161, .194, .227, .260, .293, .327, .463, .602, 4557 7.0965, .117, .157, .195, .234, .272, .311, .351, .390, .549, .711, 5063 8 .121, .146, .195, .241, .288, .334, .381, .428, .475, .667, .861, 5696 9 .154, .188, .249, .309, .367, .424, .482, .539, .597, .830, 1.07, 6510 A .208, .250, .332, .409, .484, .557, .630, .702, .774, 1.06, 1.36, 7595 B .293, .354, .468, .576, .677, .777, .874, .969, 1.06, 1.45, 1.83/ 9113 DATA FFEND/ 1 .358, .432, .572, .702, .825, .943, 1.06, 1.17, 1.28, 1.73, 2.17, 10126 2 .448, .539, .711, .871, 1.02, 1.16, 1.29, 1.43, 1.57, 2.09, 2.60, 11392 3 .579, .699, .924, 1.13, 1.33, 1.51, 1.69, 1.86, 2.02, 2.67, 3.31, 13019 4 .781, .940, 1.24, 1.52, 1.78, 2.02, 2.26, 2.48, 2.69, 3.52, 4.31, 15189 5 1.11, 1.34, 1.77, 2.17, 2.53, 2.87, 3.20, 3.51, 3.80, 4.92, 5.97, 18227 6 1.73, 2.08, 2.74, 3.37, 3.90, 4.50, 5.01, 5.50, 5.95, 7.59, 9.06, 22784 7 3.04, 3.65, 4.80, 5.86, 6.86, 7.79, 8.67, 9.50, 10.3, 13.2, 15.6, 30378 8 6.79, 8.16, 10.7, 13.1, 15.3, 17.4, 19.4, 21.2, 23.0, 29.5, 35.0, 45567 9 27.0, 32.4, 42.6, 51.9, 60.7, 68.9, 76.8, 84.2, 91.4, 117., 140., 91134 A 42.3, 50.6, 66.4, 80.8, 94.5, 107., 120., 131., 142., 183., 219., 113918 B 75.1, 90.0, 118., 144., 168., 191., 212., 234., 253., 325., 388./ 151890 DATA ITEMP1,ISTART/0,0/ IF(ISTART.EQ.0)THEN ISTART=1 DO 2 IWAVE=1,22 C 91.134 NUMBER TAKEN FROM BELL AND BERRINGTON WFFLOG(IWAVE)=DLOG(91.134D0/WAVEK(IWAVE)) DO 2 ITHETA=1,11 C CHANGE FROM PER PE TO PER NE BY MULTIPLYING BY KT C 2 FFLOG(IWAVE,ITHETA)=DLOG(FF(ITHETA,IWAVE)/THETAFF(ITHETA)*5040.* C 1 1.380658E-16*1.E-26) C AVOID UNDERFLOW 2 FFLOG(IWAVE,ITHETA)=DLOG(FF(ITHETA,IWAVE)/THETAFF(ITHETA)*5040.* 1 1.380658E-16) ENDIF IF(ITEMP.EQ.ITEMP1)GO TO 20 ITEMP1=ITEMP DO 11 J=1,NRHOX THETA(J)=5040./T(J) C .754209 HOTOP AND LINEBERGER J.PHYS.CHEM.REF.DATA VOL 14,731-752,1985. 11 XHMIN(J)=EXP(.754209/TKEV(J))/(2.*2.4148E15*T(J)*SQRT(T(J)))* 1BMIN(J)*BHYD(J,1)*XNFPH(J,1)*XNE(J) 20 WAVE=2.99792458E17/FREQ WAVELOG=DLOG(WAVE) DO 21 ITHETA=1,11 CALL LINTER(WFFLOG,FFLOG(1,ITHETA),22,WAVELOG,FFTLOG,1) 21 FFTT(ITHETA)=EXP(FFTLOG) HMINBF=0. IF(FREQ.GT.1.82365E14)MAXWAVE=MAP1(WBF,BF,85,WAVE,HMINBF,1) DO 31 J=1,NRHOX CALL LINTER(THETAFF,FFTT,11,THETA(J),FFTHETA(J),1) HMINFF=FFTHETA(J)*XNFPH(J,1)*2.*BHYD(J,1)*XNE(J)/RHO(J)*1.E-26 97 FORMAT(I5,F10.4,F10.4,1PE12.4) H=HMINBF*1.E-18*(1.-EHVKT(J)/BMIN(J))*XHMIN(J)/RHO(J) AHMIN(J)=H+HMINFF 31 SHMIN(J)=(H*BNU(J)*STIM(J)/(BMIN(J)-EHVKT(J))+HMINFF*BNU(J))/ 1AHMIN(J) RETURN END SUBROUTINE LINTER(XOLD,YOLD,NOLD,XNEW,YNEW,NNEW) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION XOLD(1),YOLD(1),XNEW(1),YNEW(1) C XOLD AND XNEW INCREASING IOLD=2 DO 2 INEW=1,NNEW 1 IF(XNEW(INEW).LT.XOLD(IOLD))GO TO 2 IF(IOLD.EQ.NOLD)GO TO 2 IOLD=IOLD+1 GO TO 1 2 YNEW(INEW)=YOLD(IOLD-1)+(YOLD(IOLD)-YOLD(IOLD-1))/ 1(XOLD(IOLD)-XOLD(IOLD-1))*(XNEW(INEW)-XOLD(IOLD-1)) RETURN END SUBROUTINE HRAYOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) WAVE=2.997925E18/ MIN (FREQ,2.463D15) WW=WAVE**2 SIG=(5.799E-13+1.422E-6/WW+2.784/(WW*WW))/(WW*WW) DO 2 J=1,NRHOX 2 SIGH(J)=SIG*XNFPH(J,1)*2.*BHYD(J,1)/RHO(J) RETURN END SUBROUTINE HE1OP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C REQUIRES FUNCTION COULFF COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) FREQ3=2.815E29/FREQ/FREQ/FREQ DO 100 J=1,NRHOX C LIMIT 198310.76 RYDBERG 109722.267 C N=6 TO INFINITY BHE1=BHE2 H=FREQ3*4./2./(109722.267*HCKT(J))* 1(EXP(-MAX(195262.919D0,198310.76D0-WAVENO)*HCKT(J))- 2EXP(-198310.76*HCKT(J)))*STIM(J)*BHE2(J,1) S=H*BNU(J) C 5P 1P IF(WAVENO.LT.4368.190)GO TO 30 X=FREQ3/3125. A=X* 3.*EXP(-193942.57 *HCKT(J))*(BHE1(J,29)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,29)/BHE2(J,1)-EHVKT(J)) C 5G 1G IF(WAVENO.LT.4388.260)GO TO 30 X=FREQ3/3125. A=X* 9.*EXP(-193922.5 *HCKT(J))*(BHE1(J,28)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,28)/BHE2(J,1)-EHVKT(J)) C 5G 3G IF(WAVENO.LT.4388.260)GO TO 30 X=FREQ3/3125. A=X*27.*EXP(-193922.5 *HCKT(J))*(BHE1(J,27)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,27)/BHE2(J,1)-EHVKT(J)) C 5F 1F IF(WAVENO.LT.4389.390)GO TO 30 X=FREQ3/3125. A=X* 7.*EXP(-193921.37 *HCKT(J))*(BHE1(J,26)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,26)/BHE2(J,1)-EHVKT(J)) C 5F 3F IF(WAVENO.LT.4389.450)GO TO 30 X=FREQ3/3125. A=X*15.*EXP(-193921.31 *HCKT(J))*(BHE1(J,25)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,25)/BHE2(J,1)-EHVKT(J)) C 5D 1D IF(WAVENO.LT.4392.369)GO TO 30 X=FREQ3/3125. A=X* 5.*EXP(-193918.391*HCKT(J))*(BHE1(J,24)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,24)/BHE2(J,1)-EHVKT(J)) C 5D 3D IF(WAVENO.LT.4393.515)GO TO 30 X=FREQ3/3125. A=X*15.*EXP(-193917.245*HCKT(J))*(BHE1(J,23)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,23)/BHE2(J,1)-EHVKT(J)) C 5P 3P IF(WAVENO.LT.4509.980)GO TO 30 X=FREQ3/3125. A=X* 9.*EXP(-193800.78 *HCKT(J))*(BHE1(J,22)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,22)/BHE2(J,1)-EHVKT(J)) C 5S 1S IF(WAVENO.LT.4647.133)GO TO 30 X=FREQ3/3125. A=X* 1.*EXP(-193663.627*HCKT(J))*(BHE1(J,21)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,21)/BHE2(J,1)-EHVKT(J)) C 5S 3S IF(WAVENO.LT.4963.671)GO TO 30 X=FREQ3/3125. A=X* 3.*EXP(-193347.089*HCKT(J))*(BHE1(J,20)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,20)/BHE2(J,1)-EHVKT(J)) C 4P 1P IF(WAVENO.LT.6817.943)GO TO 30 X=FREQ3/1024. A=X* 3.*EXP(-191492.817*HCKT(J))*(BHE1(J,19)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,19)/BHE2(J,1)-EHVKT(J)) C 4F 1F IF(WAVENO.LT.6858.680)GO TO 30 X=FREQ3/1024. A=X* 7.*EXP(-191452.08 *HCKT(J))*(BHE1(J,18)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,18)/BHE2(J,1)-EHVKT(J)) C 4F 3F IF(WAVENO.LT.6858.960)GO TO 30 X=FREQ3/1024. A=X*21.*EXP(-191451.80 *HCKT(J))*(BHE1(J,17)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,17)/BHE2(J,1)-EHVKT(J)) C 4D 1D IF(WAVENO.LT.6864.201)GO TO 30 X=FREQ3/1024. A=X* 5.*EXP(-191446.559*HCKT(J))*(BHE1(J,16)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,16)/BHE2(J,1)-EHVKT(J)) C 4D 3D IF(WAVENO.LT.6866.172)GO TO 30 X=FREQ3/1024. A=X*15.*EXP(-191444.588*HCKT(J))*(BHE1(J,15)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,15)/BHE2(J,1)-EHVKT(J)) C 4P 3P IF(WAVENO.LT.7093.620)GO TO 30 X=FREQ3/1024. A=X* 9.*EXP(-191217.14 *HCKT(J))*(BHE1(J,14)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,14)/BHE2(J,1)-EHVKT(J)) C 4S 1S IF(WAVENO.LT.7370.429)GO TO 30 X=FREQ3/1024. A=X* 1.*EXP(-190940.331*HCKT(J))*(BHE1(J,13)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,13)/BHE2(J,1)-EHVKT(J)) C 4S 3S IF(WAVENO.LT.8012.550)GO TO 30 X=FREQ3/1024. A=X* 3.*EXP(-190298.210*HCKT(J))*(BHE1(J,12)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,12)/BHE2(J,1)-EHVKT(J)) C 3P 1P IF(WAVENO.LT.12101.289)GO TO 30 X=EXP(58.81-2.89*FREQLG) A=X* 3.*EXP(-186209.471*HCKT(J))*(BHE1(J,11)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,11)/BHE2(J,1)-EHVKT(J)) C 3D 1D IF(WAVENO.LT.12205.695)GO TO 30 X=EXP(85.20-3.69*FREQLG) A=X* 5.*EXP(-186105.065*HCKT(J))*(BHE1(J,10)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,10)/BHE2(J,1)-EHVKT(J)) C 3D 3D IF(WAVENO.LT.12209.106)GO TO 30 X=EXP(85.20-3.69*FREQLG) A=X*15.*EXP(-186101.654*HCKT(J))*(BHE1(J, 9)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,9)/BHE2(J,1)-EHVKT(J)) C 3P 3P IF(WAVENO.LT.12746.066)GO TO 30 X=EXP(49.30-2.60*FREQLG) A=X* 9.*EXP(-185564.694*HCKT(J))*(BHE1(J, 8)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,8)/BHE2(J,1)-EHVKT(J)) C 3S 1S IF(WAVENO.LT.13445.824)GO TO 30 X=EXP(23.85-1.86*FREQLG) A=X* 1.*EXP(-184864.936*HCKT(J))*(BHE1(J, 7)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,7)/BHE2(J,1)-EHVKT(J)) C 3S 3S IF(WAVENO.LT.15073.868)GO TO 30 X=EXP(12.69-1.54*FREQLG) A=X* 3.*EXP(-183236.892*HCKT(J))*(BHE1(J, 6)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,6)/BHE2(J,1)-EHVKT(J)) C 2P 1P IF(WAVENO.LT.27175.760)GO TO 30 X=EXP(81.35-3.5*FREQLG) A=X* 3.*EXP(-171135.000*HCKT(J))*(BHE1(J, 5)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,5)/BHE2(J,1)-EHVKT(J)) C 2P 3P IF(WAVENO.LT.29223.753)GO TO 30 X=EXP(61.21-2.9*FREQLG) A=X* 9.*EXP(-169087.007*HCKT(J))*(BHE1(J, 4)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,4)/BHE2(J,1)-EHVKT(J)) C 2S 1S IF(WAVENO.LT.32033.214)GO TO 30 X=EXP(26.83-1.91*FREQLG) A=X* 1.*EXP(-166277.546*HCKT(J))*(BHE1(J, 3)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,3)/BHE2(J,1)-EHVKT(J)) C 2S 3S IF(WAVENO.LT.38454.691)GO TO 30 X=EXP(-390.026+(21.035-.318*FREQLG)*FREQLG) A=X* 3.*EXP(-159856.069*HCKT(J))*(BHE1(J, 2)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,2)/BHE2(J,1)-EHVKT(J)) C 1S 1S IF(WAVENO.LT.198310.760)GO TO 30 X=EXP(33.32-2.*FREQLG) A=X* 1.*1. *(BHE1(J, 1)-BHE2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BHE1(J,1)/BHE2(J,1)-EHVKT(J)) 30 H=H*XNFPHE(J,1)/RHO(J) S=S*XNFPHE(J,1)/RHO(J) C FREE-FREE A=3.619E8/SQRT(T(J))*COULFF(J,1)/FREQ*XNE(J)/FREQ* 1XNFHE(J,2)/FREQ*STIM(J)/RHO(J) H=H+A S=S+A*BNU(J) AHE1(J)=H SHE1(J)=BNU(J) IF(H.GT.0.)SHE1(J)=S/H 100 CONTINUE C 100 SHE1(J)=S/H RETURN END SUBROUTINE HE2OP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C REQUIRES FUNCTION COULFF COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) FREQ3=2.815E29/FREQ/FREQ/FREQ DO 100 J=1,NRHOX C LIMIT 438908.85 4*RYDBERG 438889.068 C N=10 TO INFINITY XNFPRHO=XNFPHE(J,2)/RHO(J) H=FREQ3*16. *2./2./(438889.068*HCKT(J))* 1(EXP(-MAX(434519.959D0,438908.85D0-WAVENO)*HCKT(J))- 2EXP(-438908.85*HCKT(J)))*STIM(J)*XNFPRHO S=H*BNU(J) C N=9 IF(WAVENO.LT.5418.390)GO TO 30 X=FREQ3/59049.*16. A=X*162.*EXP(-433490.46*HCKT(J))*STIM(J)*XNFPRHO H=H+A S=S+A*BNU(J) C N=8 IF(WAVENO.LT.6857.660)GO TO 30 X=FREQ3*16./32768. C A=X*128.*EXP(-433490.46*HCKT(J))*STIM(J)*XNFPRHO A=X*128.*EXP(-432051.19*HCKT(J))*STIM(J)*XNFPRHO H=H+A S=S+A*BNU(J) C N=7 IF(WAVENO.LT.8956.950)GO TO 30 X=FREQ3*16./16807. A=X*98.*EXP(-429951.90*HCKT(J))*STIM(J)*XNFPRHO H=H+A S=S+A*BNU(J) C N=6 IF(WAVENO.LT.12191.437)GO TO 30 X=FREQ3*16./7776.*(1.0986+(-2.704E13+1.229E27/FREQ)/FREQ) A=X*72.*EXP(-426717.413*HCKT(J))*(BHE2(J,6)-EHVKT(J))*XNFPRHO H=H+A S=S+A*BNU(J)*STIM(J)/(BHE2(J,6)-EHVKT(J)) C N=5 IF(WAVENO.LT.17555.715)GO TO 30 X=FREQ3*16./3125.*(1.102+(-3.909E13+2.371E27/FREQ)/FREQ) A=X*50.*EXP(-421353.135*HCKT(J))*(BHE2(J,5)-EHVKT(J))*XNFPRHO H=H+A S=S+A*BNU(J)*STIM(J)/(BHE2(J,5)-EHVKT(J)) C N=4 IF(WAVENO.LT.27430.925)GO TO 30 X=FREQ3*16./1024.*(1.101+(-5.765E13+4.593E27/FREQ)/FREQ) A=X*32.*EXP(-411477.925*HCKT(J))*(BHE2(J,4)-EHVKT(J))*XNFPRHO H=H+A S=S+A*BNU(J)*STIM(J)/(BHE2(J,4)-EHVKT(J)) C N=3 IF(WAVENO.LT.48766.491)GO TO 30 CTYPO X=FREQ3*16./343.*(1.101+(-9.863E13+1.035E28/FREQ)/FREQ) X=FREQ3*16./243.*(1.101+(-9.863E13+1.035E28/FREQ)/FREQ) A=X*18.*EXP(-390142.359*HCKT(J))*(BHE2(J,3)-EHVKT(J))*XNFPRHO H=H+A S=S+A*BNU(J)*STIM(J)/(BHE2(J,3)-EHVKT(J)) C N=2 IF(WAVENO.LT.109726.529)GO TO 30 X=FREQ3*16./32.*(1.105+(-2.375E14+4.077E28/FREQ)/FREQ) A=X* 8.*EXP(-329182.321*HCKT(J))*(BHE2(J,2)-EHVKT(J))*XNFPRHO H=H+A S=S+A*BNU(J)*STIM(J)/(BHE2(J,2)-EHVKT(J)) C N=1 IF(WAVENO.LT.438908.850)GO TO 30 X=FREQ3*16./1.*(.9916+(2.719E13-2.268E30/FREQ)/FREQ) A=X* 2.*1. *(BHE2(J,1)-EHVKT(J))*XNFPRHO H=H+A S=S+A*BNU(J)*STIM(J)/(BHE2(J,1)-EHVKT(J)) C C FREE-FREE C 30 A=3.6919E8/SQRT(T(J))*COULFF(J,2)/FREQ*XNE(J)/FREQ* 30 A=3.6919E8*4./SQRT(T(J))*COULFF(J,2)/FREQ*XNE(J)/FREQ* 1XNFPHE(J,3)/FREQ*STIM(J)/RHO(J) H=H+A S=S+A*BNU(J) AHE2(J)=H SHE2(J)=BNU(J) IF(H.GT.0.)SHE2(J)=S/H 100 CONTINUE C 100 SHE2(J)=S/H RETURN END SUBROUTINE HEMIOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) C A=3.397E-46+(-5.216E-31+7.039E-15/FREQ)/FREQ C B=-4.116E-42+(1.067E-26+8.135E-11/FREQ)/FREQ C C=5.081E-37+(-8.724E-23-5.659E-8/FREQ)/FREQ C DO 3 J=1,NRHOX C 3 AHEMIN(J)=(A*T(J)+B+C/T(J))*XNE(J)*XNFHE(J,1)/RHO(J) A=3.397E-01+(-5.216E+14+7.039E+30/FREQ)/FREQ B=-4.116E+03+(1.067E+19+8.135E+34/FREQ)/FREQ C=5.081E+08+(-8.724E+22-5.659E+37/FREQ)/FREQ DO 3 J=1,NRHOX 3 AHEMIN(J)=(A*T(J)+B+C/T(J))/1.E15*XNE(J)/1.E15* 1XNFPHE(J,1)/1.E15/RHO(J) C 1XNFHE(J,1)/1.E15/RHO(J) C APPROXIMATE XNFHE BY XNFPHE*PF AND PF=1 RETURN END SUBROUTINE HERAOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) WAVE=2.997925E18/ MIN (FREQ,5.15D15) WW=WAVE**2 SIG=5.484E-14/WW/WW*(1.+(2.44E5+5.94E10/(WW-2.90E5))/WW)**2 DO 2 J=1,NRHOX 2 SIGHE(J)=SIG*XNFPHE(J,1)/RHO(J)*BHE1(J,1) RETURN END SUBROUTINE COOLOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C SI1,MG1,AL1,C1 COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /RHOX/RHOX(kw),NRHOX CALL C1OP CALL MG1OP CALL AL1OP CALL SI1OP CALL FE1OP DO 100 J=1,NRHOX 100 ACOOL(J)=AC1(J)+AMG1(J)+AAL1(J)+ASI1(J)+AFE1(J) RETURN END SUBROUTINE C1OP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DO 100 J=1,NRHOX C LIMIT 2P 90862.70 C UPPER LEVELS TO INFINITY H=1.E-30 S=0. C PP 1S 13 IF(WAVENO.LT.16886.790)GO TO 30 X=0. A=X* 1.*EXP(-73975.91 *HCKT(J))*(BC1(J,13)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,13)/BC2(J,1)-EHVKT(J)) C PP 1D 12 IF(WAVENO.LT.18251.980)GO TO 30 X=0. A=X* 5.*EXP(-72610.72 *HCKT(J))*(BC1(J,12)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,12)/BC2(J,1)-EHVKT(J)) C PP 3P 11 IF(WAVENO.LT.19487.800)GO TO 30 X=0. A=X* 9.*EXP(-71374.90 *HCKT(J))*(BC1(J,11)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,11)/BC2(J,1)-EHVKT(J)) C PP 3S 10 IF(WAVENO.LT.20118.750)GO TO 30 X=0. A=X* 3.*EXP(-70743.95 *HCKT(J))*(BC1(J,10)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,10)/BC2(J,1)-EHVKT(J)) C PP 3D 9 IF(WAVENO.LT.21140.700)GO TO 30 X=0. A=X*15.*EXP(-69722.00 *HCKT(J))*(BC1(J, 9)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,9)/BC2(J,1)-EHVKT(J)) C PP 1P 8 IF(WAVENO.LT.22006.370)GO TO 30 X=2.1E-18*(22006.370/WAVENO)**1.5 A=X* 3.*EXP(-68856.33 *HCKT(J))*(BC1(J, 8)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,8)/BC2(J,1)-EHVKT(J)) C PS 1P 6 IF(WAVENO.LT.28880.880)GO TO 30 X=1.54E-18*(28880.880/WAVENO)**1.2 A=X* 3.*EXP(-61981.82 *HCKT(J))*(BC1(J, 6)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,6)/BC2(J,1)-EHVKT(J)) C PS 3P 5 IF(WAVENO.LT.30489.700)GO TO 30 X=0.2E-18*(30489.700/WAVENO)**1.2 A=X* 9.*EXP(-60373.00 *HCKT(J))*(BC1(J, 5)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,5)/BC2(J,1)-EHVKT(J)) C P3 3P 14 C LIMIT 4P 133856.20 IF(WAVENO.LT.58601.270)GO TO 30 X=0. A=X* 9.*EXP(-75254.93 *HCKT(J))*(BC1(J,14)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,14)/BC2(J,1)-EHVKT(J)) C P2 1S 3 C LIMIT 2P0.5 90820.42 IF(WAVENO.LT.69172.400)GO TO 30 X=33.6E-18*(69172.400/WAVENO)**1.5- 1 24.0E-18*(69172.400/WAVENO)**2.5 X=X/3. A=X* 1.*EXP(-21648.02 *HCKT(J))*(BC1(J, 3)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,3)/BC2(J,1)-EHVKT(J)) C LIMIT 2P1.5 90883.84 IF(WAVENO.LT.69235.820)GO TO 30 A=A*2. H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,3)/BC2(J,1)-EHVKT(J)) C P3 3D 7 C LIMIT 4P 133856.20 IF(WAVENO.LT.69767.350)GO TO 30 X=16.E-18*(69767.350/WAVENO)**3 A=X*15.*EXP(-64088.85 *HCKT(J))*(BC1(J, 7)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,7)/BC2(J,1)-EHVKT(J)) C P2 1D 2 C LIMIT 2P0.5 90820.42 IF(WAVENO.LT.80627.760)GO TO 30 X=28.7E-18*(80627.760/WAVENO)**1.5- 1 18.4E-18*(80627.760/WAVENO)**2.5 X=X/3. A=X* 5.*EXP(-10192.66 *HCKT(J))*(BC1(J, 2)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,2)/BC2(J,1)-EHVKT(J)) C LIMIT 2P0.5 90820.42 IF(WAVENO.LT.80691.180)GO TO 30 A=A*2. H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,2)/BC2(J,1)-EHVKT(J)) C P2 3P 1 C LIMIT 2P0.5 90820.42 IF(WAVENO.LT.90777.000)GO TO 30 X=38.6E-18*(90777.000/WAVENO)**2- 1 28.2E-18*(90777.000/WAVENO)**3 X=X/3. A=X* 5.*EXP(- 43.42 *HCKT(J))*(BC1(J, 1)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,1)/BC2(J,1)-EHVKT(J)) C LIMIT 2P0.5 90820.42 IF(WAVENO.LT.90804.000)GO TO 30 A=X* 3.*EXP(- 16.42 *HCKT(J))*(BC1(J, 1)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,1)/BC2(J,1)-EHVKT(J)) C LIMIT 2P0.5 90820.42 IF(WAVENO.LT.90820.420)GO TO 30 A=X* 1.*1. *(BC1(J, 1)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,1)/BC2(J,1)-EHVKT(J)) C LIMIT 2P1.5 90883.84 IF(WAVENO.LT.90840.420)GO TO 30 X=X*2. A=X* 5.*EXP(- 43.42 *HCKT(J))*(BC1(J, 1)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,1)/BC2(J,1)-EHVKT(J)) C LIMIT 2P1.5 90883.84 IF(WAVENO.LT.90867.420)GO TO 30 A=X* 3.*EXP(- 16.42 *HCKT(J))*(BC1(J, 1)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,1)/BC2(J,1)-EHVKT(J)) C LIMIT 2P1.5 90883.84 IF(WAVENO.LT.90883.840)GO TO 30 A=X* 1.*1. *(BC1(J, 1)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,1)/BC2(J,1)-EHVKT(J)) C P3 5S 4 C LIMIT 4P 133856.20 IF(WAVENO.LT.100121.000)GO TO 30 X=1.E-18*(100121.000/WAVENO)**3 A=X* 5.*EXP(-33735.20 *HCKT(J))*(BC1(J, 4)-BC2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BC1(J,4)/BC2(J,1)-EHVKT(J)) C 30 H=H*XNFPC(J,1)/RHO(J) S=S*XNFPC(J,1)/RHO(J) AC1(J)=H IF(H.GT.0.)SC1(J)=S/H 100 CONTINUE RETURN END SUBROUTINE MG1OP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DO 100 J=1,NRHOX C LIMIT 2S 61671.02 H=1.E-30 S=0. C 3D 3D IF(WAVENO.LT.13713.986)GO TO 30 X=25.E-18*(13713.986/WAVENO)**2.7 A=X*15.*EXP(-47957.034*HCKT(J))*(BMG1(J,8)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,8)/BMG2(J,1)-EHVKT(J)) C 4P 3P IF(WAVENO.LT.13823.223)GO TO 30 X=33.8E-18*(13823.223/WAVENO)**2.8 A=X* 9.*EXP(-47847.797*HCKT(J))*(BMG1(J,7)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,7)/BMG2(J,1)-EHVKT(J)) C 3D 1D IF(WAVENO.LT.15267.955)GO TO 30 X=45.E-18*(15267.955/WAVENO)**2.7 A=X* 5.*EXP(-46403.065*HCKT(J))*(BMG1(J,6)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,6)/BMG2(J,1)-EHVKT(J)) C 4S 1S IF(WAVENO.LT.18167.687)GO TO 30 X=.43E-18*(18167.687/WAVENO)**2.6 A=X* 1.*EXP(-43503.333*HCKT(J))*(BMG1(J,5)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,5)/BMG2(J,1)-EHVKT(J)) C 4S 3S IF(WAVENO.LT.20473.617)GO TO 30 X=2.1E-18*(20473.617/WAVENO)**2.6 A=X* 3.*EXP(-41197.043*HCKT(J))*(BMG1(J,4)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,4)/BMG2(J,1)-EHVKT(J)) C 3P 1P IF(WAVENO.LT.26619.756)GO TO 30 X=16.E-18*(26619.756/WAVENO)**2.1- 1 7.8E-18*(26619.756/WAVENO)**9.5 A=X* 3.*EXP(-35051.264*HCKT(J))*(BMG1(J,3)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,3)/BMG2(J,1)-EHVKT(J)) C 3P 3P IF(WAVENO.LT.39759.842)GO TO 30 X=20.E-18*(39759.842/WAVENO)**2.7 X= MAX (X,40.E-18*(39759.842/WAVENO)**14) A=X* 5.*EXP(-21911.178*HCKT(J))*(BMG1(J,2)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,2)/BMG2(J,1)-EHVKT(J)) IF(WAVENO.LT.39800.556)GO TO 30 A=X* 3.*EXP(-21870.464*HCKT(J))*(BMG1(J,2)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,2)/BMG2(J,1)-EHVKT(J)) IF(WAVENO.LT.39820.615)GO TO 30 A=X* 1.*EXP(-21850.405*HCKT(J))*(BMG1(J,2)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,2)/BMG2(J,1)-EHVKT(J)) C 3S 1S IF(WAVENO.LT.61671.020)GO TO 30 X=1.1E-18*(61671.020/WAVENO)**10 A=X* 1.*1. *(BMG1(J,1)-BMG2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BMG1(J,1)/BMG2(J,1)-EHVKT(J)) C 30 IF(H.GT.0.)SMG1(J)=S/H 100 AMG1(J)=H*XNFPMG(J,1)/RHO(J) RETURN END SUBROUTINE AL1OP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DO 100 J=1,NRHOX C LIMIT 1S 48278.37 H=1.E-30 S=0. BSTIMB=BNU(J)*STIM(J)*BAL2(J,1) BEHVKT=BAL2(J,1)*EHVKT(J) C 4F 2F IF(WAVENO.LT.6958.993)GO TO 30 X=0. A=X*14.*EXP(-41319.377*HCKT(J))*(BAL1(J,9)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,9)/BAL2(J,1)-EHVKT(J)) C 5P 2P IF(WAVENO.LT.8002.467)GO TO 30 X=50.E-18*(8002.467/WAVENO)**3 A=X* 6.*EXP(-40275.903*HCKT(J))*(BAL1(J,8)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,8)/BAL2(J,1)-EHVKT(J)) C 4D 2D IF(WAVENO.LT.9346.231)GO TO 30 X=50.E-18*(9346.231/WAVENO)**3 A=X*10.*EXP(-38932.139*HCKT(J))*(BAL1(J,7)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,7)/BAL2(J,1)-EHVKT(J)) C 5S 2S IF(WAVENO.LT.10588.957)GO TO 30 X=56.7E-18*(10588.957/WAVENO)**1.9 A=X* 2.*EXP(-37689.413*HCKT(J))*(BAL1(J,6)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,6)/BAL2(J,1)-EHVKT(J)) C 4P 2P IF(WAVENO.LT.15318.007)GO TO 30 X=14.5E-18*15318.007/WAVENO A=X* 6.*EXP(-32960.363*HCKT(J))*(BAL1(J,5)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,5)/BAL2(J,1)-EHVKT(J)) C 3D 2D IF(WAVENO.LT.15842.129)GO TO 30 X=47.E-18*(15842.129/WAVENO)**1.83 A=X*10.*EXP(-32436.241*HCKT(J))*(BAL1(J,4)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,4)/BAL2(J,1)-EHVKT(J)) C 4S 2S IF(WAVENO.LT.22930.614)GO TO 30 X=10.E-18*(22930.614/WAVENO)**2 A=X* 2.*EXP(-25347.756*HCKT(J))*(BAL1(J,2)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,2)/BAL2(J,1)-EHVKT(J)) C 3P 2P IF(WAVENO.LT.48166.309)GO TO 30 X=65.E-18*(48166.309/WAVENO)**5 A=X* 4.*EXP( -112.061*HCKT(J))*(BAL1(J,1)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,1)/BAL2(J,1)-EHVKT(J)) IF(WAVENO.LT.48278.370)GO TO 30 A=X* 2.*1. *(BAL1(J,1)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,1)/BAL2(J,1)-EHVKT(J)) C P2 4P IF(WAVENO.LT.55903.260)GO TO 30 X=10.E-18*(55903.260/WAVENO)**2 A=X*12.*EXP(-29097.11 *HCKT(J))*(BAL1(J,3)-BAL2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BAL1(J,3)/BAL2(J,1)-EHVKT(J)) C 30 IF(H.GT.0.)SAL1(J)=S/H 100 AAL1(J)=H*XNFPAL(J,1)/RHO(J) RETURN END SUBROUTINE SI1OP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DO 100 J=1,NRHOX C LIMIT 2P 65939.10 H=1.E-30 S=0. C PP 3P IF(WAVENO.LT.16810.969)GO TO 30 X=0. A=X* 9.*EXP(-49128.131*HCKT(J))*(BSI1(J,11)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,11)/BSI2(J,1)-EHVKT(J)) C PP 3D IF(WAVENO.LT.17777.641)GO TO 30 X=18.E-18*(17777.641/WAVENO)**3 A=X*15.*EXP(-48161.459*HCKT(J))*(BSI1(J,10)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,10)/BSI2(J,1)-EHVKT(J)) C PD 1D IF(WAVENO.LT.18587.546)GO TO 30 X=0. A=X* 5.*EXP(-47351.554*HCKT(J))*(BSI1(J, 9)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,9)/BSI2(J,1)-EHVKT(J)) C PP 1P IF(WAVENO.LT.18655.039)GO TO 30 X=0. A=X* 3.*EXP(-47284.061*HCKT(J))*(BSI1(J, 8)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,8)/BSI2(J,1)-EHVKT(J)) C PS 1P IF(WAVENO.LT.24947.216)GO TO 30 X=4.09E-18*(24947.216/WAVENO)**2 A=X* 3.*EXP(-40991.884*HCKT(J))*(BSI1(J, 6)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,6)/BSI2(J,1)-EHVKT(J)) C PS 3P IF(WAVENO.LT.26079.180)GO TO 30 X=1.25E-18*(26079.180/WAVENO)**2 A=X* 9.*EXP(-39859.920*HCKT(J))*(BSI1(J, 5)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,5)/BSI2(J,1)-EHVKT(J)) C P2 1S C LIMIT 2P0.5 65747.55 IF(WAVENO.LT.50353.180)GO TO 30 X=1./3.*46.E-18*(50353.180/WAVENO)**.5 BOLT=1.*EXP(-15394.370*HCKT(J))*(BSI1(J, 3)-BSI2(J,1)*EHVKT(J)) A=X*BOLT H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,3)/BSI2(J,1)-EHVKT(J)) C LIMIT 2P1.5 66035.00 IF(WAVENO.LT.50640.630)GO TO 30 X=2./3.*46.E-18*(50640.630/WAVENO)**.5 A=X*BOLT H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,3)/BSI2(J,1)-EHVKT(J)) C P2 1D C LIMIT 2P0.5 65747.55 IF(WAVENO.LT.59448.700)GO TO 30 X=1./3.*35.E-18*(59448.700/WAVENO)**3 BOLT=5.*EXP(- 6298.850*HCKT(J))*(BSI1(J, 2)-BSI2(J,1)*EHVKT(J)) A=X*BOLT H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,2)/BSI2(J,1)-EHVKT(J)) C LIMIT 2P1.5 66035.00 IF(WAVENO.LT.59736.150)GO TO 30 X=2./3.*35.E-18*(59736.150/WAVENO)**3 BOLT=5.*EXP(- 6298.850*HCKT(J))*(BSI1(J, 2)-BSI2(J,1)*EHVKT(J)) A=X*BOLT H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,1)/BSI2(J,1)-EHVKT(J)) C P3 3D C LIMIT 4P 108749.82 IF(WAVENO.LT.63446.510)GO TO 30 X=18.E-18*(63446.510/WAVENO)**3 A=X*15.*EXP(-45303.310*HCKT(J))*(BSI1(J, 7)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,7)/BSI2(J,1)-EHVKT(J)) C P2 3P C LIMIT 2P0.5 65747.55 IF(WAVENO.LT.65524.393)GO TO 30 X=37.E-18 IF(WAVENO.GT.74000.)X=X*(74000./WAVENO)**5 X=X/3. A=X* 5.*EXP(- 223.157*HCKT(J))*(BSI1(J, 1)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,1)/BSI2(J,1)-EHVKT(J)) IF(WAVENO.LT.65670.435)GO TO 30 A=X* 3.*EXP(- 77.115*HCKT(J))*(BSI1(J, 1)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,1)/BSI2(J,1)-EHVKT(J)) IF(WAVENO.LT.65747.550)GO TO 30 A=X* 1.*1. *(BSI1(J, 1)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,1)/BSI2(J,1)-EHVKT(J)) C LIMIT 2P1.5 66035.00 IF(WAVENO.LT.65811.843)GO TO 30 X=X*2. A=X* 5.*EXP(- 223.157*HCKT(J))*(BSI1(J, 1)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,1)/BSI2(J,1)-EHVKT(J)) IF(WAVENO.LT.65957.885)GO TO 30 A=X* 3.*EXP(- 77.115*HCKT(J))*(BSI1(J, 1)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,1)/BSI2(J,1)-EHVKT(J)) IF(WAVENO.LT.66035.000)GO TO 30 A=X* 1.*1. *(BSI1(J, 1)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,1)/BSI2(J,1)-EHVKT(J)) C P3 5S C LIMIT 4P 108749.82 IF(WAVENO.LT.75423.767)GO TO 30 X=15.E-18*(75423.767/WAVENO)**3 A=X* 5.*EXP(-33326.053*HCKT(J))*(BSI1(J, 4)-BSI2(J,1)*EHVKT(J)) H=H+A S=S+A*BNU(J)*STIM(J)/(BSI1(J,4)/BSI2(J,1)-EHVKT(J)) C 30 SSI1(J)=BNU(J) IF(H.GT.0.)SSI1(J)=S/H 100 ASI1(J)=H*XNFPSI(J,1)/RHO(J) RETURN END SUBROUTINE FE1OP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1) COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10) COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION BFUDGE(kw) EQUIVALENCE (FLXRAD(1),BFUDGE(1)) DIMENSION G(48),E(48),WNO(48) DATA G/25.,35.,21.,15.,9.,35.,33.,21.,27.,49.,9.,21.,27.,9.,9., 1 25.,33.,15.,35.,3.,5.,11.,15.,13.,15.,9.,21.,15.,21.,25.,35., 2 9.,5.,45.,27.,21.,15.,21.,15.,25.,21.,35.,5.,15.,45.,35.,55.,25./ DATA E/500.,7500.,12500.,17500.,19000.,19500.,19500.,21000., 1 22000.,23000.,23000.,24000.,24000.,24500.,24500.,26000.,26500., 2 26500.,27000.,27500.,28500.,29000.,29500.,29500.,29500.,30000., 3 31500.,31500.,33500.,33500.,34000.,34500.,34500.,35000.,35500., 4 37000.,37000.,37000.,38500.,40000.,40000.,41000.,41000.,43000., 5 43000.,43000.,43000.,44000./ DATA WNO/63500.,58500.,53500.,59500.,45000.,44500.,44500.,43000., 1 58000.,41000.,54000.,40000.,40000.,57500.,55500.,38000.,57500., 2 57500.,37000.,54500.,53500.,55000.,34500.,34500.,34500.,34000., 3 32500.,32500.,32500.,32500.,32000.,29500.,29500.,31000.,30500., 4 29000.,27000.,54000.,27500.,24000.,47000.,23000.,44000.,42000., 5 42000.,21000.,42000.,42000./ DO 1 J=1,NRHOX BFUDGE(J)=BSI1(J,1) 1 AFE1(J)=0. IF(WAVENO.LT.21000.)RETURN DO 10 I=1,48 IF(WNO(I).GT.WAVENO)GO TO 10 XSECT=3.E-18/(1.+((WNO(I)+3000.-WAVENO)/WNO(I)/.1)**4) DO 5 J=1,NRHOX 5 AFE1(J)=AFE1(J)+XSECT*G(I)*EXP(-E(I)*HCKT(J)) 10 CONTINUE DO 15 J=1,NRHOX AFE1(J)=AFE1(J)*STIM(J)*XNFPFE(J,1)/RHO(J) 15 SFE1(J)=BNU(J)*STIM(J)/(BFUDGE(J)-EHVKT(J)) RETURN END SUBROUTINE LUKEOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C SI2,MG2,CA2,N1,O1 COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION XNFPN(kw),XNFPO(kw),XNFPMG(kw),XNFPSI(kw),XNFPCA(kw) REAL*8 N1OP,MG2OP DATA ITEMP1/0/ IF(ITEMP.EQ.ITEMP1)GO TO 10 ITEMP1=ITEMP CALL POPS(7.D0,1,XNFPN) CALL POPS(8.D0,1,XNFPO) CALL POPS(12.01D0,1,XNFPMG) CALL POPS(14.01D0,1,XNFPSI) CALL POPS(20.01D0,1,XNFPCA) 10 DO 11 J=1,NRHOX 11 ALUKE(J)=(N1OP(J)*XNFPN(J)+O1OP(J)*XNFPO(J)+MG2OP(J)*XNFPMG(J)+ 1SI2OP(J)*XNFPSI(J)+CA2OP(J)*XNFPCA(J))*STIM(J)/RHO(J) RETURN END REAL*8 FUNCTION N1OP(J) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C CROSS-SECTION TIMES PARTITION FUNCTION COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION C1130(kw),C1020(kw) DATA FREQ1,ITEMP1/0.,0/ IF(ITEMP.EQ.ITEMP1)GO TO 30 ITEMP1=ITEMP DO 20 K=1,NRHOX C1130(K)=6.*EXP(-3.575/TKEV(K)) 20 C1020(K)=10.*EXP(-2.384/TKEV(K)) 30 IF(FREQ.EQ.FREQ1)GO TO 40 X1130=0. X1020=0. X853=0. IF(FREQ.GE.3.517915D15)X853= 1SEATON(3.517915D15,1.142D-17,2.D0,4.29D0) IF(FREQ.GE.2.941534D15)X1020= 1SEATON(2.941534D15,4.41D-18,1.5D0,3.85D0) IF(FREQ.GE.2.653317D15)X1130= 1SEATON(2.653317D15,4.2D-18,1.5D0,4.34D0) FREQ1=FREQ 40 N1OP=X853*4.+X1020*C1020(J)+X1130*C1130(J) RETURN END FUNCTION O1OP(J) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C FROM DEANE PETERSON AFTER PEACH C CROSS-SECTION TIMES PARTITION FUNCTION COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO DATA FREQ1/0./ IF(FREQ.EQ.FREQ1)GO TO 1 X911=0. IF(FREQ.GE.3.28805D15)X911=SEATON(3.28805D15,2.94D-18,1.D0,2.66D0) FREQ1=FREQ 1 O1OP=X911*9. RETURN END REAL*8 FUNCTION MG2OP(J) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C CROSS-SECTION TIMES PARTITION FUNCTION COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION C1169(kw) DATA FREQ1,ITEMP1/0.,0/ IF(ITEMP.EQ.ITEMP1)GO TO 30 ITEMP1=ITEMP DO 20 K=1,NRHOX 20 C1169(K)=6.*EXP(-4.43/TKEV(K)) 30 IF(FREQ.EQ.FREQ1)GO TO 40 X1169=0. X824=0. IF(FREQ.GE.3.635492D15)X824= 1SEATON(3.635492D15,1.40D-19,4.D0,6.7D0) IF(FREQ.GE.2.564306D15)X1169=5.11E-19*(2.564306D15/FREQ)**3 FREQ1=FREQ 40 MG2OP=X824*2.+X1169*C1169(J) RETURN END FUNCTION SI2OP(J) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C CROSS-SECTION TIMES THE PARTITION FUNCTION COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION FLOG(9),FREQSI(7),PEACH(6,14),X(6),TLG(6),DT(kw),NT(kw) DATA PEACH/ C 10000 12000 14000 16000 18000 20000 WAVE(A) 1 -43.8941, -43.8941, -43.8941, -43.8941, -43.8941, -43.8941, 500 2 -42.2444, -42.2444, -42.2444, -42.2444, -42.2444, -42.2444, 600 3 -40.6054, -40.6054, -40.6054, -40.6054, -40.6054, -40.6054, 759 4 -54.2389, -52.2906, -50.8799, -49.8033, -48.9485, -48.2490, 760 5 -50.4108, -48.4892, -47.1090, -46.0672, -45.2510, -44.5933, 1905 6 -52.0936, -50.0741, -48.5999, -47.4676, -46.5649, -45.8246, 1906 7 -51.9548, -49.9371, -48.4647, -47.3340, -46.4333, -45.6947, 1975 8 -54.2407, -51.7319, -49.9178, -48.5395, -47.4529, -46.5709, 1976 9 -52.7355, -50.2218, -48.4059, -47.0267, -45.9402, -45.0592, 3245 T -53.5387, -50.9189, -49.0200, -47.5750, -46.4341, -45.5082, 3246 1 -53.2417, -50.6234, -48.7252, -47.2810, -46.1410, -45.2153, 3576 2 -53.5097, -50.8535, -48.9263, -47.4586, -46.2994, -45.3581, 3577 3 -54.0561, -51.2365, -49.1980, -47.6497, -46.4302, -45.4414, 3900 4 -53.8469, -51.0256, -48.9860, -47.4368, -46.2162, -45.2266/ 4200 DATA FREQSI/4.9965417D15,3.9466738D15,1.5736321D15,1.5171539D15, 1 9.2378947E14,8.3825004E14,7.6869872E14/ C 2P,2D,2P,2D,2P DATA FLOG/36.32984,36.14752,35.91165,34.99216,34.95561,34.45951, 1 34.36234,34.27572,34.20161/ DATA TLG/9.21034,9.39266,9.54681,9.68034,9.79813,9.90349/ DATA FREQ1,ITEMP1/0.,0/ IF(ITEMP.EQ.ITEMP1)GO TO 20 ITEMP1=ITEMP DO 11 K=1,NRHOX N=MAX0(MIN0(5, INT(T(K)/2000.)-4),1) NT(K)=N 11 DT(K)=(TLOG(K)-TLG(N))/(TLG(N+1)-TLG(N)) GO TO 21 20 IF(FREQ.EQ.FREQ1)GO TO 30 21 FREQ1=FREQ DO 22 N=1,7 IF(FREQ.GT.FREQSI(N))GO TO 23 22 CONTINUE N=8 23 D=(FREQLG-FLOG(N))/(FLOG(N+1)-FLOG(N)) IF(N.GT.2)N=2*N-2 IF(N.EQ.14)N=13 D1=1.-D DO 24 IT=1,6 24 X(IT)=PEACH(IT,N+1)*D+PEACH(IT,N)*D1 30 N=NT(J) SI2OP=EXP(X(N)*(1.-DT(J))+X(N+1)*DT(J))*6. RETURN END FUNCTION CA2OP(J) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C CROSS-SECTION TIMES THE PARTITION FUNCTION COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION C1218(kw),C1420(kw) DATA FREQ1,ITEMP1/0.,0/ IF(ITEMP.EQ.ITEMP1)GO TO 30 ITEMP1=ITEMP DO 20 K=1,NRHOX C1218(K)=10.*EXP(-1.697/TKEV(K)) 20 C1420(K)=6.*EXP(-3.142/TKEV(K)) 30 IF(FREQ.EQ.FREQ1)GO TO 40 X1420=0. X1218=0. X1044=0. IF(FREQ.GE.2.870454D15)X1044=5.4E-20*(2.870454D15/FREQ)**3 IF(FREQ.GE.2.460127D15)X1218=1.64E-17*SQRT(2.460127D15/FREQ) IF(FREQ.GE.2.110779D15)X1420= 1SEATON(2.110779D15,4.13D-18,3.D0,.69D0) FREQ1=FREQ 40 CA2OP=X1044*2.+X1218*C1218(J)+X1420*C1420(J) RETURN END SUBROUTINE HOTOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION XNFP(kw,21) DIMENSION A(420) DIMENSION A1(63),A2(63),A3(63),A4(63),A5(63),A6(63),A7(42) EQUIVALENCE (A(1),A1(1)),(A(64),A2(1)),(A(127),A3(1)) EQUIVALENCE (A(190),A4(1)),(A(253),A5(1)),(A(316),A6(1)) EQUIVALENCE (A(379),A7(1)) DATA A1/ 1 4.149945D15, 6.90E-18, 1.000, 6., 6., 13.71, 2., 6.01 2 4.574341D15, 2.50E-18, 1.000, 4., 2., 11.96, 2., 6.01 3 5.220770D15, 1.08E-17, 1.000, 4., 10., 9.28, 2., 6.01 4 5.222307D15, 5.35E-18, 3.769, 2., 1., 0.00, 16., 10.00 5 5.892577D15, 4.60E-18, 1.950, 6., 6., 0.00, 2., 6.01 6 6.177022D15, 3.50E-18, 1.000, 4., 12., 5.33, 2., 6.01 7 6.181062D15, 6.75E-18, 3.101, 5., 1., 4.05, 6., 7.01 8 6.701879D15, 6.65E-18, 2.789, 5., 5., 1.90, 6., 7.01 9 7.158382D15, 6.65E-18, 2.860, 6., 9., 0.00, 6./ 7.01 DATA A2/ 1 7.284488D15, 3.43E-18, 4.174, 5., 6., 5.02, 11., 8.01 2 7.693612D15, 3.53E-18, 3.808, 5., 10., 3.33, 11., 8.01 3 7.885955D15, 2.32E-18, 3.110, 5., 6., 5.02, 11., 8.01 4 8.295079D15, 3.97E-18, 3.033, 5., 10., 3.33, 11., 8.01 5 8.497686D15, 7.32E-18, 3.837, 5., 4., 0.00, 11., 8.01 6 8.509966D15, 2.00E-18, 1.750, 7., 3., 12.69, 3., 6.02 7 8.572854D15, 1.68E-18, 3.751, 5., 6., 5.02, 11., 8.01 8 9.906370D15, 4.16E-18, 2.717, 3., 6., 0.00, 17., 10.01 9 1.000693E16, 2.40E-18, 1.750, 7., 9., 6.50, 3./ 6.02 DATA A3/ 1 1.046078E16, 4.80E-18, 1.000, 4., 10., 12.53, 7., 7.02 2 1.067157E16, 2.71E-18, 2.148, 3., 6., 0.00, 17., 10.01 3 1.146734E16, 2.06E-18, 1.626, 6., 6., 0.00, 7., 7.02 4 1.156813E16, 5.20E-19, 2.126, 3., 6., 0.00, 17., 10.01 5 1.157840E16, 9.10E-19, 4.750, 4., 1., 0.00, 3., 6.02 6 1.177220E16, 5.30E-18, 1.000, 4., 12., 7.10, 7., 7.02 7 1.198813E16, 3.97E-18, 2.780, 6., 1., 5.35, 12., 8.02 8 1.325920E16, 3.79E-18, 2.777, 6., 5., 2.51, 12., 8.02 9 1.327649E16, 3.65E-18, 2.014, 6., 9., 0.00, 12./ 8.02 DATA A4/ 1 1.361466E16, 7.00E-18, 1.000, 2., 5., 7.48, 12., 8.02 2 1.365932E16, 9.30E-19, 1.500, 7., 6., 8.00, 4., 6.03 3 1.481487E16, 1.10E-18, 1.750, 7., 3., 16.20, 8., 7.03 4 1.490032E16, 5.49E-18, 3.000, 5., 1., 6.91, 18., 10.02 5 1.533389E16, 1.80E-18, 2.277, 4., 9., 0.00, 18., 10.02 6 1.559452E16, 8.70E-19, 3.000, 6., 2., 0.00, 4., 6.03 7 1.579688E16, 4.17E-18, 2.074, 4., 5., 3.20, 18., 10.02 8 1.643205E16, 1.39E-18, 2.792, 5., 5., 3.20, 18., 10.02 9 1.656208E16, 2.50E-18, 2.346, 5., 9., 0.00, 18./ 10.02 DATA A5/ 1 1.671401E16, 1.30E-18, 1.750, 7., 9., 8.35, 8., 7.03 2 1.719725E16, 1.48E-18, 2.225, 5., 9., 0.00, 18., 10.02 3 1.737839E16, 2.70E-18, 1.000, 4., 10., 15.74, 13., 8.03 4 1.871079E16, 1.27E-18, .831, 6., 6., 0.00, 13., 8.03 5 1.873298E16, 9.10E-19, 3.000, 4., 1., 0.00, 8., 7.03 6 1.903597E16, 2.90E-18, 1.000, 4., 12., 8.88, 13., 8.03 7 2.060738E16, 4.60E-18, 1.000, 3., 12., 22.84, 19., 10.03 8 2.125492E16, 5.90E-19, 1.000, 6., 6., 9.99, 9., 7.04 9 2.162610E16, 1.69E-18, 1.937, 5., 6., 7.71, 19./ 10.03 DATA A6/ 1 2.226127E16, 1.69E-18, 1.841, 5., 10., 5.08, 19., 10.03 2 2.251163E16, 9.30E-19, 2.455, 6., 6., 7.71, 19., 10.03 3 2.278001E16, 7.90E-19, 1.000, 6., 9., 10.20, 14., 8.04 4 2.317678E16, 1.65E-18, 2.277, 6., 10., 5.08, 19., 10.03 5 2.348946E16, 3.11E-18, 1.963, 6., 4., 0.00, 19., 10.03 6 2.351911E16, 7.30E-19, 1.486, 5., 6., 7.71, 19., 10.03 7 2.366973E16, 5.00E-19, 1.000, 4., 2., 0.00, 9., 7.04 8 2.507544E16, 6.90E-19, 1.000, 6., 3., 19.69, 14., 8.04 9 2.754065E16, 7.60E-19, 1.000, 2., 1., 0.00, 14./ 8.04 DATA A7/ 1 2.864850E16, 1.54E-18, 2.104, 6., 1., 7.92, 20., 10.04 2 2.965598E16, 1.53E-18, 2.021, 6., 5., 3.76, 20., 10.04 3 3.054151E16, 1.40E-18, 1.471, 6., 9., 0.00, 20., 10.04 4 3.085141E16, 2.80E-18, 1.000, 4., 5., 11.01, 20., 10.04 5 3.339687E16, 3.60E-19, 1.000, 6., 2., 0.00, 15., 8.05 6 3.818757E16, 4.90E-19, 1.145, 6., 6., 0.00, 21./ 10.05 DATA NUM/60/ DATA ITEMP1/0/ IF(ITEMP.EQ.ITEMP1)GO TO 95 ITEMP1=ITEMP CALL POPS(6.03D0,11,XNFP) CALL POPS(7.04D0,11,XNFP(1,5)) CALL POPS(8.05D0,11,XNFP(1,10)) CALL POPS(10.05D0,11,XNFP(1,16)) 95 L=-6 DO 20 I=1,NUM L=L+7 IF(FREQ.LT.A(L))GO TO 20 XSECT=A(L+1)*(A(L+2)+(A(L)/FREQ)-A(L+2)*(A(L)/FREQ))* 1 SQRT((A(L)/FREQ)** INT(A(L+3))) ID=A(L+6) DO 10 J=1,NRHOX XX=XSECT*XNFP(J,ID)*A(L+4) C IF(XX.GT.AHOT(J)/100.)AHOT(J)=AHOT(J)+XX/EXP(A(L+5)/TKEV(J)) IF(XX.GT.AHOT(J)/100.)AHOT(J)=AHOT(J)+XX*EXP(-A(L+5)/TKEV(J)) 10 CONTINUE 20 CONTINUE DO 30 J=1,NRHOX 30 AHOT(J)=AHOT(J)*STIM(J)/RHO(J) RETURN END FUNCTION SEATON(FREQ0,XSECT,POWER,A) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO SEATON=XSECT*(A+(1.-A)*(FREQ0/FREQ))* 1SQRT((FREQ0/FREQ)**( INT(2.*POWER+.01))) RETURN END SUBROUTINE ELECOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) DO 1 J=1,NRHOX 1 SIGEL(J)=.6653E-24*XNE(J)/RHO(J) RETURN END SUBROUTINE H2RAOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION XNH2(kw) DATA ITEMP1/0/ IF(ITEMP.EQ.ITEMP1)GO TO 20 ITEMP1=ITEMP DO 11 J=1,NRHOX 11 XNH2(J)=(XNFPH(J,1)*2.*BHYD(J,1))**2*EXP(4.477/TKEV(J)-4.6628E1+ 1(1.8031E-3+(-5.0239E-7+(8.1424E-11-5.0501E-15*T(J))*T(J))*T(J))* 2T(J)-1.5*TLOG(J))/RHO(J) 20 WAVE=2.997925E18/ MIN (FREQ,2.922D15) WW=WAVE**2 SIG=(8.14E-13+1.28E-6/WW+1.61/(WW*WW))/(WW*WW) DO 21 J=1,NRHOX SIGH2(J)=SIG*XNH2(J) C IF(T(J).GT.0.)SIGH2(J)=0. 21 CONTINUE RETURN END SUBROUTINE HLINOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C REQUIRES STARK AND COULX COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION BOLT(kw,4),MLAST(kw) DATA ITEMP1/0/ IF(ITEMP.EQ.ITEMP1)GO TO 20 DO 10 J=1,NRHOX MLAST(J)=1100./XNE(J)**.133333333 DO 10 N=1,4 10 BOLT(J,N)=EXP(-(13.595-13.595/DBLE(N*N))/TKEV(J))*2.*DBLE(N*N)* 1BHYD(J,N)*XNFPH(J,1)/RHO(J) ITEMP1=ITEMP 20 N=SQRT(3.28805D15/FREQ) IF(N.EQ.0.OR.N.GT.4)RETURN GO TO (21,22,30,30),N 21 IF(FREQ.LT.2.D15)RETURN GO TO 30 22 IF(FREQ.LT.4.44E14)RETURN 30 MFREQ=SQRT(3.28805D15/(3.28805D15/DBLE(N*N)-FREQ)) DO 50 J=1,NRHOX M1=MFREQ M2=M1+1 M1=MAX0(M1,N+1) H=0. S=0. IF(M1.LE.6)GO TO 39 IF(M1.GT.MLAST(J))GO TO 45 M1=M1-1 M2=M2+3 IF(N.LT.4.OR.M1.GT.8)GO TO 39 H=STARK(3,4,J)*(1.-EHVKT(J)*BHYD(J,4)/BHYD(J,3))*BOLT(J,3) S=H*BNU(J)*STIM(J)/(BHYD(J,3)/BHYD(J,4)-EHVKT(J)) 39 DO 40 M=M1,M2 BHYDJM=1. IF(M.LE.6)BHYDJM=BHYD(J,M) C ASSUMING FREQ APROXIMATELY FREQNM A=STARK(N,M,J)*(1.-EHVKT(J)*BHYDJM/BHYD(J,N))*BOLT(J,N) H=H+A 40 S=S+A*BNU(J)*STIM(J)/(BHYD(J,N)/BHYDJM-EHVKT(J)) AHLINE(J)=H SHLINE(J)=S/H GO TO 50 45 AHLINE(J)=COULX(N,3.28806D15/DBLE(N*N),1.)*(1.-EHVKT(J)/ 1BHYD(J,N))*BOLT(J,N) SHLINE(J)=BNU(J)*STIM(J)/(BHYD(J,N)-EHVKT(J)) 50 CONTINUE RETURN END FUNCTION STARK(N,M,J) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB DIMENSION F0(kw) DIMENSION KNMTAB(5,4),FSTARK(10,4) REAL*8 NN,MM,IMPACT,KNM,KNMTAB DATA KNMTAB/.000356,.000523,.00109,.00149,.00225,.0125,.0177,.028, 1.0348,.0493,.124,.171,.223,.261,.342,.683,.866,1.02,1.19,1.46/ DATA FSTARK/.1387,.07910,.02126,.01394,.006462,.004814,.002779, 1 .002216,.001443,.001201,.3921,.1193,.03766,.02209,.01139, 2 .008036,.005007,.003850,.002658,.002151,.6103,.1506,.04931, 3 .02768,.01485,.01023,.006588,.004996,.003542,.002838,.8163,.1788, 4 .05985,.03189,.01762,.01196,.007825,.005882,.004233,.003375/ C IF YOUR RYDBERG IS DIFFERENT YOU MAY GET LINES IN STRANGE PLACES DATA RYD/3.28805D15/ DATA ITEMP1/0/ EXINT(X)=- LOG(X)-.57516+(.97996-(.21654-(.033572-(.0029222- 1 1.05439E-4*X)*X)*X)*X)*X IF(ITEMP.EQ.ITEMP1)GO TO 20 DO 10 K=1,NRHOX 10 F0(K)=1.25E-9*XNE(K)**.6666667 ITEMP1=ITEMP 20 XN=N XM=M X=XN/XM XX=X**2 NN=N*N MM=M*M MMINN=M-N IF(MMINN.GT.5)GO TO 21 KNM=KNMTAB(MMINN,N) GO TO 22 21 KNM=5.5E-5*(NN*MM)**2/(MM-NN) 22 IF(MMINN.GT.10)GO TO 23 FNM=FSTARK(MMINN,N) GO TO 30 23 FNM=FSTARK(10,N)*((20.*XN+100.)/(XN+10.)/XM/(1.-XX))**3 30 FREQNM=RYD*(1./NN-1./MM) DEL=ABS(FREQ-FREQNM) DBETA=2.997925E18/FREQNM**2/F0(J)/KNM BETA=DBETA*DEL Y1=MM*DEL*HKT(J)/2. Y2=(3.14159*3.14159/2./.0265384/2.997925E10)*DEL**2/XNE(J) QSTAT=1.5+.5*(Y1**2-1.384)/(Y1**2+1.384) IMPACT=0. IF(Y1.GT.8..OR.Y1.GE.Y2)GO TO 40 EXY2=0. IF(Y2.LE.8.)EXY2=EXINT(Y2) IMPACT=1.438*SQRT(Y1*(1.-XX))*(.4*EXP(-Y1)+EXINT(Y1)-.5*EXY2) 40 IF(BETA.GT.20.)GO TO 45 PROF=8./(80.+BETA**3) RATIO=QSTAT+IMPACT GO TO 50 45 PROF=1.5/BETA/BETA/SQRT(BETA) DIOI=6.28*1.48E-25*(2.*MM*RYD/DEL)*XNE(J)*(SQRT(2.*MM*RYD/DEL)* 1(1.3*QSTAT+.30*IMPACT)-3.9*RYD*HKT(J)) RATIO=QSTAT*MIN(1.+DIOI,1.25D0)+IMPACT 50 STARK=.0265384*FNM*PROF*DBETA*RATIO RETURN END FUNCTION COULX(N,FREQ,Z) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION A(6),B(6),C(6) DATA A/.9916,1.105,1.101,1.101,1.102,1.0986/ DATA B/2.719E13,-2.375E14,-9.863E13,-5.765E13,-3.909E13,-2.704E13/ DATA C/-2.268E30,4.077E28,1.035E28,4.593E27,2.371E27,1.229E27/ IF(FREQ.LT.Z*Z*3.28805D15/DBLE(N*N))GO TO 1 COULX=2.815E29/FREQ/FREQ/FREQ/DBLE(N**5)*Z**4 IF(N.GT.6)RETURN COULX=COULX*(A(N)+(B(N)+C(N)*(Z*Z/FREQ))*(Z*Z/FREQ)) RETURN 1 COULX=0. RETURN END SUBROUTINE LINOP(N,NSTEPS,STEPWT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) DIMENSION STEPS(9,29,10) DIMENSION WT(10) DIMENSION CO1(kw),CO2(kw),CO3(kw),CO4(kw),INEJ(kw),ITJ(kw) DIMENSION TABT(29),TABNE(9) DATA TABT/3.48,3.52,3.56,3.60,3.64,3.68,3.72,3.76,3.80,3.84,3.88, 1 3.92,3.96,4.0,4.05,4.10,4.15,4.20,4.25,4.30,4.35,4.40,4.45,4.5, 2 4.6,4.7,4.8,4.9,5.0/ DATA TABNE/17.,16.,15.,14.,13.,12.,11.,10.,9./ DATA ITEMP1/0/ DATA TENLOG/2.30258509299405E0/ IF(ITEMP.EQ.ITEMP1)GO TO 20 ITEMP1=ITEMP DO 15 J=1,NRHOX TL=TLOG(J)/TENLOG DO 10 IT=2,29 IF(TL.LT.TABT(IT))GO TO 11 10 CONTINUE IT=29 11 XNELOG= LOG10(XNE(J)) DO 12 INE=2,9 IF(XNELOG.GT.TABNE(INE))GO TO 13 12 CONTINUE INE=9 13 INEJ(J)=INE ITJ(J)=IT X=(TL-TABT(IT-1))/(TABT(IT)-TABT(IT-1)) Y=(XNELOG-TABNE(INE-1))/(TABNE(INE)-TABNE(INE-1)) CO1(J)=(1.-X)*(1.-Y)*TENLOG CO2(J)=(1.-X)*Y*TENLOG CO3(J)=X*(1.-Y)*TENLOG CO4(J)=X*Y*TENLOG 15 CONTINUE WT(1)=1./60. WT(2)=2./60. WT(3)=3./60. WT(4)=6./60. WT(5)=6./60. WT(6)=6./60. WT(7)=6./60. WT(8)=10./60. WT(9)=10./60. WT(10)=10./60. REWIND 9 WLEND=0. 20 WAVE=2.997925E17/FREQ 21 IF(WAVE.LT.WLEND)GO TO 22 READ(9)WLBEG,WLEND,STEPS GO TO 21 22 NSTEPS=10 STEPWT=WT(N) DO 25 J=1,NRHOX IT=ITJ(J) INE=INEJ(J) 25 ALINES(J)=EXP(CO1(J)*STEPS(INE-1,IT-1,N)+CO2(J)*STEPS(INE,IT-1,N)+ 1CO3(J)*STEPS(INE-1,IT,N)+CO4(J)*STEPS(INE,IT,N)) RETURN END SUBROUTINE LINSOP(J,NSTEPS,STEPWT) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C DUMMY FOR LINE ABSORPTION DISTRIBUTION FUNCTIONS S=J COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) RETURN END SUBROUTINE XLINOP RETURN END SUBROUTINE XLISOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) C DUMMY LINE SCATTERING ROUTINE RETURN END SUBROUTINE XCONOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C DUMMY CONTINUOUS OPACITY ROUTINE COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) RETURN END SUBROUTINE XSOP IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C DUMMY SCATTERING ROUTINE COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw), 1 SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw), 2 SXLINE(kw),SXCONT(kw) RETURN END SUBROUTINE JOSH(IFSCAT,IFSURF) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C IFSCAT=1 SOLVE INTEGRAL EQUATION FOR SOURCE FUNCTION C IFSCAT=0 SET SNU=SBAR C IFSURF=0 CALCULATE J AND H C IFSURF=1 CALCULATE SURFACE FLUX C IFSURF=2 CALCULATE SURFACE SPECIFIC INTENSITY COMMON /ABTOT/ABTOT(kw),ALPHA(kw) COMMON /MATX/COEFJ(51,51),COEFH(51,51),XTAU(51),NXTAU REAL*4 COEFJ,COEFH,XTAU COMMON /MUS/ANGLE(20),SURFI(20),NMU COMMON /OPTOT/ACONT(kw),SCONT(kw),ALINE(kw),SLINE(kw),SIGMAC(kw), 1 SIGMAL(kw) COMMON /PRD/PRDDOP,PRDPOW,ITPRD,NITPRD,SIGPRD(kw),NUPRD,LINPRD COMMON /PZERO/PZERO,PCON,PRAD0,PTURB0,KNU(kw),PRADK(kw),RADEN(kw) REAL*8 KNU COMMON /RHOX/RHOX(kw),NRHOX COMMON /TAUSHJ/TAUNU(kw),SNU(kw),HNU(kw),JNU(kw),JMINS(kw) REAL*8 JNU,JMINS REAL*4 XS(51),XSBAR(51),XALPHA(51),DIAG(51),XH(51),XJS(51) REAL*4 CK(51),CH(51),DELXS,ERRORX,XJ,XBETA(51),XK REAL*8 XSBAR8(51),XALPHA8(51),XS8(51),XH8(51),XJS8(51),XTAU8(51) REAL*8 XBETA8(51) REAL*8 BETA(kw) REAL*8 A(kw),B(kw),C(kw),SNUBAR(kw),CTWO(kw),B2CT(kw),B2CT1(kw) REAL*8 EXTAU(51,20),NEW DATA CH/ 1 7.15528131E-07, 1.49142693E-06, 1.52106577E-06, 2.98150826E-06, 2 5.33941056E-06, 9.13329677E-06, 1.61715943E-05, 2.97035986E-05, 3 5.33166603E-05, 9.11154202E-05, 1.61084638E-04, 2.95118050E-04, 4 5.27450291E-04, 8.67939554E-04, 1.61498412E-03, 2.50720908E-03, 5 3.20994272E-03, 5.61912498E-03, 8.60872678E-03, 1.04706492E-02, 6 1.33110350E-02, 1.62635669E-02, 1.90288834E-02, 2.18877215E-02, 7 2.36015432E-02, 2.10819542E-02, 1.80345085E-02, 1.64786074E-02, 8 1.49382707E-02, 1.19676525E-02, 9.90213640E-03, 8.17766134E-03, 8 6.11252524E-03, 4.84035723E-03, 3.06078210E-03, 2.40512565E-03, 9 2.01712688E-03, 1.33288081E-03, 7.83530239E-04, 4.31428343E-04, T 1.76504589E-04, 4.75738016E-05, 1.65963702E-05, 5.41117970E-06, 1 2.08043571E-06, 7.11612643E-07, 8.08788982E-08, 1.95130507E-08, 3 4.33638281E-09, 8.87765583E-10, 3.90236420E-11/ DATA CK/ 1 3.57771910E-07, 7.45730404E-07, 7.60575176E-07, 1.49091113E-06, 2 2.67016185E-06, 4.56793896E-06, 8.08956065E-06, 1.48632944E-05, 3 2.66928291E-05, 4.56529851E-05, 8.08134864E-05, 1.48363324E-04, 4 2.66052346E-04, 4.39771306E-04, 8.25088180E-04, 1.29440730E-03, 5 1.67680858E-03, 2.98973685E-03, 4.68314718E-03, 5.84855257E-03, 6 7.64854718E-03, 9.63155832E-03, 1.16419578E-02, 1.38551742E-02, 7 1.54840983E-02, 1.42877987E-02, 1.25930300E-02, 1.17983138E-02, 8 1.09717194E-02, 8.98320694E-03, 7.59950886E-03, 6.38808031E-03, 9 4.86854184E-03, 3.91568616E-03, 2.51398841E-03, 2.00142385E-03, T 1.70069211E-03, 1.14058319E-03, 6.80292083E-04, 3.80097074E-04, 1 1.57705377E-04, 4.31706540E-05, 1.51795348E-05, 4.98576401E-06, 2 1.92979223E-06, 6.63957223E-07, 7.65236692E-08, 1.84933668E-08, 3 4.12596224E-09, 8.47334369E-10, 3.81791959E-11/ DATA XTAU8/0.,.0000032,.0000056,.00001,.000018,.000032,.000056, 1.0001,.00018,.00032,.00056,.001,.0018,.0032,.0056,.01,.016,.025, 2.042,.065,.096,.139,.196,.273,.375,.5,.63,.78,.95,1.15,1.35,1.6, 3 1.85,2.15,2.45,2.75,3.15,3.65,4.25,5.0,6.,7.,8.,9.,10.,11.5, 4 13.,14.5,16.,18.,20./ DATA EXTAU/1020*0./ DO 10 J=1,NRHOX ABTOT(J)=ACONT(J)+ALINE(J)+SIGMAC(J)+SIGMAL(J) ALPHA(J)=(SIGMAC(J)+SIGMAL(J))/ABTOT(J) C ALPHA(J)=(SIGMAC(J)+SIGMAL(J)+SIGPRD(J))/ABTOT(J) C BETA(J)=(ACONT(J)+ALINE(J))/ABTOT(J) 10 SNUBAR(J)=(ACONT(J)*SCONT(J)+ALINE(J)*SLINE(J))/ 1(ACONT(J)+ALINE(J)) CALL INTEG(RHOX,ABTOT,TAUNU,NRHOX,ABTOT(1)*RHOX(1)) MAXJ=0 IF(IFSCAT.EQ.1)GO TO 30 C DO 20 J=1,NRHOX 20 SNU(J)=SNUBAR(J) IF(IFSURF.EQ.2)GO TO 70 MAXJ=MAP1(TAUNU,SNU,NRHOX,XTAU8,XS8,NXTAU) DO 22 L=1,NXTAU 22 XS(L)=XS8(L) IF(IFSURF.EQ.1)GO TO 60 DO 21 J=1,NRHOX 21 ALPHA(J)=0. C 30 IF(TAUNU(1).GT.XTAU8(NXTAU))MAXJ=1 IF(MAXJ.EQ.1)GO TO 401 MAXJ=MAP1(TAUNU,SNUBAR,NRHOX,XTAU8,XSBAR8,NXTAU) MAXJ=MAP1(TAUNU,ALPHA,NRHOX,XTAU8,XALPHA8,NXTAU) C MAXJ=MAP1(TAUNU,BETA,NRHOX,XTAU8,XBETA8,NXTAU) DO 31 L=1,NXTAU C IN CASE OF BAD INTERPOLATION XALPHA(L)=MAX(XALPHA8(L),0.D0) XSBAR(L)=MAX(XSBAR8(L),1.D-38) XBETA(L)=MAX(XBETA8(L),0.D0) IF(XTAU8(L).LT.TAUNU(1))THEN XSBAR(L)=MAX(SNUBAR(1),1.D-38) XALPHA(L)=MAX(ALPHA(1),0.D0) XBETA(L)=MAX(BETA(1),0.D0) ENDIF XS(L)=XSBAR(L) DIAG(L)=1.-XALPHA(L)*COEFJ(L,L) C 31 XSBAR(L)=XBETA(L)*XSBAR(L) 31 XSBAR(L)=(1.-XALPHA(L))*XSBAR(L) C THE LIMIT ON DO 34, THE MAXIMUM NUMBER OF ITERATIONS, IS ARBITRARY DO 34 L=1,NXTAU IFERR=0 K=NXTAU+1 DO 33 KK=1,NXTAU K=K-1 DELXS=0. DO 32 M=1,NXTAU 32 DELXS=DELXS+COEFJ(K,M)*XS(M) DELXS=(DELXS*XALPHA(K)+XSBAR(K)-XS(K))/DIAG(K) ERRORX=ABS(DELXS/XS(K)) IF(ERRORX.GT..00001)IFERR=1 33 XS(K)=MAX(XS(K)+DELXS,1.E-38) 39 IF(IFERR.EQ.0)GO TO 35 34 CONTINUE C 35 IF(IFSURF.EQ.1)GO TO 60 DO 305 M=1,NXTAU 305 XS8(M)=XS(M) IF(IFSURF.EQ.2)GO TO 670 MDUMMY=MAP1(XTAU8,XS8,NXTAU,TAUNU,SNU,MAXJ) IF(MAXJ.EQ.NRHOX)GO TO 46 401 MAXJ1=MAXJ+1 IF(MAXJ.EQ.1)MAXJ1=1 DO 40 J=MAXJ1,NRHOX 40 SNU(J)=SNUBAR(J) M=MAX0(MAXJ-1,1) NM1=NRHOX-M+1 NMJ=NRHOX-MAXJ+1 C THE LIMIT ON DO 45 IS ARBITRARY DO 45 L=1,NXTAU ERROR=0. CALL DERIV(TAUNU(M),SNU(M),HNU(M),NM1) DO 41 J=M,NRHOX 41 HNU(J)=HNU(J)/3. CALL DERIV(TAUNU(MAXJ),HNU(MAXJ),JMINS(MAXJ),NMJ) DO 43 J=MAXJ1,NRHOX JNU(J)=JMINS(J)+SNU(J) C SNEW=BETA(J)*SNUBAR(J)+ALPHA(J)*JNU(J) SNEW=(1.-ALPHA(J))*SNUBAR(J)+ALPHA(J)*JNU(J) ERROR=ABS(SNEW-SNU(J))/SNEW+ERROR 43 SNU(J)=SNEW IF(ERROR.LT..00001)GO TO 46 45 CONTINUE 46 IF(IFSURF.EQ.2)GO TO 70 IF(MAXJ.EQ.1)THEN KNU(1)=JNU(1)/3. RETURN ENDIF C 50 DO 51 L=1,NXTAU XJS(L)=-XS(L) DO 501 M=1,NXTAU 501 XJS(L)=XJS(L)+COEFJ(L,M)*XS(M) XJS8(L)=XJS(L) XH(L)=0. DO 502 M=1,NXTAU 502 XH(L)=XH(L)+COEFH(L,M)*XS(M) 51 XH8(L)=XH(L) MDUMMY=MAP1(XTAU8,XJS8,NXTAU,TAUNU,JMINS,MAXJ) MDUMMY=MAP1(XTAU8,XH8,NXTAU,TAUNU,HNU,MAXJ) XK=0. DO 52 M=1,NXTAU 52 XK=XK+CK(M)*XS(M) KNU(1)=XK DO 53 J=1,MAXJ 53 JNU(J)=JMINS(J)+SNU(J) RETURN C 60 XH(1)=0. DO 61 M=1,NXTAU 61 XH(1)=XH(1)+CH(M)*XS(M) HNU(1)=XH(1) RETURN C C ASSUMES REAL*8 AND LARGE EXPONENT RANGE 670 CALL PARCOE(XS8,XTAU8,A,B,C,NXTAU) N1=NXTAU-1 DO 671 J=1,NXTAU CTWO(J)=C(J)*2. 671 B2CT(J)=B(J)+CTWO(J)*XTAU8(J) DO 672 J=1,N1 672 B2CT1(J)=B(J)+CTWO(J)*XTAU8(J+1) IF(EXTAU(1,1).EQ.0.)THEN DO 673 MU=1,NMU DO 673 J=1,NXTAU TANGLE=XTAU8(J)/ANGLE(MU) IF(TANGLE.LT.300.)EXTAU(J,MU)=EXP(-TANGLE) 673 CONTINUE ENDIF DO 675 MU=1,NMU SURFI(MU)=0. DO 674 J=1,N1 IF(EXTAU(J,MU).EQ.0.)GO TO 675 674 SURFI(MU)=SURFI(MU)+ 1EXTAU(J,MU)*(XS8(J)+(B2CT(J)+CTWO(J)*ANGLE(MU))*ANGLE(MU))- 2EXTAU(J+1,MU)*(XS8(J+1)+(B2CT1(J)+CTWO(J)*ANGLE(MU))*ANGLE(MU)) SURFI(MU)=SURFI(MU)+EXTAU(NXTAU,MU)*(XS8(NXTAU)+(B2CT(NXTAU)+ 1CTWO(NXTAU)*ANGLE(MU))*ANGLE(MU)) 675 CONTINUE RETURN C 70 CALL PARCOE(SNU,TAUNU,A,B,C,NRHOX) N1=NRHOX-1 DO 71 J=1,NRHOX CTWO(J)=C(J)*2. 71 B2CT(J)=B(J)+CTWO(J)*TAUNU(J) DO 710 J=1,N1 710 B2CT1(J)=B(J)+CTWO(J)*TAUNU(J+1) DO 75 MU=1,NMU OLD=1. SUM=0. DO 73 J=1,N1 TANGLE=TAUNU(J+1)/ANGLE(MU) NEW=EXP(-TANGLE) D=TANGLE-TAUNU(J)/ANGLE(MU) IF(D.LE..03)GO TO 72 SUM=SUM+OLD*(SNU(J)+(B2CT(J)+CTWO(J)*ANGLE(MU))*ANGLE(MU))- 1 NEW*(SNU(J+1)+(B2CT1(J)+CTWO(J)*ANGLE(MU))*ANGLE(MU)) C REAL*4 C IF(TANGLE.LT.50.)GO TO 73 C REAL*8 G-FLOATING IF(TANGLE.LT.300.)GO TO 73 SURFI(MU)=SUM GO TO 75 72 DDDDD=1. IF(D.GT..001)DDDDD=((((D/9.+1.)*D/8.+1.)*D/7.+1.)*D/6.+1.)*D/5.+1. SUM=SUM+NEW*(SNU(J)+(SNU(J)+B2CT(J)*ANGLE(MU)+(SNU(J)+(B2CT(J)+ 1CTWO(J)*ANGLE(MU))*ANGLE(MU))*(DDDDD*D/4.+1.)*D/3.)*D/2.)*D 73 OLD=NEW SURFI(MU)=SUM+OLD*(SNU(NRHOX)+(B2CT(NRHOX)+CTWO(NRHOX)*ANGLE(MU))* 1ANGLE(MU)) 75 CONTINUE RETURN END SUBROUTINE BLOCKJ COMMON /MATX/CJ(2601),CH(2601),XTAU(51),NXTAU DIMENSION CJ 1(36),CJ 2(36),CJ 3(36),CJ 4(36),CJ 5(36) DIMENSION CJ 6(36),CJ 7(36),CJ 8(36),CJ 9(36),CJ 10(36) DIMENSION CJ 11(36),CJ 12(36),CJ 13(36),CJ 14(36),CJ 15(36) DIMENSION CJ 16(36),CJ 17(36),CJ 18(36),CJ 19(36),CJ 20(36) DIMENSION CJ 21(36),CJ 22(36),CJ 23(36),CJ 24(36),CJ 25(36) DIMENSION CJ 26(36),CJ 27(36),CJ 28(36),CJ 29(36),CJ 30(36) DIMENSION CJ 31(36),CJ 32(36),CJ 33(36),CJ 34(36),CJ 35(36) DIMENSION CJ 36(36),CJ 37(36),CJ 38(36),CJ 39(36),CJ 40(36) DIMENSION CJ 41(36),CJ 42(36),CJ 43(36),CJ 44(36),CJ 45(36) DIMENSION CJ 46(36),CJ 47(36),CJ 48(36),CJ 49(36),CJ 50(36) DIMENSION CJ 51(36),CJ 52(36),CJ 53(36),CJ 54(36),CJ 55(36) DIMENSION CJ 56(36),CJ 57(36),CJ 58(36),CJ 59(36),CJ 60(36) DIMENSION CJ 61(36),CJ 62(36),CJ 63(36),CJ 64(36),CJ 65(36) DIMENSION CJ 66(36),CJ 67(36),CJ 68(36),CJ 69(36),CJ 70(36) DIMENSION CJ 71(36),CJ 72(36),CJ 73( 9) EQUIVALENCE (CJ 1(1),CJ ( 1)),(CJ 2(1),CJ ( 37)) EQUIVALENCE (CJ 3(1),CJ ( 73)),(CJ 4(1),CJ ( 109)) EQUIVALENCE (CJ 5(1),CJ ( 145)),(CJ 6(1),CJ ( 181)) EQUIVALENCE (CJ 7(1),CJ ( 217)),(CJ 8(1),CJ ( 253)) EQUIVALENCE (CJ 9(1),CJ ( 289)),(CJ 10(1),CJ ( 325)) EQUIVALENCE (CJ 11(1),CJ ( 361)),(CJ 12(1),CJ ( 397)) EQUIVALENCE (CJ 13(1),CJ ( 433)),(CJ 14(1),CJ ( 469)) EQUIVALENCE (CJ 15(1),CJ ( 505)),(CJ 16(1),CJ ( 541)) EQUIVALENCE (CJ 17(1),CJ ( 577)),(CJ 18(1),CJ ( 613)) EQUIVALENCE (CJ 19(1),CJ ( 649)),(CJ 20(1),CJ ( 685)) EQUIVALENCE (CJ 21(1),CJ ( 721)),(CJ 22(1),CJ ( 757)) EQUIVALENCE (CJ 23(1),CJ ( 793)),(CJ 24(1),CJ ( 829)) EQUIVALENCE (CJ 25(1),CJ ( 865)),(CJ 26(1),CJ ( 901)) EQUIVALENCE (CJ 27(1),CJ ( 937)),(CJ 28(1),CJ ( 973)) EQUIVALENCE (CJ 29(1),CJ (1009)),(CJ 30(1),CJ (1045)) EQUIVALENCE (CJ 31(1),CJ (1081)),(CJ 32(1),CJ (1117)) EQUIVALENCE (CJ 33(1),CJ (1153)),(CJ 34(1),CJ (1189)) EQUIVALENCE (CJ 35(1),CJ (1225)),(CJ 36(1),CJ (1261)) EQUIVALENCE (CJ 37(1),CJ (1297)),(CJ 38(1),CJ (1333)) EQUIVALENCE (CJ 39(1),CJ (1369)),(CJ 40(1),CJ (1405)) EQUIVALENCE (CJ 41(1),CJ (1441)),(CJ 42(1),CJ (1477)) EQUIVALENCE (CJ 43(1),CJ (1513)),(CJ 44(1),CJ (1549)) EQUIVALENCE (CJ 45(1),CJ (1585)),(CJ 46(1),CJ (1621)) EQUIVALENCE (CJ 47(1),CJ (1657)),(CJ 48(1),CJ (1693)) EQUIVALENCE (CJ 49(1),CJ (1729)),(CJ 50(1),CJ (1765)) EQUIVALENCE (CJ 51(1),CJ (1801)),(CJ 52(1),CJ (1837)) EQUIVALENCE (CJ 53(1),CJ (1873)),(CJ 54(1),CJ (1909)) EQUIVALENCE (CJ 55(1),CJ (1945)),(CJ 56(1),CJ (1981)) EQUIVALENCE (CJ 57(1),CJ (2017)),(CJ 58(1),CJ (2053)) EQUIVALENCE (CJ 59(1),CJ (2089)),(CJ 60(1),CJ (2125)) EQUIVALENCE (CJ 61(1),CJ (2161)),(CJ 62(1),CJ (2197)) EQUIVALENCE (CJ 63(1),CJ (2233)),(CJ 64(1),CJ (2269)) EQUIVALENCE (CJ 65(1),CJ (2305)),(CJ 66(1),CJ (2341)) EQUIVALENCE (CJ 67(1),CJ (2377)),(CJ 68(1),CJ (2413)) EQUIVALENCE (CJ 69(1),CJ (2449)),(CJ 70(1),CJ (2485)) EQUIVALENCE (CJ 71(1),CJ (2521)),(CJ 72(1),CJ (2557)) EQUIVALENCE (CJ 73(1),CJ (2593)) DATA CJ 1/ 1 9.79744820E-06, 8.96296860E-06, 8.35934549E-06, 7.89335126E-06, 2 7.44161783E-06, 7.01338932E-06, 6.60406268E-06, 6.18398056E-06, 3 5.76053476E-06, 5.34734829E-06, 4.94621727E-06, 4.53113519E-06, 4 4.11083148E-06, 3.69997631E-06, 3.30117385E-06, 2.88937415E-06, 5 2.55730770E-06, 2.24433006E-06, 1.88506336E-06, 1.58859300E-06, 6 1.33086897E-06, 1.09505641E-06, 8.86720269E-07, 6.98736456E-07, 7 5.33933743E-07, 4.00542516E-07, 3.06250782E-07, 2.30467716E-07, 8 1.70827079E-07, 1.22755304E-07, 8.97411915E-08, 6.17573521E-08, 9 4.31436590E-08, 2.84810947E-08, 1.90445828E-08, 1.28647073E-08/ DATA CJ 2/ 1 7.72163607E-09, 4.14498085E-09, 2.00041016E-09, 8.21655030E-10, 2 2.57654521E-10, 8.26321572E-11, 2.69513765E-11, 8.90661828E-12, 3 2.97449037E-12, 5.83155356E-13, 1.16051514E-13, 2.33699420E-14, 4 4.75155459E-15, 5.75016867E-16, 7.03774182E-17, 1.84495605E-05, 5 2.04340585E-05, 1.83893753E-05, 1.67455934E-05, 1.56681842E-05, 6 1.47030431E-05, 1.38123877E-05, 1.29157909E-05, 1.20215185E-05, 7 1.11539807E-05, 1.03144214E-05, 9.44721432E-06, 8.57000031E-06, 8 7.71299640E-06, 6.88139393E-06, 6.02284144E-06, 5.33058911E-06, 9 4.67816358E-06, 3.92926961E-06, 3.31128764E-06, 2.77407705E-06/ DATA CJ 3/ 1 2.28254302E-06, 1.84828352E-06, 1.45644794E-06, 1.11293201E-06, 2 8.34890799E-07, 6.38348903E-07, 4.80386613E-07, 3.56071674E-07, 3 2.55870903E-07, 1.87056331E-07, 1.28726866E-07, 8.99285240E-08, 4 5.93659104E-08, 3.96964700E-08, 2.68151550E-08, 1.60949529E-08, 5 8.63978399E-09, 4.16964794E-09, 1.71265479E-09, 5.37054134E-10, 6 1.72238158E-10, 5.61773464E-11, 1.85649208E-11, 6.20001617E-12, 7 1.21552673E-12, 2.41897316E-13, 4.87122141E-14, 9.90412136E-15, 8 1.19856284E-15, 1.46694406E-16, 1.73787847E-05, 1.87918674E-05, 9 2.08999830E-05, 1.83387653E-05, 1.62807705E-05, 1.51671131E-05/ DATA CJ 4/ 1 1.41811027E-05, 1.32240507E-05, 1.22888417E-05, 1.13916825E-05, 2 1.05286937E-05, 9.64030881E-06, 8.74342375E-06, 7.86815095E-06, 3 7.01932516E-06, 6.14328580E-06, 5.43706123E-06, 4.77153058E-06, 4 4.00764123E-06, 3.37730951E-06, 2.82937491E-06, 2.32803523E-06, 5 1.88511642E-06, 1.48546973E-06, 1.13510730E-06, 8.51525287E-07, 6 6.51067057E-07, 4.89957364E-07, 3.63165556E-07, 2.60968439E-07, 7 1.90782877E-07, 1.31291340E-07, 9.17200485E-08, 6.05485677E-08, 8 4.04872778E-08, 2.73493468E-08, 1.64155829E-08, 8.81189759E-09, 9 4.25271133E-09, 1.74677236E-09, 5.47752673E-10, 1.75669266E-10/ DATA CJ 5/ 1 5.72964369E-11, 1.89347458E-11, 6.32352422E-12, 1.23974071E-12, 2 2.46716040E-13, 4.96825863E-14, 1.01014163E-14, 1.22243878E-15, 3 1.49616625E-16, 3.25551939E-05, 3.36923300E-05, 3.51339037E-05, 4 3.88807453E-05, 3.39978572E-05, 3.01736404E-05, 2.80557516E-05, 5 2.60587444E-05, 2.41623827E-05, 2.23709199E-05, 2.06616637E-05, 6 1.89100581E-05, 1.71462550E-05, 1.54274129E-05, 1.37618090E-05, 7 1.20435652E-05, 1.06587206E-05, 9.35383616E-06, 7.85622517E-06, 8 6.62051755E-06, 5.54637186E-06, 4.56358554E-06, 3.69533249E-06, 9 2.91191152E-06, 2.22510520E-06, 1.66920873E-06, 1.27625797E-06/ DATA CJ 6/ 1 9.60441144E-07, 7.11896566E-07, 5.11564087E-07, 3.73982533E-07, 2 2.57364048E-07, 1.79794324E-07, 1.18690371E-07, 7.93652009E-08, 3 5.36115600E-08, 3.21786438E-08, 1.72735185E-08, 8.33637456E-09, 4 3.42410898E-09, 1.07373157E-09, 3.44355456E-10, 1.12315261E-10, 5 3.71168073E-11, 1.23956785E-11, 2.43019968E-12, 4.83624689E-13, 6 9.73902009E-14, 1.98012828E-14, 2.39628331E-15, 2.93285700E-16, 7 5.51439894E-05, 5.61737699E-05, 5.70971222E-05, 5.97158543E-05, 8 6.64856520E-05, 5.78678247E-05, 5.11761113E-05, 4.71765037E-05, 9 4.35390905E-05, 4.02099897E-05, 3.70855896E-05, 3.39125099E-05/ DATA CJ 7/ 1 3.07335362E-05, 2.76442550E-05, 2.46552200E-05, 2.15743729E-05, 2 1.90924626E-05, 1.67544242E-05, 1.40714918E-05, 1.18579707E-05, 3 9.93395930E-06, 8.17364957E-06, 6.61851880E-06, 5.21535125E-06, 4 3.98524025E-06, 2.98960335E-06, 2.28581302E-06, 1.72017429E-06, 5 1.27502343E-06, 9.16222511E-07, 6.69810519E-07, 4.60944116E-07, 6 3.22015062E-07, 2.12576632E-07, 1.42144487E-07, 9.60192338E-08, 7 5.76324937E-08, 3.09371550E-08, 1.49305800E-08, 6.13263252E-09, 8 1.92306956E-09, 6.16745755E-10, 2.01158282E-10, 6.64767407E-11, 9 2.22008383E-11, 4.35252215E-12, 8.66178627E-13, 1.74427211E-13/ DATA CJ 8/ 1 3.54643725E-14, 4.29177646E-15, 5.25278713E-16, 8.91694801E-05, 2 9.01232630E-05, 9.09107328E-05, 9.25454757E-05, 9.72160435E-05, 3 1.08952038E-04, 9.40609395E-05, 8.21386656E-05, 7.52804540E-05, 4 6.92140241E-05, 6.36798786E-05, 5.81457739E-05, 5.26491551E-05, 5 4.73328076E-05, 4.22021470E-05, 3.69215245E-05, 3.26707758E-05, 6 2.86680627E-05, 2.40761116E-05, 2.02882014E-05, 1.69960157E-05, 7 1.39841085E-05, 1.13233607E-05, 8.92267193E-06, 6.81810177E-06, 8 5.11470759E-06, 3.91063057E-06, 2.94291447E-06, 2.18133635E-06, 9 1.56749018E-06, 1.14592288E-06, 7.88590043E-07, 5.50907755E-07/ DATA CJ 9/ 1 3.63678755E-07, 2.43182435E-07, 1.64270749E-07, 9.85982526E-08, 2 5.29275745E-08, 2.55433660E-08, 1.04917571E-08, 3.29000168E-09, 3 1.05513294E-09, 3.44142921E-10, 1.13728830E-10, 3.79813302E-11, 4 7.44632040E-12, 1.48186329E-12, 2.98411029E-13, 6.06726381E-14, 5 7.34239348E-15, 8.98649491E-16, 1.48734554E-04, 1.49668443E-04, 6 1.50406412E-04, 1.51853966E-04, 1.54848007E-04, 1.63105701E-04, 7 1.83690606E-04, 1.57030317E-04, 1.35729830E-04, 1.23968355E-04, 8 1.13534508E-04, 1.03387927E-04, 9.34668387E-05, 8.39522065E-05, 9 7.48117928E-05, 6.54283214E-05, 5.78852350E-05, 5.07874030E-05/ DATA CJ 10/ 1 4.26485228E-05, 3.59366977E-05, 3.01041834E-05, 2.47687422E-05, 2 2.00556632E-05, 1.58034172E-05, 1.20757841E-05, 9.05877784E-06, 3 6.92617657E-06, 5.21222091E-06, 3.86337217E-06, 2.77618035E-06, 4 2.02953927E-06, 1.39666621E-06, 9.75707553E-07, 6.44107267E-07, 5 4.30697222E-07, 2.90937554E-07, 1.74625805E-07, 9.37391181E-08, 6 4.52393852E-08, 1.85817455E-08, 5.82685384E-09, 1.86872322E-09, 7 6.09503895E-10, 2.01422551E-10, 6.72678568E-11, 1.31880025E-11, 8 2.62449257E-12, 5.28508532E-13, 1.07455822E-13, 1.30039311E-14, 9 1.59157564E-15, 2.56079901E-04, 2.57031747E-04, 2.57766555E-04/ DATA CJ 11/ 1 2.59163661E-04, 2.61888194E-04, 2.67327121E-04, 2.81742190E-04, 2 3.19354058E-04, 2.70603482E-04, 2.32425980E-04, 2.11306977E-04, 3 1.91402222E-04, 1.72512615E-04, 1.54685828E-04, 1.37706011E-04, 4 1.20357383E-04, 1.06446541E-04, 9.33741396E-05, 7.83973100E-05, 5 6.60530846E-05, 5.53292123E-05, 4.55210463E-05, 3.68579859E-05, 6 2.90425875E-05, 2.21917680E-05, 1.66471758E-05, 1.27280184E-05, 7 9.57827123E-06, 7.09951281E-06, 5.10161560E-06, 3.72954698E-06, 8 2.56655106E-06, 1.79298202E-06, 1.18362336E-06, 7.91455799E-07, 9 5.34630571E-07, 3.20894151E-07, 1.72255713E-07, 8.31321299E-08/ DATA CJ 12/ 1 3.41458713E-08, 1.07074315E-08, 3.43396440E-09, 1.12002317E-09, 2 3.70133495E-10, 1.23611166E-10, 2.42342125E-11, 4.82275355E-12, 3 9.71184154E-13, 1.97460132E-13, 2.38959340E-14, 2.92466775E-15, 4 4.28478665E-04, 4.29422059E-04, 4.30140918E-04, 4.31484994E-04, 5 4.34020658E-04, 4.38774835E-04, 4.48007289E-04, 4.74192413E-04, 6 5.41887598E-04, 4.55714167E-04, 3.88809223E-04, 3.48834385E-04, 7 3.12498533E-04, 2.79274664E-04, 2.48145828E-04, 2.16625539E-04, 8 1.91470492E-04, 1.67889720E-04, 1.40916781E-04, 1.18707073E-04, 9 9.94231585E-05, 8.17917639E-05, 6.62222043E-05, 5.21781154E-05/ DATA CJ 13/ 1 3.98685750E-05, 2.99067370E-05, 2.28655892E-05, 1.72069282E-05, 2 1.27538260E-05, 9.16465428E-06, 6.69979937E-06, 4.61055441E-06, 3 3.22090046E-06, 2.12624430E-06, 1.42175560E-06, 9.60397422E-07, 4 5.76444952E-07, 3.09434371E-07, 1.49335410E-07, 6.13382136E-08, 5 1.92343401E-08, 6.16860678E-09, 2.01195275E-09, 6.64888375E-10, 6 2.22048435E-10, 4.35329925E-11, 8.66332015E-12, 1.74457896E-12, 7 3.54705773E-13, 4.29252289E-14, 5.25369629E-15, 6.81346346E-04, 8 6.82255817E-04, 6.82943987E-04, 6.84219429E-04, 6.86585612E-04, 9 6.90881586E-04, 6.98754285E-04, 7.15098144E-04, 7.61797141E-04/ DATA CJ 14/ 1 8.79148726E-04, 7.30251735E-04, 6.11067411E-04, 5.42551059E-04, 2 4.82001904E-04, 4.26857355E-04, 3.71876578E-04, 3.28350939E-04, 3 2.87718988E-04, 2.41367155E-04, 2.03264175E-04, 1.70210809E-04, 4 1.40006824E-04, 1.13344596E-04, 8.93004808E-05, 6.82295010E-05, 5 5.11791622E-05, 3.91286652E-05, 2.94446879E-05, 2.18241298E-05, 6 1.56821832E-05, 1.14643071E-05, 7.88923736E-06, 5.51132513E-06, 7 3.63822025E-06, 2.43275575E-06, 1.64332221E-06, 9.86342258E-07, 8 5.29464043E-07, 2.55522410E-07, 1.04953205E-07, 3.29109410E-08, 9 1.05547740E-08, 3.44253802E-09, 1.13765089E-09, 3.79933350E-10/ DATA CJ 15/ 1 7.44864964E-11, 1.48232305E-11, 2.98503002E-12, 6.06912361E-13, 2 7.34463078E-14, 8.98921998E-15, 1.11484772E-03, 1.11575700E-03, 3 1.11644237E-03, 1.11770657E-03, 1.12003104E-03, 1.12418195E-03, 4 1.13155813E-03, 1.14602725E-03, 1.17595605E-03, 1.25851233E-03, 5 1.46433575E-03, 1.19777795E-03, 9.84898023E-04, 8.67486801E-04, 6 7.63496933E-04, 6.62669548E-04, 5.84007289E-04, 5.11122829E-04, 7 4.28377739E-04, 3.60559179E-04, 3.01823315E-04, 2.48203963E-04, 8 2.00902454E-04, 1.58263961E-04, 1.20908862E-04, 9.06877167E-05, 9 6.93314047E-05, 5.21706171E-05, 3.86672514E-05, 2.77844799E-05/ DATA CJ 16/ 1 2.03112075E-05, 1.39770538E-05, 9.76407481E-06, 6.44553426E-06, 2 4.30987268E-06, 2.91128982E-06, 1.74737828E-06, 9.37977549E-07, 3 4.52670223E-07, 1.85928420E-07, 5.83025562E-08, 1.86979588E-08, 4 6.09849176E-09, 2.01535459E-09, 6.73052396E-10, 1.31952557E-10, 5 2.62592423E-11, 5.28794933E-12, 1.07513735E-12, 1.30108980E-13, 6 1.59242422E-14, 1.87645118E-03, 1.87738833E-03, 1.87809318E-03, 7 1.87938984E-03, 1.88176229E-03, 1.88596108E-03, 1.89330275E-03, 8 1.90726205E-03, 1.93448596E-03, 1.98883781E-03, 2.13292357E-03, 9 2.50895650E-03, 2.02160072E-03, 1.64022652E-03, 1.42967764E-03/ DATA CJ 17/ 1 1.23180309E-03, 1.08166934E-03, 9.44527709E-04, 7.90233024E-04, 2 6.64466714E-04, 5.55869126E-04, 4.56912546E-04, 3.69718850E-04, 3 2.91182454E-04, 2.22414806E-04, 1.66800680E-04, 1.27509362E-04, 4 9.59420089E-05, 7.11054588E-05, 5.10907704E-05, 3.73475053E-05, 5 2.56997018E-05, 1.79528489E-05, 1.18509126E-05, 7.92410065E-06, 6 5.35260374E-06, 3.21262703E-06, 1.72448625E-06, 8.32230538E-07, 7 3.41823776E-07, 1.07186229E-07, 3.43749330E-08, 1.12115909E-08, 8 3.70504943E-09, 1.23734148E-09, 2.42580742E-10, 4.82746345E-11, 9 9.72126355E-12, 1.97650655E-12, 2.39188535E-13, 2.92745938E-14/ DATA CJ 18/ 1 3.05596719E-03, 3.05690144E-03, 3.05760323E-03, 3.05889229E-03, 2 3.06124422E-03, 3.06538575E-03, 3.07256282E-03, 3.08598245E-03, 3 3.11130067E-03, 3.15877520E-03, 3.25098448E-03, 3.51262193E-03, 4 4.18929515E-03, 3.32802567E-03, 2.66019874E-03, 2.26255826E-03, 5 1.97241133E-03, 1.71470116E-03, 1.42979273E-03, 1.19998887E-03, 6 1.00267078E-03, 8.23483583E-04, 6.65943148E-04, 5.24251321E-04, 7 4.00308105E-04, 3.00140478E-04, 2.29403448E-04, 1.72588821E-04, 8 1.27898063E-04, 9.18898504E-05, 6.71676646E-05, 4.62170248E-05, 9 3.22840871E-05, 2.13103008E-05, 1.42486670E-05, 9.62450663E-06/ DATA CJ 19/ 1 5.77646456E-06, 3.10063265E-06, 1.49631817E-06, 6.14572206E-07, 2 1.92708225E-07, 6.18011032E-08, 2.01565561E-08, 6.66099210E-09, 3 2.22449327E-09, 4.36107753E-10, 8.67867310E-11, 1.74765026E-11, 4 3.55326822E-12, 4.29999393E-13, 5.26279611E-14, 4.58905399E-03, 5 4.58994482E-03, 4.59061355E-03, 4.59184086E-03, 4.59407675E-03, 6 4.59800330E-03, 4.60477562E-03, 4.61732873E-03, 4.64062203E-03, 7 4.68292875E-03, 4.76051134E-03, 4.92176307E-03, 5.38442458E-03, 8 6.54922376E-03, 5.03719066E-03, 3.84919968E-03, 3.34188460E-03, 9 2.88688751E-03, 2.39518284E-03, 2.00456361E-03, 1.67194936E-03/ DATA CJ 20/ 1 1.37143155E-03, 1.10808371E-03, 8.71743749E-04, 6.65317431E-04, 2 4.98659080E-04, 3.81044905E-04, 2.86621113E-04, 2.12371138E-04, 3 1.52561656E-04, 1.11506092E-04, 7.67190760E-05, 5.35872980E-05, 4 3.53701589E-05, 2.36483834E-05, 1.59731092E-05, 9.58640571E-06, 5 5.14549598E-06, 2.48305034E-06, 1.01981189E-06, 3.19766809E-07, 6 1.02546081E-07, 3.34450069E-08, 1.10521721E-08, 3.69092105E-09, 7 7.23588135E-10, 1.43994616E-10, 2.89963727E-11, 5.89541038E-12, 8 7.13428630E-13, 8.73165412E-14, 7.63344239E-03, 7.63436095E-03, 9 7.63505020E-03, 7.63631460E-03, 7.63861604E-03, 7.64265143E-03/ DATA CJ 21/ 1 7.64959272E-03, 7.66239614E-03, 7.68593738E-03, 7.72797518E-03, 2 7.80267307E-03, 7.94918588E-03, 8.25219168E-03, 9.08595967E-03, 3 1.11718179E-02, 8.50948584E-03, 6.67067668E-03, 5.66624412E-03, 4 4.63749691E-03, 3.85370081E-03, 3.20032500E-03, 2.61728999E-03, 5 2.11034644E-03, 1.65770792E-03, 1.26373000E-03, 9.46397409E-04, 6 7.22788157E-04, 5.43449520E-04, 4.02532513E-04, 2.89087221E-04, 7 2.11247909E-04, 1.45315957E-04, 1.01486491E-04, 6.69768382E-05, 8 4.47757942E-05, 3.02408867E-05, 1.81477045E-05, 9.73991532E-06, 9 4.69979281E-06, 1.93010363E-06, 6.05148839E-07, 1.94054898E-07/ DATA CJ 22/ 1 6.32876542E-08, 2.09132360E-08, 6.98388223E-09, 1.36911508E-09, 2 2.72448318E-10, 5.48621737E-11, 1.11541473E-11, 1.34978709E-12, 3 1.65198131E-13, 1.06716479E-02, 1.06724962E-02, 1.06731327E-02, 4 1.06743000E-02, 1.06764237E-02, 1.06801444E-02, 1.06865355E-02, 5 1.06982944E-02, 1.07198145E-02, 1.07579188E-02, 1.08245983E-02, 6 1.09515714E-02, 1.11999257E-02, 1.16984658E-02, 1.30537716E-02, 7 1.64947744E-02, 1.24602153E-02, 9.56746194E-03, 7.64827637E-03, 8 6.27825452E-03, 5.17676322E-03, 4.21361197E-03, 3.38651398E-03, 9 2.65388823E-03, 2.01962478E-03, 1.51059058E-03, 1.15272726E-03/ DATA CJ 23/ 1 8.66154710E-04, 6.41233882E-04, 4.60319778E-04, 3.36269473E-04, 2 2.31249862E-04, 1.61465725E-04, 1.06538851E-04, 7.12127109E-05, 3 4.80898278E-05, 2.88550145E-05, 1.54845115E-05, 7.47082608E-06, 4 3.06775966E-06, 9.61734204E-07, 3.08377280E-07, 1.00565701E-07, 5 3.32300398E-08, 1.10965833E-08, 2.17526303E-09, 4.32852492E-10, 6 8.71597423E-11, 1.77202052E-11, 2.14430323E-12, 2.62432019E-13, 7 1.24208536E-02, 1.24215406E-02, 1.24220560E-02, 1.24230012E-02, 8 1.24247202E-02, 1.24277306E-02, 1.24328975E-02, 1.24423905E-02, 9 1.24597184E-02, 1.24902550E-02, 1.25432456E-02, 1.26425720E-02/ DATA CJ 24/ 1 1.28308312E-02, 1.31867664E-02, 1.38836281E-02, 1.61371087E-02, 2 2.09342998E-02, 1.50640284E-02, 1.04396460E-02, 8.52366488E-03, 3 6.96923411E-03, 5.63914478E-03, 4.51383247E-03, 3.52682352E-03, 4 2.67803436E-03, 1.99989867E-03, 1.52453504E-03, 1.14460280E-03, 5 8.46833440E-04, 6.07587365E-04, 4.43675885E-04, 3.05000337E-04, 6 2.12901324E-04, 1.40441165E-04, 9.38549059E-05, 6.33698772E-05, 7 3.80168928E-05, 2.03976823E-05, 9.83979455E-06, 4.03995811E-06, 8 1.26634031E-06, 4.06007089E-07, 1.32393704E-07, 4.37443103E-08, 9 1.46069081E-08, 2.86322161E-09, 5.69721947E-10, 1.14715681E-10/ DATA CJ 25/ 1 2.33218140E-11, 2.82205447E-12, 3.45369833E-13, 1.94810935E-02, 2 1.94818503E-02, 1.94824179E-02, 1.94834588E-02, 1.94853517E-02, 3 1.94886657E-02, 1.94943513E-02, 1.95047890E-02, 1.95238140E-02, 4 1.95572554E-02, 1.96150267E-02, 1.97224258E-02, 1.99228219E-02, 5 2.02906364E-02, 2.09790973E-02, 2.24766315E-02, 2.59060675E-02, 6 3.37894606E-02, 2.36650522E-02, 1.67865205E-02, 1.34852146E-02, 7 1.07554640E-02, 8.52894897E-03, 6.62031125E-03, 5.00327821E-03, 8 3.72392321E-03, 2.83262704E-03, 2.12313739E-03, 1.56873156E-03, 9 1.12430016E-03, 8.20332823E-04, 5.63506593E-04, 3.93125304E-04/ DATA CJ 26/ 1 2.59191151E-04, 1.73143499E-04, 1.16866620E-04, 7.00863842E-05, 2 3.75917115E-05, 1.81285895E-05, 7.44097441E-06, 2.33174953E-06, 3 7.47439487E-07, 2.43692177E-07, 8.05085341E-08, 2.68803496E-08, 4 5.26840946E-09, 1.04820661E-09, 2.11044554E-10, 4.29029307E-11, 5 5.19111983E-12, 6.35267562E-13, 2.68144794E-02, 2.68152340E-02, 6 2.68158000E-02, 2.68168377E-02, 2.68187248E-02, 2.68220282E-02, 7 2.68276939E-02, 2.68380900E-02, 2.68570222E-02, 2.68902478E-02, 8 2.69474868E-02, 2.70533594E-02, 2.72490323E-02, 2.76017887E-02, 9 2.82397420E-02, 2.95368461E-02, 3.16415686E-02, 3.66967999E-02/ DATA CJ 27/ 1 4.98810707E-02, 3.43114781E-02, 2.40016204E-02, 1.87161429E-02, 2 1.45996143E-02, 1.12081149E-02, 8.40567489E-03, 6.22335553E-03, 3 4.71782027E-03, 3.52695811E-03, 2.60069160E-03, 1.86076446E-03, 4 1.35601978E-03, 9.30420718E-04, 6.48541490E-04, 4.27250986E-04, 5 2.85234445E-04, 1.92429775E-04, 1.15342167E-04, 6.18339132E-05, 6 2.98055973E-05, 1.22285626E-05, 3.83040581E-06, 1.22745361E-06, 7 4.00099709E-07, 1.32156222E-07, 4.41179135E-08, 8.64532737E-09, 8 1.71983935E-09, 3.46231251E-10, 7.03783355E-11, 8.51470572E-12, 9 1.04191002E-12, 2.93105845E-02, 2.93111926E-02, 2.93116486E-02/ DATA CJ 28/ 1 2.93124848E-02, 2.93140052E-02, 2.93166665E-02, 2.93212301E-02, 2 2.93296012E-02, 2.93448369E-02, 2.93715472E-02, 2.94174786E-02, 3 2.95021568E-02, 2.96577012E-02, 2.99349550E-02, 3.04259264E-02, 4 3.13820917E-02, 3.28196439E-02, 3.52993354E-02, 4.37293513E-02, 5 6.16813834E-02, 4.10710605E-02, 2.73272861E-02, 2.08412122E-02, 6 1.57078159E-02, 1.16349995E-02, 8.54306269E-03, 6.44256291E-03, 7 4.79727031E-03, 3.52654009E-03, 2.51682379E-03, 1.83075442E-03, 8 1.25402197E-03, 8.72988704E-04, 5.74439671E-04, 3.83149531E-04, 9 2.58298944E-04, 1.54704606E-04, 8.28739739E-05, 3.99203092E-05/ DATA CJ 29/ 1 1.63679751E-05, 5.12384714E-06, 1.64119506E-06, 5.34777682E-07, 2 1.76593238E-07, 5.89393441E-08, 1.15466876E-08, 2.29654360E-09, 3 4.62254965E-10, 9.39497631E-11, 1.13648268E-11, 1.39050368E-12, 4 3.38719415E-02, 3.38724916E-02, 3.38729041E-02, 3.38736604E-02, 5 3.38750357E-02, 3.38774427E-02, 3.38815700E-02, 3.38891395E-02, 6 3.39029120E-02, 3.39270440E-02, 3.39685030E-02, 3.40448073E-02, 7 3.41845344E-02, 3.44321947E-02, 3.48663543E-02, 3.56957363E-02, 8 3.69034406E-02, 3.89082216E-02, 4.34786937E-02, 5.48837934E-02, 9 7.92311401E-02, 5.11201902E-02, 3.29130965E-02, 2.41709942E-02/ DATA CJ 30/ 1 1.75449024E-02, 1.27168996E-02, 9.51480609E-03, 7.04353074E-03, 2 5.15471899E-03, 3.66546818E-03, 2.65931636E-03, 1.81718603E-03, 3 1.26276077E-03, 8.29549046E-04, 5.52603530E-04, 3.72158022E-04, 4 2.22659715E-04, 1.19153630E-04, 5.73421433E-05, 2.34905250E-05, 5 7.34723417E-06, 2.35189262E-06, 7.65991588E-07, 2.52849277E-07, 6 8.43647141E-08, 1.65217439E-08, 3.28511655E-09, 6.61088474E-10, 7 1.34336273E-10, 1.62470060E-11, 1.98752421E-12, 3.78705822E-02, 8 3.78710789E-02, 3.78714514E-02, 3.78721343E-02, 3.78733761E-02, 9 3.78755493E-02, 3.78792755E-02, 3.78861088E-02, 3.78985392E-02/ DATA CJ 31/ 1 3.79203122E-02, 3.79576958E-02, 3.80264251E-02, 3.81520308E-02, 2 3.83738644E-02, 3.87602803E-02, 3.94896661E-02, 4.05309718E-02, 3 4.22050142E-02, 4.58079989E-02, 5.18680175E-02, 6.69949177E-02, 4 9.99650283E-02, 6.22151021E-02, 3.79264661E-02, 2.68360813E-02, 5 1.90636001E-02, 1.40947336E-02, 1.03444628E-02, 7.52188726E-03, 6 5.32118372E-03, 3.84637814E-03, 2.61953759E-03, 1.81578530E-03, 7 1.19014956E-03, 7.91436695E-04, 5.32265138E-04, 3.17985329E-04, 8 1.69927045E-04, 8.16723406E-05, 3.34177509E-05, 1.04402136E-05, 9 3.33917358E-06, 1.08684559E-06, 3.58580423E-07, 1.19593740E-07/ DATA CJ 32/ 1 2.34095416E-08, 4.65290141E-09, 9.36054907E-10, 1.90163622E-10, 2 2.29927543E-11, 2.81213504E-12, 4.07045732E-02, 4.07050138E-02, 3 4.07053442E-02, 4.07059501E-02, 4.07070517E-02, 4.07089796E-02, 4 4.07122849E-02, 4.07183460E-02, 4.07293704E-02, 4.07486759E-02, 5 4.07818096E-02, 4.08426810E-02, 4.09537773E-02, 4.11495151E-02, 6 4.14890357E-02, 4.21248963E-02, 4.30212543E-02, 4.44338295E-02, 7 4.73542676E-02, 5.19486346E-02, 5.96595030E-02, 8.00440021E-02, 8 1.23805652E-01, 7.36099127E-02, 4.22094370E-02, 2.93020252E-02, 9 2.12632345E-02, 1.53999160E-02, 1.10899988E-02, 7.78581980E-03/ DATA CJ 33/ 1 5.59792888E-03, 3.79408528E-03, 2.62063726E-03, 1.71219569E-03, 2 1.13580719E-03, 7.62385553E-04, 4.54536615E-04, 2.42425104E-04, 3 1.16311835E-04, 4.75131868E-05, 1.48204245E-05, 4.73468735E-06, 4 1.53971465E-06, 5.07644565E-07, 1.69215319E-07, 3.31006873E-08, 5 6.57573986E-09, 1.32234067E-09, 2.68548744E-10, 3.24584914E-11, 6 3.96867843E-12, 4.32342833E-02, 4.32346787E-02, 4.32349753E-02, 7 4.32355189E-02, 4.32365074E-02, 4.32382374E-02, 4.32412033E-02, 8 4.32466417E-02, 4.32565325E-02, 4.32738504E-02, 4.33035646E-02, 9 4.33581273E-02, 4.34576211E-02, 4.36326376E-02, 4.39353696E-02/ DATA CJ 34/ 1 4.44994366E-02, 4.52881489E-02, 4.65156962E-02, 4.89934064E-02, 2 5.27270383E-02, 5.86246340E-02, 6.89792766E-02, 9.55178919E-02, 3 1.53805931E-01, 8.72665990E-02, 4.81287151E-02, 3.42518696E-02, 4 2.42867642E-02, 1.72256496E-02, 1.19534085E-02, 8.52602534E-03, 5 5.73789848E-03, 3.94296355E-03, 2.56435298E-03, 1.69519482E-03, 6 1.13475697E-03, 6.74616532E-04, 3.58827677E-04, 1.71739540E-04, 7 6.99968308E-05, 2.17862780E-05, 6.94913635E-06, 2.25715388E-06, 8 7.43486392E-07, 2.47641764E-07, 4.83984298E-08, 9.60806708E-09, 9 1.93104607E-09, 3.91989428E-10, 4.73549560E-11, 5.78776151E-12/ DATA CJ 35/ 1 4.32087632E-02, 4.32091029E-02, 4.32093576E-02, 4.32098246E-02, 2 4.32106738E-02, 4.32121598E-02, 4.32147075E-02, 4.32193789E-02, 3 4.32278743E-02, 4.32427472E-02, 4.32682614E-02, 4.33150958E-02, 4 4.34004438E-02, 4.35504092E-02, 4.38093044E-02, 4.42899816E-02, 5 4.49583505E-02, 4.59898809E-02, 4.80394281E-02, 5.10451508E-02, 6 5.55906118E-02, 6.30744680E-02, 7.57836932E-02, 1.10123496E-01, 7 1.85653774E-01, 1.03646665E-01, 5.94714146E-02, 4.05637117E-02, 8 2.79429568E-02, 1.89929637E-02, 1.33657202E-02, 8.89196126E-03, 9 6.06091784E-03, 3.91386910E-03, 2.57362900E-03, 1.71569689E-03/ DATA CJ 36/ 1 1.01565207E-03, 5.38061069E-04, 2.56602824E-04, 1.04242060E-04, 2 3.23436807E-05, 1.02933846E-05, 3.33770653E-06, 1.09794325E-06, 3 3.65311742E-07, 7.13048076E-08, 1.41415068E-08, 2.83995095E-09, 4 5.76120933E-10, 6.95510376E-11, 8.49584676E-12, 3.61991027E-02, 5 3.61993546E-02, 3.61995435E-02, 3.61998898E-02, 3.62005195E-02, 6 3.62016216E-02, 3.62035109E-02, 3.62069750E-02, 3.62132746E-02, 7 3.62243025E-02, 3.62432184E-02, 3.62779330E-02, 3.63411687E-02, 8 3.64521995E-02, 3.66436361E-02, 3.69982490E-02, 3.74895600E-02, 9 3.82437785E-02, 3.97276968E-02, 4.18684883E-02, 4.50254746E-02/ DATA CJ 37/ 1 5.00133841E-02, 5.80103385E-02, 7.21340556E-02, 1.13025502E-01, 2 1.99418938E-01, 1.09586908E-01, 5.94793914E-02, 3.95984015E-02, 3 2.61425920E-02, 1.80656790E-02, 1.18401639E-02, 7.98800065E-03, 4 5.11311185E-03, 3.34058255E-03, 2.21597730E-03, 1.30517128E-03, 5 6.88176910E-04, 3.26823531E-04, 1.32263645E-04, 4.08905223E-05, 6 1.29798657E-05, 4.20064215E-06, 1.37970996E-06, 4.58502450E-07, 7 8.93659154E-08, 1.77037640E-08, 3.55218722E-09, 7.20086542E-10, 8 8.68632550E-11, 1.06039398E-11, 2.93072216E-02, 2.93074062E-02, 9 2.93075447E-02, 2.93077986E-02, 2.93082602E-02, 2.93090679E-02/ DATA CJ 38/ 1 2.93104528E-02, 2.93129919E-02, 2.93176092E-02, 2.93256917E-02, 2 2.93395542E-02, 2.93649910E-02, 2.94113137E-02, 2.94926082E-02, 3 2.96326546E-02, 2.98916735E-02, 3.02496816E-02, 3.07973230E-02, 4 3.18679302E-02, 3.33963795E-02, 3.56156824E-02, 3.90380654E-02, 5 4.43148129E-02, 5.31920594E-02, 6.91640591E-02, 1.16575775E-01, 6 2.09934433E-01, 1.12013093E-01, 5.82642687E-02, 3.70523334E-02, 7 2.49076025E-02, 1.59750451E-02, 1.06254412E-02, 6.72152469E-03, 8 4.35445309E-03, 2.87016476E-03, 1.67963537E-03, 8.80394242E-04, 9 4.15953076E-04, 1.67551113E-04, 5.15743081E-05, 1.63204537E-05/ DATA CJ 39/ 1 5.26947577E-06, 1.72764130E-06, 5.73294937E-07, 1.11549698E-07, 2 2.20694579E-08, 4.42352504E-09, 8.95959064E-10, 1.07979712E-10, 3 1.31720886E-11, 2.56383409E-02, 2.56384908E-02, 2.56386032E-02, 4 2.56388093E-02, 2.56391840E-02, 2.56398398E-02, 2.56409641E-02, 5 2.56430254E-02, 2.56467737E-02, 2.56533350E-02, 2.56645878E-02, 6 2.56852340E-02, 2.57228259E-02, 2.57887774E-02, 2.59023307E-02, 7 2.61121441E-02, 2.64017019E-02, 2.68436483E-02, 2.77041846E-02, 8 2.89248481E-02, 3.06808077E-02, 3.33507344E-02, 3.73782881E-02, 9 4.39205671E-02, 5.52858594E-02, 7.56826005E-02, 1.25832006E-01/ DATA CJ 40/ 1 2.30642137E-01, 1.18332498E-01, 5.71643469E-02, 3.76047112E-02, 2 2.34557191E-02, 1.53226318E-02, 9.55330997E-03, 6.12663729E-03, 3 4.00811123E-03, 2.32818065E-03, 1.21213576E-03, 5.69369511E-04, 4 2.28164697E-04, 6.98955884E-05, 2.20433677E-05, 7.09934098E-06, 5 2.32303675E-06, 7.69668743E-07, 1.49486186E-07, 2.95334964E-08, 6 5.91300771E-09, 1.19656261E-09, 1.44067978E-10, 1.75607129E-11, 7 2.22761665E-02, 2.22762878E-02, 2.22763789E-02, 2.22765457E-02, 8 2.22768492E-02, 2.22773802E-02, 2.22782905E-02, 2.22799595E-02, 9 2.22829944E-02, 2.22883068E-02, 2.22974173E-02, 2.23141315E-02/ DATA CJ 41/ 1 2.23445596E-02, 2.23979289E-02, 2.24897765E-02, 2.26593445E-02, 2 2.28930634E-02, 2.32491203E-02, 2.39401206E-02, 2.49151104E-02, 3 2.63070342E-02, 2.83995587E-02, 3.15019911E-02, 3.64043040E-02, 4 4.45264732E-02, 5.81378958E-02, 7.88629990E-02, 1.36137259E-01, 5 2.57211631E-01, 1.30192772E-01, 6.63608831E-02, 3.93311909E-02, 6 2.48502333E-02, 1.51148435E-02, 9.53662310E-03, 6.16693160E-03, 7 3.54233209E-03, 1.82616568E-03, 8.50690362E-04, 3.38428996E-04, 8 1.02988259E-04, 3.23302532E-05, 1.03769100E-05, 3.38662021E-06, 9 1.11972018E-06, 2.16945941E-07, 4.27817069E-08, 8.55290917E-09/ DATA CJ 42/ 1 1.72871725E-09, 2.07874878E-10, 2.53124541E-11, 1.72345593E-02, 2 1.72346481E-02, 1.72347146E-02, 1.72348367E-02, 1.72350586E-02, 3 1.72354470E-02, 1.72361127E-02, 1.72373334E-02, 1.72395531E-02, 4 1.72434383E-02, 1.72501011E-02, 1.72623239E-02, 1.72845732E-02, 5 1.73235899E-02, 1.73907151E-02, 1.75145682E-02, 1.76851231E-02, 6 1.79446101E-02, 1.84470178E-02, 1.91532719E-02, 2.01562308E-02, 7 2.16523609E-02, 2.38450945E-02, 2.72488293E-02, 3.27267114E-02, 8 4.14736368E-02, 5.40800824E-02, 7.55433816E-02, 1.36071502E-01, 9 2.66937747E-01, 1.30878244E-01, 5.70704857E-02, 3.54810703E-02/ DATA CJ 43/ 1 2.10071223E-02, 1.30176391E-02, 8.31203265E-03, 4.71755468E-03, 2 2.40684877E-03, 1.11154500E-03, 4.38918146E-04, 1.32672849E-04, 3 4.14559690E-05, 1.32607288E-05, 4.31651874E-06, 1.42423313E-06, 4 2.75284873E-07, 5.41870348E-08, 1.08174709E-08, 2.18388654E-09, 5 2.62281135E-10, 3.19056755E-11, 1.37799601E-02, 1.37800274E-02, 6 1.37800778E-02, 1.37801704E-02, 1.37803386E-02, 1.37806330E-02, 7 1.37811376E-02, 1.37820629E-02, 1.37837454E-02, 1.37866904E-02, 8 1.37917405E-02, 1.38010045E-02, 1.38178664E-02, 1.38474308E-02, 9 1.38982799E-02, 1.39920548E-02, 1.41210902E-02, 1.43171872E-02/ DATA CJ 44/ 1 1.46961074E-02, 1.52270987E-02, 1.59778404E-02, 1.70905750E-02, 2 1.87061758E-02, 2.11789725E-02, 2.50716330E-02, 3.10732443E-02, 3 3.92866830E-02, 5.24646620E-02, 7.45948113E-02, 1.44921051E-01, 4 2.88593785E-01, 1.37313825E-01, 6.35764233E-02, 3.58313861E-02, 5 2.14391887E-02, 1.33813743E-02, 7.44208358E-03, 3.73383866E-03, 6 1.70148693E-03, 6.64396181E-04, 1.98863645E-04, 6.17263113E-05, 7 1.96498532E-05, 6.37293608E-06, 2.09672615E-06, 4.03929604E-07, 8 7.93103504E-08, 1.58017896E-08, 3.18509708E-09, 3.81879489E-10, 9 4.63921497E-11, 1.10836014E-02, 1.10836534E-02, 1.10836924E-02/ DATA CJ 45/ 1 1.10837639E-02, 1.10838939E-02, 1.10841214E-02, 1.10845115E-02, 2 1.10852267E-02, 1.10865271E-02, 1.10888033E-02, 1.10927065E-02, 3 1.10998664E-02, 1.11128976E-02, 1.11357432E-02, 1.11750288E-02, 4 1.12474539E-02, 1.13470595E-02, 1.14983165E-02, 1.17902001E-02, 5 1.21983629E-02, 1.27737467E-02, 1.36229698E-02, 1.48484789E-02, 6 1.67074935E-02, 1.95944437E-02, 2.39552086E-02, 2.97559740E-02, 7 3.86981296E-02, 5.32679383E-02, 8.05305435E-02, 1.50256705E-01, 8 3.10028330E-01, 1.43359269E-01, 5.79514507E-02, 3.41359790E-02, 9 2.07888262E-02, 1.13072749E-02, 5.57200234E-03, 2.50380051E-03/ DATA CJ 46/ 1 9.66527996E-04, 2.86446076E-04, 8.83262559E-05, 2.79849270E-05, 2 9.04393983E-06, 2.96723592E-06, 5.69809173E-07, 1.11611337E-07, 3 2.21956566E-08, 4.46712809E-09, 5.34730172E-10, 6.48783939E-11, 4 8.05345169E-03, 8.05348793E-03, 8.05351512E-03, 8.05356495E-03, 5 8.05365555E-03, 8.05381410E-03, 8.05408592E-03, 8.05458428E-03, 6 8.05549048E-03, 8.05707659E-03, 8.05979643E-03, 8.06478541E-03, 7 8.07386492E-03, 8.08978091E-03, 8.11714522E-03, 8.16757597E-03, 8 8.23689741E-03, 8.34208772E-03, 8.54480995E-03, 8.82771009E-03, 9 9.22537505E-03, 9.80990903E-03, 1.06485399E-02, 1.19099547E-02/ DATA CJ 47/ 1 1.38442261E-02, 1.67118796E-02, 2.04310483E-02, 2.59634497E-02, 2 3.44927631E-02, 4.92459652E-02, 7.17143792E-02, 1.53427244E-01, 3 3.26514616E-01, 1.45742764E-01, 6.13074379E-02, 3.60649980E-02, 4 1.88174151E-02, 8.98850140E-03, 3.94809638E-03, 1.49719844E-03, 5 4.37206538E-04, 1.33525468E-04, 4.20207143E-05, 1.35118440E-05, 6 4.41591581E-06, 8.44260219E-07, 1.64822984E-07, 3.26934692E-08, 7 6.56642250E-09, 7.84314417E-10, 9.49969176E-11, 6.23899214E-03, 8 6.23901934E-03, 6.23903975E-03, 6.23907716E-03, 6.23914519E-03, 9 6.23926423E-03, 6.23946831E-03, 6.23984247E-03, 6.24052283E-03/ DATA CJ 48/ 1 6.24171365E-03, 6.24375562E-03, 6.24750111E-03, 6.25431728E-03, 2 6.26626487E-03, 6.28680368E-03, 6.32464677E-03, 6.37664705E-03, 3 6.45551338E-03, 6.60736780E-03, 6.81898452E-03, 7.11587158E-03, 4 7.55107120E-03, 8.17302480E-03, 9.10333057E-03, 1.05183121E-02, 5 1.25918504E-02, 1.52408962E-02, 1.91039365E-02, 2.48947623E-02, 6 3.45085256E-02, 4.88880645E-02, 7.83625393E-02, 1.60081234E-01, 7 3.50633150E-01, 1.58268933E-01, 6.90948156E-02, 3.39747806E-02, 8 1.55020551E-02, 6.60454805E-03, 2.44930269E-03, 7.02699419E-04, 9 2.12238793E-04, 6.62828734E-05, 2.11942671E-05, 6.89702873E-06/ DATA CJ 49/ 1 1.31225577E-06, 2.55272620E-07, 5.04948874E-08, 1.01195427E-08, 2 1.20591545E-09, 1.45796071E-10, 3.86282087E-03, 3.86283723E-03, 3 3.86284949E-03, 3.86287197E-03, 3.86291285E-03, 3.86298440E-03, 4 3.86310704E-03, 3.86333191E-03, 3.86374079E-03, 3.86445644E-03, 5 3.86568359E-03, 3.86793446E-03, 3.87203051E-03, 3.87920970E-03, 6 3.89154986E-03, 3.91428208E-03, 3.94550854E-03, 3.99284634E-03, 7 4.08391991E-03, 4.21067527E-03, 4.38819654E-03, 4.64778015E-03, 8 5.01747072E-03, 5.56772337E-03, 6.39868712E-03, 7.60416847E-03, 9 9.12449772E-03, 1.13047814E-02, 1.44977905E-02, 1.96168808E-02/ DATA CJ 50/ 1 2.68935185E-02, 4.08571483E-02, 6.32813848E-02, 1.50625472E-01, 2 3.39572661E-01, 1.48214255E-01, 4.93249265E-02, 2.20913623E-02, 3 9.10755191E-03, 3.29653797E-03, 9.28076731E-04, 2.77064012E-04, 4 8.58448019E-05, 2.72917711E-05, 8.84251505E-06, 1.67419032E-06, 5 3.24506159E-07, 6.40121059E-08, 1.28003362E-08, 1.52186166E-09, 6 1.83661677E-10, 2.98227701E-03, 2.98228934E-03, 2.98229858E-03, 7 2.98231552E-03, 2.98234633E-03, 2.98240025E-03, 2.98249267E-03, 8 2.98266213E-03, 2.98297027E-03, 2.98350958E-03, 2.98443436E-03, 9 2.98613057E-03, 2.98921719E-03, 2.99462686E-03, 3.00392462E-03/ DATA CJ 51/ 1 3.02104965E-03, 3.04456802E-03, 3.08020825E-03, 3.14873479E-03, 2 3.24401847E-03, 3.37728863E-03, 3.57180598E-03, 3.84811665E-03, 3 4.25788866E-03, 4.87350005E-03, 5.76017191E-03, 6.86845602E-03, 4 8.44008711E-03, 1.07075673E-02, 1.42674113E-02, 1.91878660E-02, 5 2.82561307E-02, 4.26527329E-02, 7.23734657E-02, 1.66053959E-01, 6 3.70990169E-01, 1.46316337E-01, 4.02698622E-02, 1.66654154E-02, 7 5.85171602E-03, 1.60804097E-03, 4.73088651E-04, 1.45155849E-04, 8 4.58264260E-05, 1.47698909E-05, 2.78019464E-06, 5.36593606E-07, 9 1.05505562E-07, 2.10437806E-08, 2.49526484E-09, 3.00506659E-10/ DATA CJ 52/ 1 2.45811060E-03, 2.45812052E-03, 2.45812796E-03, 2.45814160E-03, 2 2.45816641E-03, 2.45820983E-03, 2.45828425E-03, 2.45842070E-03, 3 2.45866882E-03, 2.45910309E-03, 2.45984773E-03, 2.46121352E-03, 4 2.46369880E-03, 2.46805437E-03, 2.47553979E-03, 2.48932478E-03, 5 2.50825196E-03, 2.53692541E-03, 2.59202576E-03, 2.66857395E-03, 6 2.77551117E-03, 2.93133156E-03, 3.15215542E-03, 3.47856747E-03, 7 3.96667106E-03, 4.66523184E-03, 5.53158490E-03, 6.74834637E-03, 8 8.48186839E-03, 1.11569348E-02, 1.47721717E-02, 2.12195479E-02, 9 3.09773686E-02, 5.02403557E-02, 8.47913144E-02, 1.81191796E-01/ DATA CJ 53/ 1 4.35742447E-01, 1.57375913E-01, 3.77857605E-02, 1.33290042E-02, 2 3.53494257E-03, 1.01785399E-03, 3.07954790E-04, 9.62707958E-05, 3 3.08028604E-05, 5.75212773E-06, 1.10383599E-06, 2.16097638E-07, 4 4.29560091E-08, 5.07558302E-09, 6.09587246E-10, 1.59316061E-03, 5 1.59316688E-03, 1.59317159E-03, 1.59318020E-03, 1.59319588E-03, 6 1.59322330E-03, 1.59327032E-03, 1.59335653E-03, 1.59351327E-03, 7 1.59378762E-03, 1.59425804E-03, 1.59512085E-03, 1.59669084E-03, 8 1.59944218E-03, 1.60417019E-03, 1.61287589E-03, 1.62482628E-03, 9 1.64292426E-03, 1.67768186E-03, 1.72592489E-03, 1.79323589E-03/ DATA CJ 54/ 1 1.89114489E-03, 2.02956203E-03, 2.23347321E-03, 2.53694524E-03, 2 2.96846806E-03, 3.49945234E-03, 4.23810820E-03, 5.27764154E-03, 3 6.85566320E-03, 8.94419422E-03, 1.25605380E-02, 1.78083775E-02, 4 2.75074712E-02, 4.34318231E-02, 6.94569400E-02, 1.80213811E-01, 5 4.82085871E-01, 1.59332134E-01, 2.91552500E-02, 7.98884103E-03, 6 2.23838591E-03, 6.64530586E-04, 2.04998005E-04, 6.49535002E-05, 7 1.20017500E-05, 2.28581804E-06, 4.44969147E-07, 8.80630041E-08, 8 1.03581918E-08, 1.23968941E-09, 9.19353157E-04, 9.19356689E-04, 9 9.19359338E-04, 9.19364194E-04, 9.19373024E-04, 9.19388477E-04/ DATA CJ 55/ 1 9.19414967E-04, 9.19463536E-04, 9.19551848E-04, 9.19706417E-04, 2 9.19971453E-04, 9.20457558E-04, 9.21342061E-04, 9.22892046E-04, 3 9.25555409E-04, 9.30458801E-04, 9.37188357E-04, 9.47376741E-04, 4 9.66933632E-04, 9.94056491E-04, 1.03185805E-03, 1.08675904E-03, 5 1.16420985E-03, 1.27797277E-03, 1.44658757E-03, 1.68503220E-03, 6 1.97650300E-03, 2.37877954E-03, 2.93932288E-03, 3.77931108E-03, 7 4.87354280E-03, 6.72829417E-03, 9.34450658E-03, 1.39897358E-02, 8 2.12049787E-02, 3.26161983E-02, 5.81647722E-02, 1.80163994E-01, 9 5.28527592E-01, 1.49377768E-01, 1.15278749E-02, 4.59015236E-03/ DATA CJ 56/ 1 1.38941231E-03, 4.28560071E-04, 1.35327423E-04, 2.48657102E-05, 2 4.71313230E-06, 9.13883767E-07, 1.80285390E-07, 2.11329971E-08, 3 2.52237838E-09, 4.97079819E-04, 4.97081685E-04, 4.97083085E-04, 4 4.97085651E-04, 4.97090317E-04, 4.97098482E-04, 4.97112480E-04, 5 4.97138144E-04, 4.97184809E-04, 4.97266483E-04, 4.97406528E-04, 6 4.97663382E-04, 4.98130737E-04, 4.98949688E-04, 5.00356809E-04, 7 5.02947077E-04, 5.06501374E-04, 5.11881044E-04, 5.22202627E-04, 8 5.36506913E-04, 5.56423251E-04, 5.85308796E-04, 6.25981209E-04, 9 6.85566078E-04, 7.73559903E-04, 8.97395372E-04, 1.04790530E-03/ DATA CJ 57/ 1 1.25423681E-03, 1.53936087E-03, 1.96212602E-03, 2.50592714E-03, 2 3.41272196E-03, 4.66542054E-03, 6.82886520E-03, 1.00691970E-02, 3 1.49757493E-02, 2.58195605E-02, 5.09895938E-02, 1.82142093E-01, 4 6.01661913E-01, 1.50263934E-01, 1.58288354E-02, 5.51672004E-03, 5 1.65384948E-03, 5.09052680E-04, 9.09755702E-05, 1.69166221E-05, 6 3.23492020E-06, 6.31498526E-07, 7.32461577E-08, 8.67314425E-09, 7 1.99897580E-04, 1.99898314E-04, 1.99898865E-04, 1.99899876E-04, 8 1.99901713E-04, 1.99904927E-04, 1.99910438E-04, 1.99920541E-04, 9 1.99938912E-04, 1.99971066E-04, 2.00026199E-04, 2.00127316E-04/ DATA CJ 58/ 1 2.00311299E-04, 2.00633683E-04, 2.01187569E-04, 2.02207070E-04, 2 2.03605772E-04, 2.05722301E-04, 2.09781451E-04, 2.15403274E-04, 3 2.23223904E-04, 2.34552788E-04, 2.50477950E-04, 2.73755006E-04, 4 3.08022036E-04, 3.56046650E-04, 4.14131503E-04, 4.93307223E-04, 5 6.01961696E-04, 7.61675253E-04, 9.65031926E-04, 1.29979774E-03, 6 1.75495195E-03, 2.52510301E-03, 3.64908014E-03, 5.29931482E-03, 7 8.79054164E-03, 1.67919264E-02, 3.55701775E-02, 1.66679011E-01, 8 6.41873216E-01, 1.58308363E-01, 1.77085013E-02, 6.03634025E-03, 9 1.80763238E-03, 3.11806787E-04, 5.65880157E-05, 1.06367396E-05/ DATA CJ 59/ 1 2.05017106E-06, 2.34827287E-07, 2.75486735E-08, 5.28818603E-05, 2 5.28820503E-05, 5.28821928E-05, 5.28824541E-05, 5.28829291E-05, 3 5.28837603E-05, 5.28851853E-05, 5.28877980E-05, 5.28925486E-05, 4 5.29008632E-05, 5.29151200E-05, 5.29412674E-05, 5.29888416E-05, 5 5.30722006E-05, 5.32154105E-05, 5.34789783E-05, 5.38405186E-05, 6 5.43874713E-05, 5.54359909E-05, 5.68872122E-05, 5.89042335E-05, 7 6.18224554E-05, 6.59176796E-05, 7.18895835E-05, 8.06530367E-05, 8 9.28834987E-05, 1.07603823E-04, 1.27556001E-04, 1.54750330E-04, 9 1.94387175E-04, 2.44363059E-04, 3.25638255E-04, 4.34517962E-04/ DATA CJ 60/ 1 6.15363065E-04, 8.73306817E-04, 1.24206340E-03, 1.99323939E-03, 2 3.61586646E-03, 7.36911421E-03, 1.44074720E-02, 1.54062035E-01, 3 6.33582634E-01, 1.56936612E-01, 1.73635032E-02, 5.93902443E-03, 4 9.83219604E-04, 1.72819923E-04, 3.17727814E-05, 6.02693095E-06, 5 6.79784799E-07, 7.88643246E-08, 1.82807098E-05, 1.82807748E-05, 6 1.82808235E-05, 1.82809129E-05, 1.82810753E-05, 1.82813597E-05, 7 1.82818471E-05, 1.82827408E-05, 1.82843657E-05, 1.82872098E-05, 8 1.82920863E-05, 1.83010300E-05, 1.83173026E-05, 1.83458148E-05, 9 1.83947973E-05, 1.84849417E-05, 1.86085855E-05, 1.87956191E-05/ DATA CJ 61/ 1 1.91541013E-05, 1.96501256E-05, 2.03392769E-05, 2.13358157E-05, 2 2.27332848E-05, 2.47691753E-05, 2.77527835E-05, 3.19096345E-05, 3 3.69028889E-05, 4.36557463E-05, 5.28355375E-05, 6.61732519E-05, 4 8.29308083E-05, 1.10069853E-04, 1.46252852E-04, 2.06020283E-04, 5 2.90747496E-04, 4.11136869E-04, 6.54752904E-04, 1.17836636E-03, 6 2.40810384E-03, 5.96195264E-03, 1.74408453E-02, 1.57214854E-01, 7 6.34718148E-01, 1.61430142E-01, 2.17755787E-02, 3.57256008E-03, 8 5.94303637E-04, 1.05566722E-04, 1.95664621E-05, 2.16074217E-06, 9 2.47019226E-07, 5.90993561E-06, 5.90995641E-06, 5.90997201E-06/ DATA CJ 62/ 1 5.91000062E-06, 5.91005263E-06, 5.91014365E-06, 5.91029968E-06, 2 5.91058575E-06, 5.91110593E-06, 5.91201634E-06, 5.91357737E-06, 3 5.91644034E-06, 5.92164933E-06, 5.93077618E-06, 5.94645523E-06, 4 5.97530877E-06, 6.01488215E-06, 6.07473829E-06, 6.18944359E-06, 5 6.34811763E-06, 6.56849358E-06, 6.88701017E-06, 7.33337610E-06, 6 7.98307221E-06, 8.93403352E-06, 1.02568260E-05, 1.18428606E-05, 7 1.39833327E-05, 1.68858911E-05, 2.10905717E-05, 2.63556257E-05, 8 3.48481793E-05, 4.61177632E-05, 6.46293202E-05, 9.07018097E-05, 9 1.27489574E-04, 2.01259458E-04, 3.57792631E-04, 7.19204235E-04/ DATA CJ 63/ 1 1.74517798E-03, 5.82749688E-03, 1.69669437E-02, 1.55348802E-01, 2 6.23701145E-01, 1.43451922E-01,-3.48187206E-03, 6.67723197E-04, 3 1.48321433E-04, 2.94977261E-05, 3.38985522E-06, 3.95018156E-07, 4 2.25483171E-06, 2.25483958E-06, 2.25484548E-06, 2.25485630E-06, 5 2.25487597E-06, 2.25491039E-06, 2.25496940E-06, 2.25507759E-06, 6 2.25527431E-06, 2.25561862E-06, 2.25620898E-06, 2.25729171E-06, 7 2.25926164E-06, 2.26271320E-06, 2.26864252E-06, 2.27955359E-06, 8 2.29451754E-06, 2.31714912E-06, 2.36051277E-06, 2.42048496E-06, 9 2.50375229E-06, 2.62405024E-06, 2.79253700E-06, 3.03758083E-06/ DATA CJ 64/ 1 3.39586922E-06, 3.89356224E-06, 4.48935327E-06, 5.29197530E-06, 2 6.37805708E-06, 7.94736586E-06, 9.90683609E-06, 1.30567384E-05, 3 1.72201765E-05, 2.40272738E-05, 3.35631444E-05, 4.69403195E-05, 4 7.35652864E-05, 1.29461927E-04, 2.56623835E-04, 6.10103049E-04, 5 1.98016924E-03, 6.61162926E-03, 1.97409592E-02, 1.66436919E-01, 6 6.81084221E-01, 1.26300556E-01,-4.66188632E-04, 8.88047485E-04, 7 1.80476316E-04, 2.02474567E-05, 2.30519837E-06, 7.66178811E-07, 8 7.66181465E-07, 7.66183455E-07, 7.66187103E-07, 7.66193736E-07, 9 7.66205345E-07, 7.66225246E-07, 7.66261733E-07, 7.66328077E-07/ DATA CJ 65/ 1 7.66444192E-07, 7.66643289E-07, 7.67008435E-07, 7.67672784E-07, 2 7.68836788E-07, 7.70836355E-07, 7.74515824E-07, 7.79561768E-07, 3 7.87192752E-07, 8.01812442E-07, 8.22027724E-07, 8.50088062E-07, 4 8.90613005E-07, 9.47343962E-07, 1.02979830E-06, 1.15025096E-06, 5 1.31737793E-06, 1.51718372E-06, 1.78595349E-06, 2.14900946E-06, 6 2.67250263E-06, 3.32462241E-06, 4.37002472E-06, 5.74739251E-06, 7 7.99091094E-06, 1.11202703E-05, 1.54900517E-05, 2.41361492E-05, 8 4.21368915E-05, 8.26176837E-05, 1.93279196E-04, 6.10921593E-04, 9 1.98181686E-03, 6.63905502E-03, 2.11121110E-02, 1.47647210E-01/ DATA CJ 66/ 1 7.41809339E-01, 1.33790339E-01, 5.01487182E-04, 1.04568765E-03, 2 1.20288596E-04, 1.34382316E-05, 8.57088619E-08, 8.57091533E-08, 3 8.57093719E-08, 8.57097727E-08, 8.57105014E-08, 8.57117766E-08, 4 8.57139628E-08, 8.57179708E-08, 8.57252587E-08, 8.57380140E-08, 5 8.57598846E-08, 8.57999953E-08, 8.58729720E-08, 8.60008310E-08, 6 8.62204624E-08, 8.66245821E-08, 8.71787179E-08, 8.80165955E-08, 7 8.96213548E-08, 9.18393144E-08, 9.49161071E-08, 9.93558454E-08, 8 1.05563824E-07, 1.14572453E-07, 1.27704487E-07, 1.45874719E-07, 9 1.67529054E-07, 1.96553240E-07, 2.35594091E-07, 2.91602843E-07/ DATA CJ 67/ 1 3.60979046E-07, 4.71448010E-07, 6.15864232E-07, 8.48941386E-07, 2 1.17061211E-06, 1.61468936E-06, 2.48048153E-06, 4.24535627E-06, 3 8.09776422E-06, 1.81670384E-05, 5.32821613E-05, 1.54559697E-04, 4 4.28901135E-04, 9.55275430E-04,-3.76288900E-03, 1.28758626E-01, 5 7.30925185E-01, 1.35950613E-01, 3.50239034E-03, 7.39490102E-04, 6 7.93709107E-05, 2.06439653E-08, 2.06440354E-08, 2.06440880E-08, 7 2.06441844E-08, 2.06443596E-08, 2.06446663E-08, 2.06451920E-08, 8 2.06461559E-08, 2.06479084E-08, 2.06509758E-08, 2.06562352E-08, 9 2.06658810E-08, 2.06834303E-08, 2.07141775E-08, 2.07669938E-08/ DATA CJ 68/ 1 2.08641748E-08, 2.09974301E-08, 2.11989155E-08, 2.15848062E-08, 2 2.21181348E-08, 2.28579477E-08, 2.39254208E-08, 2.54179319E-08, 3 2.75835584E-08, 3.07400247E-08, 3.51068015E-08, 4.03100133E-08, 4 4.72828475E-08, 5.66603189E-08, 7.01107091E-08, 8.67680891E-08, 5 1.13287218E-07, 1.47950783E-07, 2.03890911E-07, 2.81096290E-07, 6 3.87699179E-07, 5.95628575E-07, 1.01992811E-06, 1.94824133E-06, 7 4.38748695E-06, 1.30179794E-05, 3.88485065E-05, 1.16417342E-04, 8 3.47961738E-04, 1.00762108E-03, 2.73564972E-04, 1.32228865E-01, 9 7.23792490E-01, 1.23663010E-01,-9.29885927E-03,-1.23193146E-04/ DATA CJ 69/ 1 4.56812442E-09, 4.56813986E-09, 4.56815144E-09, 4.56817267E-09, 2 4.56821126E-09, 4.56827881E-09, 4.56839460E-09, 4.56860689E-09, 3 4.56899290E-09, 4.56966849E-09, 4.57082688E-09, 4.57295137E-09, 4 4.57681661E-09, 4.58358866E-09, 4.59522127E-09, 4.61662468E-09, 5 4.64597233E-09, 4.69034496E-09, 4.77532270E-09, 4.89275528E-09, 6 5.05562923E-09, 5.29059184E-09, 5.61901966E-09, 6.09538996E-09, 7 6.78936667E-09, 7.74882510E-09, 8.89123179E-09, 1.04209298E-08, 8 1.24762158E-08, 1.54208935E-08, 1.90632192E-08, 2.48537007E-08, 9 3.24104017E-08, 4.45831096E-08, 6.13489390E-08, 8.44499966E-08/ DATA CJ 70/ 1 1.29392210E-07, 2.20783682E-07, 4.19850164E-07, 9.39902731E-07, 2 2.76543520E-06, 8.18408673E-06, 2.43693695E-05, 7.29812344E-05, 3 2.19196312E-04, 1.10653705E-03, 8.66793851E-04, 1.36464968E-01, 4 7.60579030E-01, 1.08315064E-01,-7.14703041E-03, 9.32044857E-10, 5 9.32047995E-10, 9.32050349E-10, 9.32054664E-10, 9.32062510E-10, 6 9.32076240E-10, 9.32099779E-10, 9.32142934E-10, 9.32221403E-10, 7 9.32358740E-10, 9.32594222E-10, 9.33026093E-10, 9.33811827E-10, 8 9.35188459E-10, 9.37553133E-10, 9.41903948E-10, 9.47869514E-10, 9 9.56888953E-10, 9.74161074E-10, 9.98027764E-10, 1.03112604E-09/ DATA CJ 71/ 1 1.07886618E-09, 1.14558244E-09, 1.24232345E-09, 1.38320084E-09, 2 1.57787370E-09, 1.80953521E-09, 2.11953699E-09, 2.53574655E-09, 3 3.13154835E-09, 3.86780770E-09, 5.03700719E-09, 6.56094325E-09, 4 9.01229904E-09, 1.23833002E-08, 1.70205327E-08, 2.60240567E-08, 5 4.42839754E-08, 8.39202093E-08, 1.86998871E-07, 5.46516447E-07, 6 1.60572524E-06, 4.74612620E-06, 1.41224686E-05, 4.23264569E-05, 7 2.22304979E-04, 1.15531950E-03, 2.47181017E-03, 1.20822713E-01, 8 8.05702466E-01, 1.42819359E-02, 3.98573562E-11, 3.98574863E-11, 9 3.98575839E-11, 3.98577629E-11, 3.98580882E-11, 3.98586575E-11/ DATA CJ 72/ 1 3.98596336E-11, 3.98614230E-11, 3.98646767E-11, 3.98703713E-11, 2 3.98801355E-11, 3.98980426E-11, 3.99306215E-11, 3.99876986E-11, 3 4.00857347E-11, 4.02660912E-11, 4.05133383E-11, 4.08870542E-11, 4 4.16023791E-11, 4.25901010E-11, 4.39585256E-11, 4.59296366E-11, 5 4.86791694E-11, 5.26561680E-11, 5.84281163E-11, 6.63696338E-11, 6 7.57734928E-11, 8.82877885E-11, 1.04980903E-10, 1.28693399E-10, 7 1.57746760E-10, 2.03423868E-10, 2.62280518E-10, 3.55705134E-10, 8 4.82255574E-10, 6.53598367E-10, 9.79681374E-10, 1.62290687E-09, 9 2.96780567E-09, 6.28523094E-09, 1.69238753E-08, 4.47834951E-08/ DATA CJ 73/ 1 1.15119869E-07, 2.80762913E-07, 6.12865151E-07, 7.29517944E-07, 2-1.85281351E-05,-3.70871197E-04,-9.85146118E-03, 9.43947195E-02, 3 9.92892411E-01/ DATA XTAU/0.,.0000032,.0000056,.00001,.000018, A.000032,.000056,.0001,.00018,.00032, 1.00056,.001,.0018,.0032,.0056,.01,.016,.025,.042,.065, 2.096,.139,.196,.273,.375,.5,.63,.78,.95,1.15,1.35,1.6,1.85,2.15, 32.45,2.75,3.15,3.65,4.25,5.0,6.,7.,8.,9.,10.,11.5,13.,14.5,16., 4 18.,20./ DATA NXTAU/51/ END SUBROUTINE BLOCKH COMMON /MATX/CJ(2601),CH(2601),XTAU(51),NXTAU DIMENSION CH 1(36),CH 2(36),CH 3(36),CH 4(36),CH 5(36) DIMENSION CH 6(36),CH 7(36),CH 8(36),CH 9(36),CH 10(36) DIMENSION CH 11(36),CH 12(36),CH 13(36),CH 14(36),CH 15(36) DIMENSION CH 16(36),CH 17(36),CH 18(36),CH 19(36),CH 20(36) DIMENSION CH 21(36),CH 22(36),CH 23(36),CH 24(36),CH 25(36) DIMENSION CH 26(36),CH 27(36),CH 28(36),CH 29(36),CH 30(36) DIMENSION CH 31(36),CH 32(36),CH 33(36),CH 34(36),CH 35(36) DIMENSION CH 36(36),CH 37(36),CH 38(36),CH 39(36),CH 40(36) DIMENSION CH 41(36),CH 42(36),CH 43(36),CH 44(36),CH 45(36) DIMENSION CH 46(36),CH 47(36),CH 48(36),CH 49(36),CH 50(36) DIMENSION CH 51(36),CH 52(36),CH 53(36),CH 54(36),CH 55(36) DIMENSION CH 56(36),CH 57(36),CH 58(36),CH 59(36),CH 60(36) DIMENSION CH 61(36),CH 62(36),CH 63(36),CH 64(36),CH 65(36) DIMENSION CH 66(36),CH 67(36),CH 68(36),CH 69(36),CH 70(36) DIMENSION CH 71(36),CH 72(36),CH 73( 9) EQUIVALENCE (CH 1(1),CH ( 1)),(CH 2(1),CH ( 37)) EQUIVALENCE (CH 3(1),CH ( 73)),(CH 4(1),CH ( 109)) EQUIVALENCE (CH 5(1),CH ( 145)),(CH 6(1),CH ( 181)) EQUIVALENCE (CH 7(1),CH ( 217)),(CH 8(1),CH ( 253)) EQUIVALENCE (CH 9(1),CH ( 289)),(CH 10(1),CH ( 325)) EQUIVALENCE (CH 11(1),CH ( 361)),(CH 12(1),CH ( 397)) EQUIVALENCE (CH 13(1),CH ( 433)),(CH 14(1),CH ( 469)) EQUIVALENCE (CH 15(1),CH ( 505)),(CH 16(1),CH ( 541)) EQUIVALENCE (CH 17(1),CH ( 577)),(CH 18(1),CH ( 613)) EQUIVALENCE (CH 19(1),CH ( 649)),(CH 20(1),CH ( 685)) EQUIVALENCE (CH 21(1),CH ( 721)),(CH 22(1),CH ( 757)) EQUIVALENCE (CH 23(1),CH ( 793)),(CH 24(1),CH ( 829)) EQUIVALENCE (CH 25(1),CH ( 865)),(CH 26(1),CH ( 901)) EQUIVALENCE (CH 27(1),CH ( 937)),(CH 28(1),CH ( 973)) EQUIVALENCE (CH 29(1),CH (1009)),(CH 30(1),CH (1045)) EQUIVALENCE (CH 31(1),CH (1081)),(CH 32(1),CH (1117)) EQUIVALENCE (CH 33(1),CH (1153)),(CH 34(1),CH (1189)) EQUIVALENCE (CH 35(1),CH (1225)),(CH 36(1),CH (1261)) EQUIVALENCE (CH 37(1),CH (1297)),(CH 38(1),CH (1333)) EQUIVALENCE (CH 39(1),CH (1369)),(CH 40(1),CH (1405)) EQUIVALENCE (CH 41(1),CH (1441)),(CH 42(1),CH (1477)) EQUIVALENCE (CH 43(1),CH (1513)),(CH 44(1),CH (1549)) EQUIVALENCE (CH 45(1),CH (1585)),(CH 46(1),CH (1621)) EQUIVALENCE (CH 47(1),CH (1657)),(CH 48(1),CH (1693)) EQUIVALENCE (CH 49(1),CH (1729)),(CH 50(1),CH (1765)) EQUIVALENCE (CH 51(1),CH (1801)),(CH 52(1),CH (1837)) EQUIVALENCE (CH 53(1),CH (1873)),(CH 54(1),CH (1909)) EQUIVALENCE (CH 55(1),CH (1945)),(CH 56(1),CH (1981)) EQUIVALENCE (CH 57(1),CH (2017)),(CH 58(1),CH (2053)) EQUIVALENCE (CH 59(1),CH (2089)),(CH 60(1),CH (2125)) EQUIVALENCE (CH 61(1),CH (2161)),(CH 62(1),CH (2197)) EQUIVALENCE (CH 63(1),CH (2233)),(CH 64(1),CH (2269)) EQUIVALENCE (CH 65(1),CH (2305)),(CH 66(1),CH (2341)) EQUIVALENCE (CH 67(1),CH (2377)),(CH 68(1),CH (2413)) EQUIVALENCE (CH 69(1),CH (2449)),(CH 70(1),CH (2485)) EQUIVALENCE (CH 71(1),CH (2521)),(CH 72(1),CH (2557)) EQUIVALENCE (CH 73(1),CH (2593)) DATA CH 1/ 1 7.15528120E-07,-7.63679981E-07,-7.15500186E-07,-7.15459313E-07, 2-7.15399161E-07,-7.15312983E-07,-7.15165254E-07,-7.14858701E-07, 3-7.14382582E-07,-7.13607800E-07,-7.12377050E-07,-7.10300825E-07, 4-7.06860448E-07,-7.01420388E-07,-6.93063611E-07,-6.79532139E-07, 5-6.63270842E-07,-6.41769994E-07,-6.06941637E-07,-5.67254987E-07, 6-5.22282879E-07,-4.70473751E-07,-4.14388755E-07,-3.53840218E-07, 7-2.91560381E-07,-2.33727889E-07,-1.88154634E-07,-1.48244615E-07, 8-1.14444272E-07,-8.53987435E-08,-6.43470333E-08,-4.56539380E-08, 9-3.26942276E-08,-2.21150989E-08,-1.50875635E-08,-1.03652019E-08/ DATA CH 2/ 1-6.33939388E-09,-3.46859459E-09,-1.70493170E-09,-7.13016572E-10, 2-2.27726935E-10,-7.40657549E-11,-2.44269562E-11,-8.14546806E-12, 3-2.74070206E-12,-5.42231753E-13,-1.08693370E-13,-2.20183137E-14, 4-4.49889022E-15,-5.47402692E-16,-6.72957970E-17, 1.49142688E-06, 5-3.90281313E-07,-1.61431531E-06,-1.49134752E-06,-1.49120973E-06, 6-1.49097554E-06,-1.49063560E-06,-1.49006119E-06,-1.48907404E-06, 7-1.48745761E-06,-1.48489081E-06,-1.48056166E-06,-1.47338907E-06, 8-1.46204838E-06,-1.44462816E-06,-1.41642180E-06,-1.38252570E-06, 9-1.33770838E-06,-1.26511114E-06,-1.18238754E-06,-1.08864711E-06/ DATA CH 3/ 1-9.80655730E-07,-8.63751857E-07,-7.37544289E-07,-6.07728094E-07, 2-4.87182021E-07,-3.92189148E-07,-3.09000744E-07,-2.38547359E-07, 3-1.78004914E-07,-1.34124776E-07,-9.51609333E-08,-6.81477476E-08, 4-4.60966417E-08,-3.14484678E-08,-2.16051921E-08,-1.32138108E-08, 5-7.22992635E-09,-3.55375351E-09,-1.48620912E-09,-4.74673171E-10, 6-1.54382378E-10,-5.09154535E-11,-1.69783820E-11,-5.71270866E-12, 7-1.13022573E-12,-2.26560028E-13,-4.58948851E-14,-9.37746872E-15, 8-1.14100396E-15,-1.40271087E-16, 1.52106578E-06, 1.68212841E-06, 9 4.09944249E-07,-1.75645270E-06,-1.52097046E-06,-1.52073553E-06/ DATA CH 4/ 1-1.52034786E-06,-1.51978995E-06,-1.51877481E-06,-1.51712012E-06, 2-1.51449942E-06,-1.51008118E-06,-1.50276284E-06,-1.49119345E-06, 3-1.47342353E-06,-1.44465254E-06,-1.41007905E-06,-1.36436695E-06, 4-1.29032132E-06,-1.20594808E-06,-1.11033885E-06,-1.00019498E-06, 5-8.80961299E-07,-7.52238763E-07,-6.19835885E-07,-4.96887979E-07, 6-4.00002484E-07,-3.15156696E-07,-2.43299681E-07,-1.81551082E-07, 7-1.36796756E-07,-9.70566781E-08,-6.95053428E-08,-4.70149442E-08, 8-3.20749578E-08,-2.20355911E-08,-1.34770434E-08,-7.37395328E-09, 9-3.62454737E-09,-1.51581560E-09,-4.84129008E-10,-1.57457780E-10/ DATA CH 5/ 1-5.19297218E-11,-1.73166017E-11,-5.82650912E-12,-1.15274044E-12, 2-2.31073221E-13,-4.68091342E-14,-9.56427242E-15,-1.16373329E-15, 3-1.43065350E-16, 2.98150821E-06, 2.98161961E-06, 3.02985925E-06, 4 5.50707149E-07,-3.40191479E-06,-2.98116452E-06,-2.98048320E-06, 5-2.97927252E-06,-2.97725646E-06,-2.97401344E-06,-2.96886903E-06, 6-2.96020082E-06,-2.94584763E-06,-2.92316158E-06,-2.88832120E-06, 7-2.83191590E-06,-2.76413769E-06,-2.67452550E-06,-2.52937199E-06, 8-2.36397499E-06,-2.17655345E-06,-1.96064093E-06,-1.72691069E-06, 9-1.47458038E-06,-1.21503614E-06,-9.74026455E-07,-7.84106027E-07/ DATA CH 6/ 1-6.17786634E-07,-4.76928629E-07,-3.55885746E-07,-2.68155970E-07, 2-1.90255412E-07,-1.36247871E-07,-9.21610475E-08,-6.28749313E-08, 3-4.31952603E-08,-2.64183673E-08,-1.44547867E-08,-7.10501576E-09, 4-2.97137592E-09,-9.49013288E-10,-3.08656397E-10,-1.01795161E-10, 5-3.39448415E-11,-1.14214051E-11,-2.25965748E-12,-4.52960874E-13, 6-9.17575200E-14,-1.87483472E-14,-2.28120596E-15,-2.80443572E-16, 7 5.33941059E-06, 5.33959050E-06, 5.33971838E-06, 5.46288397E-06, 8 9.45594076E-07,-5.99346507E-06,-5.33838396E-06,-5.33622077E-06, 9-5.33261638E-06,-5.32678301E-06,-5.31753886E-06,-5.30199406E-06/ DATA CH 7/ 1-5.27626139E-06,-5.23560527E-06,-5.17318158E-06,-5.07213438E-06, 2-4.95072325E-06,-4.79020869E-06,-4.53021687E-06,-4.23397287E-06, 3-3.89828536E-06,-3.51157189E-06,-3.09294861E-06,-2.64101390E-06, 4-2.17616046E-06,-1.74450433E-06,-1.40435137E-06,-1.10646897E-06, 5-8.54188854E-07,-6.37398304E-07,-4.80272397E-07,-3.40750911E-07, 6-2.44022354E-07,-1.65062027E-07,-1.12610064E-07,-7.73634273E-08, 7-4.73157247E-08,-2.58887527E-08,-1.27251939E-08,-5.32177962E-09, 8-1.69969699E-09,-5.52808151E-10,-1.82316613E-10,-6.07956998E-11, 9-2.04558995E-11,-4.04707848E-12,-8.11259273E-13,-1.64338996E-13/ DATA CH 8/ 1-3.35785494E-14,-4.08567126E-15,-5.02278278E-16, 9.13329675E-06, 2 9.13358176E-06, 9.13380306E-06, 9.13420159E-06, 9.37031962E-06, 3 1.47104366E-06,-1.03630349E-05,-9.13025211E-06,-9.12398505E-06, 4-9.11390737E-06,-9.09802697E-06,-9.07135096E-06,-9.02725015E-06, 5-8.95762338E-06,-8.85075952E-06,-8.67781716E-06,-8.47005078E-06, 6-8.19539043E-06,-7.75053819E-06,-7.24367751E-06,-6.66934449E-06, 7-6.00772113E-06,-5.29151194E-06,-4.51831779E-06,-3.72302663E-06, 8-2.98453429E-06,-2.40259068E-06,-1.89296597E-06,-1.46135960E-06, 9-1.09047012E-06,-8.21656389E-07,-5.82960842E-07,-4.17476248E-07/ DATA CH 9/ 1-2.82389890E-07,-1.92654440E-07,-1.32354098E-07,-8.09481724E-08, 2-4.42906997E-08,-2.17703641E-08,-9.10454075E-09,-2.90785360E-09, 3-9.45747879E-10,-3.11908427E-10,-1.04009658E-10,-3.49960749E-11, 4-6.92376506E-12,-1.38790687E-12,-2.81152041E-13,-5.74463594E-14, 5-6.98978740E-15,-8.59300205E-16, 1.61715949E-05, 1.61720720E-05, 6 1.61724330E-05, 1.61730963E-05, 1.61743243E-05, 1.65968833E-05, 7 3.13002612E-06,-1.85271744E-05,-1.61620847E-05,-1.61440014E-05, 8-1.61156455E-05,-1.60681414E-05,-1.59898028E-05,-1.58662617E-05, 9-1.56767807E-05,-1.53702665E-05,-1.50021225E-05,-1.45155180E-05/ DATA CH 10/ 1-1.37274731E-05,-1.28296443E-05,-1.18123413E-05,-1.06404566E-05, 2-9.37191392E-06,-8.00246045E-06,-6.59388527E-06,-5.28591985E-06, 3-4.25522842E-06,-3.35262610E-06,-2.58820551E-06,-1.93132270E-06, 4-1.45522738E-06,-1.03247504E-06,-7.39386642E-07,-5.00136599E-07, 5-3.41207244E-07,-2.34410137E-07,-1.43365879E-07,-7.84424320E-08, 6-3.85570653E-08,-1.61248655E-08,-5.15003730E-09,-1.67499319E-09, 7-5.52413963E-10,-1.84209108E-10,-6.19807297E-11,-1.22625154E-11, 8-2.45808833E-12,-4.97941514E-13,-1.01741831E-13,-1.23794385E-14, 9-1.52188503E-15, 2.97035986E-05, 2.97044194E-05, 2.97050368E-05/ DATA CH 11/ 1 2.97061753E-05, 2.97082586E-05, 2.97119611E-05, 3.03723299E-05, 2 5.59251004E-06,-3.39127760E-05,-2.96749188E-05,-2.96219260E-05, 3-2.95338145E-05,-2.93890504E-05,-2.91612567E-05,-2.88123315E-05, 4-2.82483380E-05,-2.75712512E-05,-2.66765293E-05,-2.52278235E-05, 5-2.35775061E-05,-2.17077264E-05,-1.95539426E-05,-1.72226003E-05, 6-1.47058714E-05,-1.21172992E-05,-9.71365644E-06,-7.81957905E-06, 7-6.16090061E-06,-4.75616197E-06,-3.54904619E-06,-2.67415660E-06, 8-1.89729441E-06,-1.35870797E-06,-9.19057204E-07,-6.27005937E-07, 9-4.30754070E-07,-2.63450092E-07,-1.44146186E-07,-7.08525779E-08/ DATA CH 12/ 1-2.96310732E-08,-9.46370616E-09,-3.07796454E-09,-1.01511437E-09, 2-3.38501999E-10,-1.13895526E-10,-2.25335364E-11,-4.51696914E-12, 3-9.15014236E-13,-1.86960114E-13,-2.27483682E-14,-2.79660454E-15, 4 5.33166603E-05, 5.33180333E-05, 5.33190646E-05, 5.33209602E-05, 5 5.33244220E-05, 5.33305318E-05, 5.33411700E-05, 5.45903715E-05, 6 9.45344212E-06,-5.98750523E-05,-5.32379559E-05,-5.30766673E-05, 7-5.28137644E-05,-5.24019279E-05,-5.17726607E-05,-5.07570460E-05, 8-4.95388096E-05,-4.79297869E-05,-4.53254263E-05,-4.23593245E-05, 9-3.89992680E-05,-3.51292236E-05,-3.09404208E-05,-2.64187551E-05/ DATA CH 13/ 1-2.17681883E-05,-1.74499821E-05,-1.40472898E-05,-1.10675313E-05, 2-8.54399479E-06,-6.37549656E-06,-4.80383043E-06,-3.40827054E-06, 3-2.44075547E-06,-1.65097143E-06,-1.12633544E-06,-7.73792885E-07, 4-4.73252449E-07,-2.58938632E-07,-1.27276602E-07,-5.32279265E-08, 5-1.70001466E-08,-5.52910028E-09,-1.82349841E-09,-6.08066807E-10, 6-2.04595667E-10,-4.04779745E-11,-8.11402352E-12,-1.64367808E-12, 7-3.35844075E-13,-4.08638019E-14,-5.02365045E-15, 9.11154221E-05, 8 9.11176038E-05, 9.11192420E-05, 9.11222497E-05, 9.11277327E-05, 9 9.11373748E-05, 9.11540492E-05, 9.11851448E-05, 9.35975830E-05/ DATA CH 14/ 1 1.47063950E-05,-1.03462574E-04,-9.08852267E-05,-9.04268484E-05, 2-8.97143077E-05,-8.86303398E-05,-8.68853564E-05,-8.47952605E-05, 3-8.20369956E-05,-7.75751291E-05,-7.24955321E-05,-6.67426582E-05, 4-6.01176981E-05,-5.29478997E-05,-4.52090066E-05,-3.72500018E-05, 5-2.98601473E-05,-2.40372258E-05,-1.89381774E-05,-1.46199094E-05, 6-1.09092379E-05,-8.21988044E-06,-5.83189075E-06,-4.17635691E-06, 7-2.82495145E-06,-1.92724820E-06,-1.32401640E-06,-8.09767079E-07, 8-4.43060175E-07,-2.17777566E-07,-9.10757716E-08,-2.90880576E-08, 9-9.46053242E-09,-3.12008024E-09,-1.04042571E-09,-3.50070669E-10/ DATA CH 15/ 1-6.92592007E-11,-1.38833572E-11,-2.81238403E-12,-5.74639184E-13, 2-6.99191232E-14,-8.59560278E-15, 1.61084635E-04, 1.61088204E-04, 3 1.61090883E-04, 1.61095798E-04, 1.61104749E-04, 1.61120458E-04, 4 1.61147526E-04, 1.61197628E-04, 1.61290476E-04, 1.65663482E-04, 5 3.12833434E-05,-1.84767463E-04,-1.60383520E-04,-1.59095632E-04, 6-1.57151752E-04,-1.54037373E-04,-1.50316849E-04,-1.45414273E-04, 7-1.37492118E-04,-1.28479528E-04,-1.18276734E-04,-1.06530685E-04, 8-9.38212441E-05,-8.01050512E-05,-6.60003185E-05,-5.29053047E-05, 9-4.25875346E-05,-3.35527875E-05,-2.59017163E-05,-1.93273550E-05/ DATA CH 16/ 1-1.45626021E-05,-1.03318579E-05,-7.39883160E-06,-5.00464369E-06, 2-3.41426413E-06,-2.34558186E-06,-1.43454739E-06,-7.84901321E-07, 3-3.85800856E-07,-1.61343209E-07,-5.15300229E-08,-1.67594408E-08, 4-5.52724107E-09,-1.84311601E-09,-6.20149585E-10,-1.22692260E-10, 5-2.45942378E-11,-4.98210441E-12,-1.01796509E-12,-1.23860554E-13, 6-1.52269488E-14, 2.95118060E-04, 2.95124067E-04, 2.95128573E-04, 7 2.95136840E-04, 2.95151884E-04, 2.95178258E-04, 2.95223609E-04, 8 2.95307219E-04, 2.95460872E-04, 2.95735401E-04, 3.02765668E-04, 9 5.58676964E-05,-3.37573852E-04,-2.93054973E-04,-2.89397464E-04/ DATA CH 17/ 1-2.83590510E-04,-2.76688687E-04,-2.67619889E-04,-2.52994639E-04, 2-2.36378122E-04,-2.17582125E-04,-1.95954621E-04,-1.72562085E-04, 3-1.47323476E-04,-1.21375266E-04,-9.72882826E-05,-7.83117813E-05, 4-6.16962878E-05,-4.76263106E-05,-3.55369461E-05,-2.67755473E-05, 5-1.89963282E-05,-1.36034154E-05,-9.20135573E-06,-6.27727001E-06, 6-4.31241145E-06,-2.63742438E-06,-1.44303115E-06,-7.09283125E-07, 7-2.96621802E-07,-9.47346057E-08,-3.08109284E-08,-1.01613469E-08, 8-3.38839182E-09,-1.14008132E-09,-2.25556130E-10,-4.52136250E-11, 9-9.15898950E-12,-1.87139993E-12,-2.27701364E-13,-2.79926878E-14/ DATA CH 18/ 1 5.27450267E-04, 5.27460048E-04, 5.27467385E-04, 5.27480841E-04, 2 5.27505322E-04, 5.27548208E-04, 5.27621863E-04, 5.27757350E-04, 3 5.28005233E-04, 5.28444089E-04, 5.29212981E-04, 5.42982886E-04, 4 9.43257257E-05,-5.94289096E-04,-5.21949862E-04,-5.11218873E-04, 5-4.98593747E-04,-4.82097985E-04,-4.55597512E-04,-4.25563821E-04, 6-3.91641331E-04,-3.52647471E-04,-3.10500866E-04,-2.65051281E-04, 7-2.18341644E-04,-1.74994619E-04,-1.40851146E-04,-1.10959921E-04, 8-8.56508809E-05,-6.39065263E-05,-4.81490961E-05,-3.41589441E-05, 9-2.44608124E-05,-1.65448705E-05,-1.12868617E-05,-7.75380763E-06/ DATA CH 19/ 1-4.74205493E-06,-2.59450211E-06,-1.27523489E-06,-5.33293310E-07, 2-1.70319442E-07,-5.53929789E-08,-1.82682443E-08,-6.09165942E-09, 3-2.04962735E-09,-4.05499382E-10,-8.12834463E-11,-1.64656199E-11, 4-3.36430424E-12,-4.09347595E-13,-5.03233504E-14, 8.67939526E-04, 5 8.67954213E-04, 8.67965230E-04, 8.67985431E-04, 8.68022175E-04, 6 8.68086519E-04, 8.68196952E-04, 8.68399838E-04, 8.68770152E-04, 7 8.69422777E-04, 8.70555855E-04, 8.72685043E-04, 9.00316828E-04, 8 1.18726820E-04,-1.05068040E-03,-8.51640282E-04,-8.30180005E-04, 9-8.02328563E-04,-7.57838031E-04,-7.07603820E-04,-6.50991942E-04/ DATA CH 20/ 1-5.86013815E-04,-5.15855799E-04,-4.40257134E-04,-3.62606802E-04, 2-2.90576808E-04,-2.33857067E-04,-1.84211669E-04,-1.42183646E-04, 3-1.06079989E-04,-7.99196360E-05,-5.66953416E-05,-4.05972023E-05, 4-2.74581721E-05,-1.87312937E-05,-1.28676222E-05,-7.86932554E-06, 5-4.30539149E-06,-2.11610499E-06,-8.84915842E-07,-2.82610874E-07, 6-9.19117308E-08,-3.03114320E-08,-1.01074120E-08,-3.40075163E-09, 7-6.72798403E-10,-1.34862967E-10,-2.73190325E-11,-5.58186980E-12, 8-6.79162392E-13,-8.34926889E-14, 1.61498414E-03, 1.61500857E-03, 9 1.61502689E-03, 1.61506049E-03, 1.61512159E-03, 1.61522856E-03/ DATA CH 21/ 1 1.61541206E-03, 1.61574893E-03, 1.61636286E-03, 1.61744182E-03, 2 1.61930543E-03, 1.62277036E-03, 1.62924770E-03, 1.68333458E-03, 3 3.60899758E-04,-1.82730765E-03,-1.58410667E-03,-1.52899488E-03, 4-1.44234855E-03,-1.34546950E-03,-1.23689296E-03,-1.11271628E-03, 5-9.78971597E-04,-8.35109934E-04,-6.87538020E-04,-5.50779439E-04, 6-4.43161682E-04,-3.49011624E-04,-2.69337615E-04,-2.00915634E-04, 7-1.51349791E-04,-1.07355641E-04,-7.68658545E-05,-5.19840976E-05, 8-3.54597507E-05,-2.43579442E-05,-1.48953901E-05,-8.14890300E-06, 9-4.00495346E-06,-1.67469957E-06,-5.34808728E-07,-1.73924801E-07/ DATA CH 22/ 1-5.73564345E-08,-1.91250993E-08,-6.43470743E-09,-1.27299579E-09, 2-2.55167484E-10,-5.16880700E-11,-1.05608383E-11,-1.28494760E-12, 3-1.57962724E-13, 2.50720905E-03, 2.50724320E-03, 2.50726881E-03, 4 2.50731578E-03, 2.50740118E-03, 2.50755068E-03, 2.50780708E-03, 5 2.50827754E-03, 2.50913426E-03, 2.51063770E-03, 2.51322757E-03, 6 2.51801809E-03, 2.52687709E-03, 2.54289614E-03, 2.63774332E-03, 7 1.76260415E-04,-2.78126196E-03,-2.45704320E-03,-2.31262955E-03, 8-2.15394575E-03,-1.97774832E-03,-1.77739883E-03,-1.56245308E-03, 9-1.33188374E-03,-1.09584644E-03,-8.77427902E-04,-7.05726344E-04/ DATA CH 23/ 1-5.55621605E-04,-4.28668973E-04,-3.19696027E-04,-2.40783539E-04, 2-1.70762699E-04,-1.22247776E-04,-8.26646695E-05,-5.63817215E-05, 3-3.87261829E-05,-2.36795672E-05,-1.29532571E-05,-6.36557648E-06, 4-2.66157673E-06,-8.49889370E-07,-2.76373703E-07,-9.11370404E-08, 5-3.03877430E-08,-1.02237148E-08,-2.02250217E-09,-4.05390165E-10, 6-8.21157965E-11,-1.67774240E-11,-2.04127682E-12,-2.50935807E-13, 7 3.20994276E-03, 3.20998251E-03, 3.21001232E-03, 3.21006698E-03, 8 3.21016637E-03, 3.21034034E-03, 3.21063867E-03, 3.21118592E-03, 9 3.21218201E-03, 3.21392850E-03, 3.21693250E-03, 3.22247328E-03/ DATA CH 24/ 1 3.23266196E-03, 3.25087011E-03, 3.28333413E-03, 3.52880121E-03, 2 2.90599435E-04,-3.99201557E-03,-3.07880403E-03,-2.86239707E-03, 3-2.62426711E-03,-2.35540482E-03,-2.06836350E-03,-1.76152461E-03, 4-1.44821000E-03,-1.15882208E-03,-9.31623746E-04,-7.33184814E-04, 5-5.65473991E-04,-4.21599458E-04,-3.17461291E-04,-2.25092147E-04, 6-1.61113538E-04,-1.08927603E-04,-7.42843836E-05,-5.10170507E-05, 7-3.11911486E-05,-1.70601847E-05,-8.38286988E-06,-3.50466057E-06, 8-1.11897755E-06,-3.63847665E-07,-1.19974679E-07,-4.00009634E-08, 9-1.34574290E-08,-2.66207243E-09,-5.33563710E-10,-1.08075026E-10/ DATA CH 25/ 1-2.20806555E-11,-2.68642989E-12,-3.30236900E-13, 5.61912502E-03, 2 5.61918736E-03, 5.61923412E-03, 5.61931984E-03, 5.61947572E-03, 3 5.61974854E-03, 5.62021633E-03, 5.62107432E-03, 5.62263546E-03, 4 5.62537113E-03, 5.63007179E-03, 5.63872596E-03, 5.65458361E-03, 5 5.68273038E-03, 5.73223829E-03, 5.82772200E-03, 6.17039808E-03, 6 1.43639190E-03,-6.68103918E-03,-5.37711410E-03,-4.91201049E-03, 7-4.39582996E-03,-3.85110759E-03,-3.27335460E-03,-2.68668446E-03, 8-2.14696473E-03,-1.72437761E-03,-1.35598680E-03,-1.04510471E-03, 9-7.78728323E-04,-5.86104634E-04,-4.15382293E-04,-2.97210854E-04/ DATA CH 26/ 1-2.00873337E-04,-1.36950183E-04,-9.40333957E-05,-5.74765590E-05, 2-3.14294076E-05,-1.54399049E-05,-6.45358275E-06,-2.06005782E-06, 3-6.69737788E-07,-2.20809596E-07,-7.36127593E-08,-2.47632234E-08, 4-4.89800939E-09,-9.81635331E-10,-1.98820044E-10,-4.06183901E-11, 5-4.94151282E-12,-6.07419294E-13, 8.60872637E-03, 8.60881218E-03, 6 8.60887654E-03, 8.60899453E-03, 8.60920907E-03, 8.60958456E-03, 7 8.61022836E-03, 8.61140900E-03, 8.61355681E-03, 8.61731911E-03, 8 8.62377964E-03, 8.63565978E-03, 8.65738046E-03, 8.69577446E-03, 9 8.76277550E-03, 8.88981793E-03, 9.07314195E-03, 9.60580772E-03/ DATA CH 27/ 1 5.68967448E-04,-1.02680807E-02,-8.28490183E-03,-7.37632354E-03, 2-6.43680808E-03,-5.45363991E-03,-4.46443150E-03,-3.56017279E-03, 3-2.85517842E-03,-2.24242398E-03,-1.72651510E-03,-1.28528029E-03, 4-9.66674652E-04,-6.84627687E-04,-4.89594200E-04,-3.30726916E-04, 5-2.25387410E-04,-1.54703712E-04,-9.45251600E-05,-5.16691993E-05, 6-2.53739882E-05,-1.06022757E-05,-3.38323341E-06,-1.09963342E-06, 7-3.62473002E-07,-1.20820939E-07,-4.06387087E-08,-8.03682131E-09, 8-1.61050138E-09,-3.26157577E-10,-6.66275604E-11,-8.10497456E-12, 9-9.96203776E-13, 1.04706488E-02, 1.04707426E-02, 1.04708129E-02/ DATA CH 28/ 1 1.04709419E-02, 1.04711764E-02, 1.04715868E-02, 1.04722905E-02, 2 1.04735808E-02, 1.04759277E-02, 1.04800379E-02, 1.04870926E-02, 3 1.05000549E-02, 1.05237187E-02, 1.05654328E-02, 1.06378618E-02, 4 1.07738115E-02, 1.09663337E-02, 1.12726017E-02, 1.26399636E-02, 5 1.00257118E-03,-1.32448573E-02,-1.02003884E-02,-8.84301595E-03, 6-7.45329555E-03,-6.07603131E-03,-4.82977802E-03,-3.86459789E-03, 7-3.02952045E-03,-2.32888278E-03,-1.73132600E-03,-1.30078168E-03, 8-9.20311543E-04,-6.57610360E-04,-4.43884672E-04,-3.02318135E-04, 9-2.07403662E-04,-1.26655650E-04,-6.91945397E-05,-3.39630183E-05/ DATA CH 29/ 1-1.41841204E-05,-4.52398956E-06,-1.46986400E-06,-4.84372815E-07, 2-1.61415718E-07,-5.42826409E-08,-1.07326218E-08,-2.15032417E-09, 3-4.35418135E-10,-8.89365256E-11,-1.08173327E-11,-1.32944308E-12, 4 1.33110352E-02, 1.33111436E-02, 1.33112249E-02, 1.33113740E-02, 5 1.33116450E-02, 1.33121192E-02, 1.33129323E-02, 1.33144233E-02, 6 1.33171350E-02, 1.33218831E-02, 1.33300305E-02, 1.33449935E-02, 7 1.33722851E-02, 1.34203163E-02, 1.35034721E-02, 1.36586923E-02, 8 1.38764431E-02, 1.42174069E-02, 1.49161828E-02, 1.68840513E-02, 9 1.68049676E-03,-1.75585958E-02,-1.31968210E-02,-1.10288702E-02/ DATA CH 30/ 1-8.93226417E-03,-7.06568073E-03,-5.63477235E-03,-4.40515439E-03, 2-3.37877289E-03,-2.50692076E-03,-1.88069912E-03,-1.32869378E-03, 3-9.48354161E-04,-6.39452497E-04,-4.35142460E-04,-2.98317864E-04, 4-1.82035567E-04,-9.93745215E-05,-4.87418148E-05,-2.03423910E-05, 5-6.48375458E-06,-2.10552910E-06,-6.93572266E-07,-2.31057278E-07, 6-7.76821776E-08,-1.53542835E-08,-3.07552806E-09,-6.22636771E-10, 7-1.27155755E-10,-1.54631131E-11,-1.90012484E-12, 1.62635669E-02, 8 1.62636881E-02, 1.62637789E-02, 1.62639456E-02, 1.62642486E-02, 9 1.62647788E-02, 1.62656879E-02, 1.62673547E-02, 1.62703861E-02/ DATA CH 31/ 1 1.62756934E-02, 1.62847988E-02, 1.63015153E-02, 1.63319866E-02, 2 1.63855544E-02, 1.64781138E-02, 1.66502535E-02, 1.68902874E-02, 3 1.72624926E-02, 1.80097009E-02, 1.91301740E-02, 2.20507234E-02, 4 1.60598467E-03,-2.29301685E-02,-1.64041170E-02,-1.31520191E-02, 5-1.03269818E-02,-8.19508155E-03,-6.38158993E-03,-4.87910449E-03, 6-3.61017455E-03,-2.70275023E-03,-1.90566618E-03,-1.35806528E-03, 7-9.14371740E-04,-6.21497638E-04,-4.25669633E-04,-2.59477519E-04, 8-1.41505510E-04,-6.93399826E-05,-2.89124421E-05,-9.20687979E-06, 9-2.98779009E-06,-9.83669747E-07,-3.27560755E-07,-1.10088386E-07/ DATA CH 32/ 1-2.17503608E-08,-4.35523904E-09,-8.81474870E-10,-1.79975890E-10, 2-2.18811141E-11,-2.68824340E-12, 1.90288838E-02, 1.90290141E-02, 3 1.90291117E-02, 1.90292909E-02, 1.90296165E-02, 1.90301864E-02, 4 1.90311635E-02, 1.90329549E-02, 1.90362129E-02, 1.90419163E-02, 5 1.90517000E-02, 1.90696574E-02, 1.91023759E-02, 1.91598480E-02, 6 1.92590133E-02, 1.94429574E-02, 1.96983785E-02, 2.00918628E-02, 7 2.08715613E-02, 2.20119512E-02, 2.37371486E-02, 2.83114149E-02, 8 2.46456465E-03,-2.93002107E-02,-1.96758212E-02,-1.52741478E-02, 9-1.20287271E-02,-9.31144019E-03,-7.08564280E-03,-5.22193919E-03/ DATA CH 33/ 1-3.89775767E-03,-2.74046750E-03,-1.94871813E-03,-1.30935747E-03, 2-8.88519151E-04,-6.07746487E-04,-3.69934554E-04,-2.01457063E-04, 3-9.85867634E-05,-4.10554077E-05,-1.30573022E-05,-4.23335105E-06, 4-1.39273145E-06,-4.63507528E-07,-1.55703706E-07,-3.07449815E-08, 5-6.15350944E-09,-1.24497731E-09,-2.54117234E-10,-3.08848439E-11, 6-3.79339169E-12, 2.18877223E-02, 2.18878607E-02, 2.18879644E-02, 7 2.18881547E-02, 2.18885006E-02, 2.18891059E-02, 2.18901436E-02, 8 2.18920464E-02, 2.18955065E-02, 2.19015636E-02, 2.19119529E-02, 9 2.19310185E-02, 2.19657448E-02, 2.20267078E-02, 2.21317887E-02/ DATA CH 34/ 1 2.23263409E-02, 2.25956922E-02, 2.30087684E-02, 2.38202866E-02, 2 2.49891583E-02, 2.67122164E-02, 2.94459970E-02, 3.60952709E-02, 3 2.92743075E-03,-3.73647840E-02,-2.38681375E-02,-1.85748279E-02, 4-1.42447859E-02,-1.07616185E-02,-7.88376564E-03,-5.85888497E-03, 5-4.10243568E-03,-2.90808105E-03,-1.94826632E-03,-1.31904346E-03, 6-9.00545180E-04,-5.47062546E-04,-2.97330725E-04,-1.45238774E-04, 7-6.03779764E-05,-1.91696902E-05,-6.20711878E-06,-2.04005630E-06, 8-6.78401904E-07,-2.27744155E-07,-4.49348897E-08,-8.98804938E-09, 9-1.81755780E-09,-3.70836723E-10,-4.50505020E-11,-5.53125955E-12/ DATA CH 35/ 1 2.36015431E-02, 2.36016814E-02, 2.36017851E-02, 2.36019752E-02, 2 2.36023209E-02, 2.36029258E-02, 2.36039630E-02, 2.36058645E-02, 3 2.36093224E-02, 2.36153754E-02, 2.36257567E-02, 2.36448050E-02, 4 2.36794912E-02, 2.37403567E-02, 2.38451879E-02, 2.40390035E-02, 5 2.43067409E-02, 2.47159813E-02, 2.55150365E-02, 2.66539649E-02, 6 2.83052241E-02, 3.08509749E-02, 3.47923899E-02, 4.46119530E-02, 7 3.20503910E-03,-4.47187614E-02,-2.99247790E-02,-2.25420281E-02, 8-1.68110438E-02,-1.21916112E-02,-8.99598614E-03,-6.25826949E-03, 9-4.41481615E-03,-2.94457279E-03,-1.98669550E-03,-1.35260584E-03/ DATA CH 36/ 1-8.19247514E-04,-4.43981117E-04,-2.16298007E-04,-8.96923905E-05, 2-2.84065921E-05,-9.18119435E-06,-3.01326406E-06,-1.00090450E-06, 3-3.35701359E-07,-6.61622460E-08,-1.32225530E-08,-2.67198497E-09, 4-5.44850998E-10,-6.61487149E-11,-8.11753486E-12, 2.10819534E-02, 5 2.10820692E-02, 2.10821561E-02, 2.10823154E-02, 2.10826050E-02, 6 2.10831118E-02, 2.10839807E-02, 2.10855737E-02, 2.10884705E-02, 7 2.10935411E-02, 2.11022372E-02, 2.11181919E-02, 2.11472395E-02, 8 2.11981948E-02, 2.12859096E-02, 2.14479200E-02, 2.16713789E-02, 9 2.20121631E-02, 2.26748079E-02, 2.36128573E-02, 2.49588564E-02/ DATA CH 37/ 1 2.69994181E-02, 3.00695593E-02, 3.50546660E-02, 4.82036877E-02, 2-7.97111783E-04,-4.87438566E-02,-3.09328678E-02,-2.26544845E-02, 3-1.62047269E-02,-1.18463299E-02,-8.17351975E-03,-5.73132332E-03, 4-3.80196984E-03,-2.55452966E-03,-1.73345966E-03,-1.04625341E-03, 5-5.65090551E-04,-2.74450106E-04,-1.13476006E-04,-3.58373195E-05, 6-1.15586552E-05,-3.78744381E-06,-1.25645208E-06,-4.20972316E-07, 7-8.28645553E-08,-1.65443178E-08,-3.34060400E-09,-6.80748360E-10, 8-8.25891906E-11,-1.01292468E-11, 1.80345087E-02, 1.80346025E-02, 9 1.80346728E-02, 1.80348018E-02, 1.80350362E-02, 1.80354466E-02/ DATA CH 38/ 1 1.80361500E-02, 1.80374397E-02, 1.80397849E-02, 1.80438900E-02, 2 1.80509298E-02, 1.80638448E-02, 1.80873553E-02, 1.81285880E-02, 3 1.81995382E-02, 1.83304906E-02, 1.85109119E-02, 1.87856137E-02, 4 1.93181999E-02, 2.00685569E-02, 2.11377479E-02, 2.27412677E-02, 5 2.51123942E-02, 2.88515368E-02, 3.50495187E-02, 5.16632021E-02, 6 3.00500586E-03,-5.10502016E-02,-3.11834652E-02,-2.18472301E-02, 7-1.57558003E-02,-1.07467788E-02,-7.47494351E-03,-4.92345064E-03, 8-3.29037961E-03,-2.22343494E-03,-1.33610350E-03,-7.18622045E-04, 9-3.47694325E-04,-1.43252461E-04,-4.50864884E-05,-1.45053799E-05/ DATA CH 39/ 1-4.74387966E-06,-1.57134883E-06,-5.25827462E-07,-1.03351743E-07, 2-2.06108848E-08,-4.15785767E-09,-8.46641867E-10,-1.02630428E-10, 3-1.25787831E-11, 1.64786075E-02, 1.64786895E-02, 1.64787510E-02, 4 1.64788638E-02, 1.64790690E-02, 1.64794279E-02, 1.64800433E-02, 5 1.64811715E-02, 1.64832231E-02, 1.64868141E-02, 1.64929723E-02, 6 1.65042692E-02, 1.65248325E-02, 1.65608906E-02, 1.66229198E-02, 7 1.67373508E-02, 1.68948904E-02, 1.71344875E-02, 1.75980955E-02, 8 1.82492013E-02, 1.91727468E-02, 2.05483911E-02, 2.25612944E-02, 9 2.56821454E-02, 3.07104584E-02, 3.88090757E-02, 5.60828824E-02/ DATA CH 40/ 1 1.38016993E-03,-5.70339351E-02,-3.20806211E-02,-2.27479574E-02, 2-1.52901387E-02,-1.05291477E-02,-6.87599889E-03,-4.56641458E-03, 3-3.07072472E-03,-1.83601908E-03,-9.82842417E-04,-4.73524685E-04, 4-1.94334826E-04,-6.09350428E-05,-1.95508802E-05,-6.38070901E-06, 5-2.11006760E-06,-7.05164855E-07,-1.38381964E-07,-2.75628064E-08, 6-5.55478372E-09,-1.13017307E-09,-1.36879731E-10,-1.67645870E-11, 7 1.49382707E-02, 1.49383419E-02, 1.49383954E-02, 1.49384934E-02, 8 1.49386716E-02, 1.49389835E-02, 1.49395182E-02, 1.49404985E-02, 9 1.49422810E-02, 1.49454010E-02, 1.49507513E-02, 1.49605658E-02/ DATA CH 41/ 1 1.49784293E-02, 1.50097490E-02, 1.50636142E-02, 1.51629417E-02, 2 1.52995974E-02, 1.55072323E-02, 1.59083061E-02, 1.64700506E-02, 3 1.72637549E-02, 1.84392393E-02, 2.01445276E-02, 2.27531418E-02, 4 2.68624659E-02, 3.32277631E-02, 4.20505558E-02, 6.32993021E-02, 5 4.77638112E-03,-6.19856622E-02,-3.71436880E-02,-2.42903955E-02, 6-1.64402688E-02,-1.05882308E-02,-6.96335960E-03,-4.64839913E-03, 7-2.75889880E-03,-1.46685643E-03,-7.02504829E-04,-2.86746026E-04, 8-8.94499336E-05,-2.85938507E-05,-9.30594132E-06,-3.07068166E-06, 9-1.02437882E-06,-2.00603757E-07,-3.98910777E-08,-8.02885662E-09/ DATA CH 42/ 1-1.63180516E-09,-1.97406377E-10,-2.41552084E-11, 1.19676523E-02, 2 1.19677075E-02, 1.19677488E-02, 1.19678247E-02, 1.19679626E-02, 3 1.19682039E-02, 1.19686175E-02, 1.19693759E-02, 1.19707550E-02, 4 1.19731688E-02, 1.19773080E-02, 1.19849008E-02, 1.19987195E-02, 5 1.20229452E-02, 1.20646023E-02, 1.21413936E-02, 1.22469917E-02, 6 1.24073222E-02, 1.27166280E-02, 1.31489715E-02, 1.37581127E-02, 7 1.46565416E-02, 1.59520156E-02, 1.79155963E-02, 2.09638003E-02, 8 2.55738576E-02, 3.17370854E-02, 4.13539855E-02, 6.47330583E-02, 9-3.13002439E-03,-6.64300268E-02,-3.38972397E-02,-2.25383908E-02/ DATA CH 43/ 1-1.42927434E-02,-9.29930308E-03,-6.15889710E-03,-3.62688409E-03, 2-1.91468013E-03,-9.11336795E-04,-3.69930636E-04,-1.14801546E-04, 3-3.65621381E-05,-1.18661438E-05,-3.90696388E-06,-1.30108568E-06, 4-2.54265702E-07,-5.04812466E-08,-1.01473767E-08,-2.06022904E-09, 5-2.48953995E-10,-3.04351150E-11, 9.90213654E-03, 9.90218064E-03, 6 9.90221371E-03, 9.90227434E-03, 9.90238459E-03, 9.90257751E-03, 7 9.90290825E-03, 9.90351464E-03, 9.90461728E-03, 9.90654721E-03, 8 9.90985662E-03, 9.91592702E-03, 9.92697457E-03, 9.94634027E-03, 9 9.97963508E-03, 1.00409936E-02, 1.01253323E-02, 1.02533023E-02/ DATA CH 44/ 1 1.04998993E-02, 1.08439750E-02, 1.13275447E-02, 1.20382071E-02, 2 1.30576130E-02, 1.45908932E-02, 1.69430759E-02, 2.04359677E-02, 3 2.49835860E-02, 3.18044908E-02, 4.24883980E-02, 7.17810122E-02, 4 8.67332704E-03,-6.89895852E-02,-3.75877207E-02,-2.31267135E-02, 5-1.47569239E-02,-9.64269831E-03,-5.60654549E-03,-2.92702753E-03, 6-1.38022587E-03,-5.55694562E-04,-1.71160116E-04,-5.42248495E-05, 7-1.75297441E-05,-5.75424343E-06,-1.91162598E-06,-3.72520712E-07, 8-7.37975875E-08,-1.48084838E-08,-3.00232238E-09,-3.62241875E-10, 9-4.42306309E-11, 8.17766125E-03, 8.17769672E-03, 8.17772332E-03/ DATA CH 45/ 1 8.17777209E-03, 8.17786076E-03, 8.17801593E-03, 8.17828196E-03, 2 8.17876969E-03, 8.17965656E-03, 8.18120883E-03, 8.18387062E-03, 3 8.18875298E-03, 8.19763809E-03, 8.21321213E-03, 8.23998502E-03, 4 8.28931430E-03, 8.35709735E-03, 8.45989986E-03, 8.65784069E-03, 5 8.93367940E-03, 9.32067034E-03, 9.88797957E-03, 1.06988496E-02, 6 1.19121548E-02, 1.37590627E-02, 1.64702835E-02, 1.99453256E-02, 7 2.50435890E-02, 3.27774721E-02, 4.59347375E-02, 7.42013248E-02, 8-3.84440691E-03,-7.61316789E-02,-3.61005009E-02,-2.25876634E-02, 9-1.45415779E-02,-8.33864216E-03,-4.30235527E-03,-2.00920297E-03/ DATA CH 46/ 1-8.02224334E-04,-2.45245798E-04,-7.72927354E-05,-2.48915407E-05, 2-8.14674445E-06,-2.70011013E-06,-5.24735849E-07,-1.03734098E-07, 3-2.07811051E-08,-4.20755327E-09,-5.06922737E-10,-6.18247845E-11, 4 6.11252521E-03, 6.11255098E-03, 6.11257031E-03, 6.11260575E-03, 5 6.11267017E-03, 6.11278293E-03, 6.11297622E-03, 6.11333061E-03, 6 6.11397502E-03, 6.11510290E-03, 6.11703692E-03, 6.12058433E-03, 7 6.12703979E-03, 6.13835434E-03, 6.15780263E-03, 6.19362889E-03, 8 6.24284199E-03, 6.31744633E-03, 6.46097742E-03, 6.66074206E-03, 9 6.94051524E-03, 7.34963242E-03, 7.93233789E-03, 8.79983611E-03/ DATA CH 47/ 1 1.01105399E-02, 1.20139653E-02, 1.44190263E-02, 1.78794221E-02, 2 2.29776191E-02, 3.12457639E-02, 4.32092822E-02, 8.03682628E-02, 3 7.96504037E-03,-7.77435659E-02,-3.82082769E-02,-2.39372959E-02, 4-1.33928966E-02,-6.77602270E-03,-3.11640595E-03,-1.22867876E-03, 5-3.71486061E-04,-1.16205869E-04,-3.72204288E-05,-1.21315871E-05, 6-4.00773967E-06,-7.75921754E-07,-1.52950062E-07,-3.05712348E-08, 7-6.17843471E-09,-7.42915499E-10,-9.04651545E-11, 4.84035718E-03, 8 4.84037714E-03, 4.84039212E-03, 4.84041957E-03, 4.84046948E-03, 9 4.84055683E-03, 4.84070657E-03, 4.84098112E-03, 4.84148033E-03/ DATA CH 48/ 1 4.84235409E-03, 4.84385235E-03, 4.84660042E-03, 4.85160115E-03, 2 4.86036555E-03, 4.87542922E-03, 4.90317432E-03, 4.94127798E-03, 3 4.99902191E-03, 5.11005101E-03, 5.26444026E-03, 5.48039520E-03, 4 5.79563422E-03, 6.24351713E-03, 6.90795579E-03, 7.90675700E-03, 5 9.34685632E-03, 1.11498855E-02, 1.37134602E-02, 1.74284831E-02, 6 2.33075143E-02, 3.15464164E-02, 4.71303961E-02, 8.31860584E-02, 7-1.39809080E-03,-8.27387920E-02,-4.26914313E-02,-2.30114305E-02, 8-1.13291684E-02,-5.10872289E-03,-1.98326793E-03,-5.91887189E-04, 9-1.83572375E-04,-5.84402378E-05,-1.89608675E-05,-6.24146835E-06/ DATA CH 49/ 1-1.20342928E-06,-2.36485698E-07,-4.71534551E-08,-9.51109020E-09, 2-1.14126675E-09,-1.38742936E-10, 3.06078216E-03, 3.06079452E-03, 3 3.06080379E-03, 3.06082079E-03, 3.06085169E-03, 3.06090577E-03, 4 3.06099849E-03, 3.06116847E-03, 3.06147755E-03, 3.06201853E-03, 5 3.06294614E-03, 3.06464754E-03, 3.06774352E-03, 3.07316939E-03, 6 3.08249429E-03, 3.09966707E-03, 3.12324631E-03, 3.15896846E-03, 7 3.22761787E-03, 3.32299780E-03, 3.45626012E-03, 3.65047653E-03, 8 3.92579238E-03, 4.33292826E-03, 4.94215751E-03, 5.81499105E-03, 9 6.89908541E-03, 8.42487188E-03, 1.06056083E-02, 1.39880458E-02/ DATA CH 50/ 1 1.85952310E-02, 2.69222098E-02, 3.97570231E-02, 8.17551485E-02, 2-2.09131453E-03,-8.11066235E-02,-3.25775813E-02,-1.56223141E-02, 3-6.89366661E-03,-2.63175306E-03,-7.74659828E-04,-2.38122772E-04, 4-7.53309275E-05,-2.43267140E-05,-7.97870666E-06,-1.53201107E-06, 5-3.00117305E-07,-5.96957156E-08,-1.20174531E-08,-1.43902739E-09, 6-1.74654400E-10, 2.40512571E-03, 2.40513525E-03, 2.40514241E-03, 7 2.40515553E-03, 2.40517939E-03, 2.40522114E-03, 2.40529272E-03, 8 2.40542396E-03, 2.40566258E-03, 2.40608023E-03, 2.40679639E-03, 9 2.40810991E-03, 2.41050005E-03, 2.41468874E-03, 2.42188700E-03/ DATA CH 51/ 1 2.43514190E-03, 2.45333866E-03, 2.48089982E-03, 2.53384359E-03, 2 2.60735450E-03, 2.70997012E-03, 2.85933438E-03, 3.07069863E-03, 3 3.38249757E-03, 3.84744668E-03, 4.51040248E-03, 5.32899596E-03, 4 6.47276667E-03, 8.09200038E-03, 1.05707708E-02, 1.38891885E-02, 5 1.97365176E-02, 2.84560234E-02, 4.53047976E-02, 8.93548007E-02, 6 1.14633644E-02,-8.50321604E-02,-2.84309792E-02,-1.22811274E-02, 7-4.58861788E-03,-1.32715400E-03,-4.03446003E-04,-1.26653331E-04, 8-4.06694747E-05,-1.32809492E-05,-2.53758515E-06,-4.95287716E-07, 9-9.82372640E-08,-1.97315428E-08,-2.35709284E-09,-2.85539273E-10/ DATA CH 52/ 1 2.01712685E-03, 2.01713472E-03, 2.01714062E-03, 2.01715144E-03, 2 2.01717110E-03, 2.01720552E-03, 2.01726451E-03, 2.01737268E-03, 3 2.01756936E-03, 2.01791361E-03, 2.01850388E-03, 2.01958652E-03, 4 2.02155648E-03, 2.02500871E-03, 2.03094102E-03, 2.04186369E-03, 5 2.05685634E-03, 2.07955939E-03, 2.12315372E-03, 2.18364614E-03, 6 2.26801810E-03, 2.39068326E-03, 2.56398272E-03, 2.81904874E-03, 7 3.19818241E-03, 3.73643021E-03, 4.39752935E-03, 5.31530603E-03, 8 6.60386497E-03, 8.55456517E-03, 1.11290500E-02, 1.55742879E-02, 9 2.20122110E-02, 3.39250844E-02, 5.36878777E-02, 9.95979074E-02/ DATA CH 53/ 1 7.38783044E-03,-9.50072179E-02,-2.79356771E-02,-1.01851683E-02, 2-2.87000689E-03,-8.58470434E-04,-2.66568783E-04,-8.49241131E-05, 3-2.75671564E-05,-5.23211420E-06,-1.01618882E-06,-2.00793527E-07, 4-4.02097603E-08,-4.78825897E-09,-5.78618369E-10, 1.33288084E-03, 5 1.33288594E-03, 1.33288976E-03, 1.33289677E-03, 1.33290952E-03, 6 1.33293182E-03, 1.33297006E-03, 1.33304017E-03, 1.33316764E-03, 7 1.33339075E-03, 1.33377332E-03, 1.33447498E-03, 1.33575171E-03, 8 1.33798900E-03, 1.34183333E-03, 1.34891082E-03, 1.35862388E-03, 9 1.37332860E-03, 1.40155268E-03, 1.44069144E-03, 1.49523153E-03/ DATA CH 54/ 1 1.57442635E-03, 1.68611825E-03, 1.85011482E-03, 2.09306390E-03, 2 2.43641543E-03, 2.85584007E-03, 3.43430215E-03, 4.23973960E-03, 3 5.44579212E-03, 7.01592436E-03, 9.67657467E-03, 1.34312915E-02, 4 2.01127759E-02, 3.05514315E-02, 4.72151598E-02, 1.06374254E-01, 5 6.17009581E-03,-9.96689690E-02,-2.29826081E-02,-6.35395069E-03, 6-1.86016685E-03,-5.69117121E-04,-1.79391630E-04,-5.77685069E-05, 7-1.08675594E-05,-2.09713305E-06,-4.12348604E-07,-8.22550044E-08, 8-9.75547377E-09,-1.17513816E-09, 7.83530263E-04, 7.83533205E-04, 9 7.83535411E-04, 7.83539456E-04, 7.83546811E-04, 7.83559683E-04/ DATA CH 55/ 1 7.83581748E-04, 7.83622204E-04, 7.83695764E-04, 7.83824512E-04, 2 7.84045274E-04, 7.84450168E-04, 7.85186888E-04, 7.86477851E-04, 3 7.88695987E-04, 7.92779208E-04, 7.98382125E-04, 8.06862583E-04, 4 8.23133638E-04, 8.45683544E-04, 8.77081467E-04, 9.22621229E-04, 5 9.86747741E-04, 1.08070159E-03, 1.21947081E-03, 1.41480537E-03, 6 1.65228363E-03, 1.97796366E-03, 2.42825567E-03, 3.09645031E-03, 7 3.95688231E-03, 5.39401252E-03, 7.38417265E-03, 1.08343660E-02, 8 1.60328684E-02, 2.39734579E-02, 4.17194172E-02, 1.11167234E-01, 9 8.12147389E-03,-1.03787203E-01,-1.21664585E-02,-3.86675215E-03/ DATA CH 56/ 1-1.18915115E-03,-3.73896986E-04,-1.19964593E-04,-2.24513332E-05, 2-4.31383088E-06,-8.45232000E-07,-1.68121328E-07,-1.98775513E-08, 3-2.38852128E-09, 4.31428330E-04, 4.31429921E-04, 4.31431114E-04, 4 4.31433301E-04, 4.31437277E-04, 4.31444237E-04, 4.31456167E-04, 5 4.31478041E-04, 4.31517814E-04, 4.31587425E-04, 4.31706786E-04, 6 4.31925702E-04, 4.32324019E-04, 4.33021975E-04, 4.34221142E-04, 7 4.36428406E-04, 4.39456738E-04, 4.44039416E-04, 4.52828828E-04, 8 4.65003230E-04, 4.81941729E-04, 5.06483608E-04, 5.40992089E-04, 9 5.91451062E-04, 6.65773945E-04, 7.70012232E-04, 8.96197259E-04/ DATA CH 57/ 1 1.06838152E-03, 1.30498580E-03, 1.65337178E-03, 2.09788586E-03, 2 2.83167264E-03, 3.83295521E-03, 5.53558430E-03, 8.03725864E-03, 3 1.17425654E-02, 1.96937155E-02, 3.83110605E-02, 1.16965943E-01, 4 1.70596981E-02,-1.04676812E-01,-1.49791483E-02,-4.61490244E-03, 5-1.41336984E-03,-4.44019379E-04,-8.12146998E-05,-1.53549240E-05, 6-2.97292628E-06,-5.85942629E-07,-6.86335825E-08,-8.18846903E-09, 7 1.76504596E-04, 1.76505236E-04, 1.76505716E-04, 1.76506595E-04, 8 1.76508194E-04, 1.76510993E-04, 1.76515791E-04, 1.76524587E-04, 9 1.76540581E-04, 1.76568575E-04, 1.76616575E-04, 1.76704609E-04/ DATA CH 58/ 1 1.76864784E-04, 1.77145446E-04, 1.77627631E-04, 1.78515097E-04, 2 1.79732531E-04, 1.81574490E-04, 1.85106158E-04, 1.89995492E-04, 3 1.96793481E-04, 2.06633635E-04, 2.20451953E-04, 2.40621411E-04, 4 2.70257059E-04, 3.11687506E-04, 3.61652140E-04, 4.29533409E-04, 5 5.22318426E-04, 6.58041955E-04, 8.29891879E-04, 1.11086753E-03, 6 1.48978818E-03, 2.12459025E-03, 3.04004297E-03, 4.36637098E-03, 7 7.12331778E-03, 1.32969150E-02, 2.85096991E-02, 1.11666537E-01, 8-4.21396883E-03,-1.10284816E-01,-1.64598789E-02,-5.04576505E-03, 9-1.54500498E-03,-2.74412953E-04,-5.08407627E-05,-9.70061455E-06/ DATA CH 59/ 1-1.89099014E-06,-2.19067018E-07,-2.59202504E-08, 4.75737999E-05, 2 4.75739692E-05, 4.75740961E-05, 4.75743288E-05, 4.75747518E-05, 3 4.75754922E-05, 4.75767614E-05, 4.75790884E-05, 4.75833196E-05, 4 4.75907252E-05, 4.76034231E-05, 4.76267115E-05, 4.76690835E-05, 5 4.77433262E-05, 4.78708713E-05, 4.81055985E-05, 4.84275557E-05, 6 4.89145775E-05, 4.98480482E-05, 5.11396923E-05, 5.29342760E-05, 7 5.55293882E-05, 5.91687194E-05, 6.44709356E-05, 7.22419364E-05, 8 8.30697594E-05, 9.60776780E-05, 1.13671693E-04, 1.37592294E-04, 9 1.72353366E-04, 2.16035135E-04, 2.86792225E-04, 3.81147735E-04/ DATA CH 60/ 1 5.37033212E-04, 7.58041404E-04, 1.07204934E-03, 1.70711650E-03, 2 3.06896932E-03, 6.23597647E-03, 1.46455423E-02, 1.10928995E-01, 3 3.32637354E-04,-1.09275276E-01,-1.61840066E-02,-4.96436691E-03, 4-8.49428119E-04,-1.53251063E-04,-2.87008566E-05,-5.51873468E-06, 5-6.30811811E-07,-7.39041184E-08, 1.65963707E-05, 1.65964292E-05, 6 1.65964730E-05, 1.65965535E-05, 1.65966997E-05, 1.65969557E-05, 7 1.65973944E-05, 1.65981988E-05, 1.65996615E-05, 1.66022215E-05, 8 1.66066110E-05, 1.66146615E-05, 1.66293089E-05, 1.66549730E-05, 9 1.66990618E-05, 1.67801970E-05, 1.68914772E-05, 1.70597947E-05/ DATA CH 61/ 1 1.73823576E-05, 1.78285817E-05, 1.84483554E-05, 1.93441974E-05, 2 2.05997413E-05, 2.24274540E-05, 2.51031596E-05, 2.88259537E-05, 3 3.32908189E-05, 3.93183762E-05, 4.74950377E-05, 5.93453073E-05, 4 7.41919140E-05, 9.81549891E-05, 1.29978323E-04, 1.82300609E-04, 5 2.56075790E-04, 3.60299807E-04, 5.69642755E-04, 1.01491888E-03, 6 2.04637231E-03, 4.98400307E-03, 1.62482170E-02, 1.09495330E-01, 7 4.87780468E-04,-1.07070311E-01,-1.85042259E-02,-2.99110492E-03, 8-5.16537201E-04,-9.40606513E-05,-1.77389579E-05,-1.99116462E-06, 9-2.30294703E-07, 5.41117987E-06, 5.41119878E-06, 5.41121296E-06/ DATA CH 62/ 1 5.41123897E-06, 5.41128625E-06, 5.41136899E-06, 5.41151083E-06, 2 5.41177089E-06, 5.41224376E-06, 5.41307138E-06, 5.41449045E-06, 3 5.41709305E-06, 5.42182829E-06, 5.43012499E-06, 5.44437766E-06, 4 5.47060549E-06, 5.50657593E-06, 5.56097877E-06, 5.66522125E-06, 5 5.80939544E-06, 6.00958333E-06, 6.29882216E-06, 6.70396889E-06, 6 7.29329526E-06, 8.15515016E-06, 9.35265992E-06, 1.07866473E-05, 7 1.27191268E-05, 1.53351846E-05, 1.91171055E-05, 2.38419814E-05, 8 3.14425618E-05, 4.14968487E-05, 5.79511291E-05, 8.10274507E-05, 9 1.13439313E-04, 1.78053573E-04, 3.14022833E-04, 6.24374131E-04/ DATA CH 63/ 1 1.49124696E-03, 4.87119183E-03, 1.58675957E-02, 1.08112412E-01, 2-5.64721193E-03,-1.07343941E-01,-1.38176932E-03,-6.67356397E-04, 3-1.37885383E-04,-2.72730427E-05,-3.15302305E-06,-3.70214196E-07, 4 2.08043565E-06, 2.08044287E-06, 2.08044828E-06, 2.08045820E-06, 5 2.08047624E-06, 2.08050781E-06, 2.08056193E-06, 2.08066115E-06, 6 2.08084156E-06, 2.08115733E-06, 2.08169875E-06, 2.08269172E-06, 7 2.08449834E-06, 2.08766372E-06, 2.09310134E-06, 2.10310735E-06, 8 2.11682952E-06, 2.13758185E-06, 2.17734083E-06, 2.23231940E-06, 9 2.30863775E-06, 2.41886513E-06, 2.57318772E-06, 2.79751407E-06/ DATA CH 64/ 1 3.12527806E-06, 3.58015346E-06, 4.12411732E-06, 4.85605468E-06, 2 5.84511401E-06, 7.27185995E-06, 9.05002713E-06, 1.19022183E-05, 3 1.56626318E-05, 2.17926082E-05, 3.03508050E-05, 4.23131053E-05, 4 6.60120571E-05, 1.15442162E-04, 2.26886841E-04, 5.32684722E-04, 5 1.69371530E-03, 5.52770775E-03, 1.80892239E-02, 1.16234750E-01, 6 2.76168404E-02,-9.53568850E-02,-2.93943754E-03,-8.38438697E-04, 7-1.65138689E-04,-1.86290604E-05,-2.14192535E-06, 7.11612643E-07, 8 7.11615095E-07, 7.11616934E-07, 7.11620305E-07, 7.11626435E-07, 9 7.11637161E-07, 7.11655550E-07, 7.11689265E-07, 7.11750569E-07/ DATA CH 65/ 1 7.11857863E-07, 7.12041833E-07, 7.12379237E-07, 7.12993109E-07, 2 7.14068666E-07, 7.15916272E-07, 7.19316041E-07, 7.23978257E-07, 3 7.31028596E-07, 7.44534757E-07, 7.63207949E-07, 7.89123296E-07, 4 8.26541566E-07, 8.78906601E-07, 9.54982163E-07, 1.06605075E-06, 5 1.22003998E-06, 1.40397899E-06, 1.65116303E-06, 1.98467729E-06, 6 2.46491486E-06, 3.06223933E-06, 4.01807902E-06, 5.27484361E-06, 7 7.31698881E-06, 1.01576386E-05, 1.41127191E-05, 2.19093204E-05, 8 3.80573906E-05, 7.41150532E-05, 1.71687225E-04, 5.33923293E-04, 9 1.69603350E-03, 5.53819650E-03, 1.83971155E-02, 1.02940053E-01/ DATA CH 66/ 1-6.16317670E-03,-1.00741788E-01,-3.73960779E-03,-9.74975681E-04, 2-1.09756316E-04,-1.23812238E-05, 8.08788948E-08, 8.08791690E-08, 3 8.08793747E-08, 8.08797519E-08, 8.08804375E-08, 8.08816375E-08, 4 8.08836946E-08, 8.08874661E-08, 8.08943238E-08, 8.09063263E-08, 5 8.09269060E-08, 8.09646492E-08, 8.10333184E-08, 8.11536300E-08, 6 8.13602954E-08, 8.17405538E-08, 8.22619620E-08, 8.30503349E-08, 7 8.45602162E-08, 8.66469097E-08, 8.95413560E-08, 9.37174735E-08, 8 9.95558916E-08, 1.08026390E-07, 1.20370367E-07, 1.37443819E-07, 9 1.57782504E-07, 1.85030552E-07, 2.21662610E-07, 2.74182728E-07/ DATA CH 67/ 1 3.39193538E-07, 4.42631225E-07, 5.77739664E-07, 7.95587506E-07, 2 1.09593305E-06, 1.51015281E-06, 2.31679844E-06, 3.95882473E-06, 3 7.53797472E-06, 1.68839094E-05, 4.95306923E-05, 1.44789965E-04, 4 4.15382842E-04, 1.09942732E-03, 1.31208811E-03, 1.02365061E-01, 5 4.70799162E-04,-9.82089711E-02,-5.38213464E-03,-6.63214122E-04, 6-7.19592889E-05, 1.95130503E-08, 1.95131164E-08, 1.95131659E-08, 7 1.95132568E-08, 1.95134219E-08, 1.95137110E-08, 1.95142064E-08, 8 1.95151148E-08, 1.95167666E-08, 1.95196575E-08, 1.95246144E-08, 9 1.95337053E-08, 1.95502450E-08, 1.95792233E-08, 1.96290007E-08/ DATA CH 68/ 1 1.97205891E-08, 1.98461735E-08, 2.00360556E-08, 2.03997073E-08, 2 2.09022661E-08, 2.15993323E-08, 2.26049996E-08, 2.40108548E-08, 3 2.60502724E-08, 2.90218592E-08, 3.31312256E-08, 3.80255045E-08, 4 4.45810213E-08, 5.33920847E-08, 6.60213059E-08, 8.16498384E-08, 5 1.06509044E-07, 1.38970511E-07, 1.91297283E-07, 2.63424155E-07, 6 3.62884506E-07, 5.56570399E-07, 9.50953805E-07, 1.81143275E-06, 7 4.06430324E-06, 1.19959897E-05, 3.56109619E-05, 1.06274847E-04, 8 3.17923256E-04, 9.41771985E-04, 3.54841289E-03, 9.95277362E-02, 9-4.11990696E-03,-9.78057270E-02, 3.72452157E-03, 5.71822715E-05/ DATA CH 69/ 1 4.33638262E-09, 4.33639724E-09, 4.33640820E-09, 4.33642830E-09, 2 4.33646485E-09, 4.33652880E-09, 4.33663844E-09, 4.33683946E-09, 3 4.33720496E-09, 4.33784467E-09, 4.33894153E-09, 4.34095316E-09, 4 4.34461307E-09, 4.35102535E-09, 4.36203991E-09, 4.38230594E-09, 5 4.41009364E-09, 4.45210675E-09, 4.53256276E-09, 4.64374017E-09, 6 4.79792631E-09, 5.02033171E-09, 5.33116143E-09, 5.78191679E-09, 7 6.43840166E-09, 7.34571416E-09, 8.42561144E-09, 9.87098040E-09, 8 1.18119837E-08, 1.45912712E-08, 1.80267803E-08, 2.34843331E-08, 9 3.06004650E-08, 4.20522909E-08, 5.78080613E-08, 7.94929896E-08/ DATA CH 70/ 1 1.21621788E-07, 2.07132769E-07, 3.92943235E-07, 8.76821801E-07, 2 2.56764760E-06, 7.55935688E-06, 2.23853323E-05, 6.66856982E-05, 3 1.99641258E-04, 1.02807083E-03, 4.04552113E-03, 1.02726581E-01, 4 1.79886089E-02,-8.60501553E-02, 2.60616271E-03, 8.87765567E-10, 5 8.87768549E-10, 8.87770786E-10, 8.87774887E-10, 8.87782344E-10, 6 8.87795393E-10, 8.87817763E-10, 8.87858776E-10, 8.87933351E-10, 7 8.88063871E-10, 8.88287666E-10, 8.88698102E-10, 8.89444837E-10, 8 8.90753137E-10, 8.93000426E-10, 8.97135224E-10, 9.02804526E-10, 9 9.11375875E-10, 9.27789361E-10, 9.50468423E-10, 9.81917510E-10/ DATA CH 71/ 1 1.02727458E-09, 1.09065231E-09, 1.18253624E-09, 1.31630906E-09, 2 1.50110859E-09, 1.72094560E-09, 2.01501193E-09, 2.40965166E-09, 3 2.97428145E-09, 3.67162075E-09, 4.77827845E-09, 6.21961604E-09, 4 8.53612265E-09, 1.17186469E-08, 1.60922937E-08, 2.45737478E-08, 5 4.17468094E-08, 7.89451660E-08, 1.75412258E-07, 5.10501814E-07, 6 1.49282957E-06, 4.38903313E-06, 1.29827929E-05, 3.86624380E-05, 7 2.01282979E-04, 1.05423514E-03, 4.64098366E-03, 9.04415425E-02, 8-1.89214643E-03,-1.71716873E-01, 3.90236429E-11, 3.90237704E-11, 9 3.90238661E-11, 3.90240415E-11, 3.90243603E-11, 3.90249183E-11/ DATA CH 72/ 1 3.90258750E-11, 3.90276288E-11, 3.90308179E-11, 3.90363993E-11, 2 3.90459694E-11, 3.90635206E-11, 3.90954520E-11, 3.91513949E-11, 3 3.92474829E-11, 3.94242567E-11, 3.96665942E-11, 4.00328934E-11, 4 4.07340360E-11, 4.17022052E-11, 4.30435973E-11, 4.49758834E-11, 5 4.76714763E-11, 5.15708862E-11, 5.72310912E-11, 6.50204295E-11, 6 7.42462624E-11, 8.65270039E-11, 1.02913995E-10, 1.26201174E-10, 7 1.54746928E-10, 1.99652158E-10, 2.57554840E-10, 3.49544435E-10, 8 4.74280527E-10, 6.43363594E-10, 9.65652637E-10, 1.60290389E-09, 9 2.94005367E-09, 6.25723494E-09, 1.70097397E-08, 4.56909069E-08/ DATA CH 73/ 1 1.20421289E-07, 3.07324137E-07, 7.38632443E-07, 2.00511821E-06, 2-4.66809104E-06,-1.85535655E-04,-4.04881136E-03, 8.50154847E-02, 3 1.69140724E-01/ END SUBROUTINE CONVEC IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ABROSS/ABROSS(kw),TAUROS(kw) COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw), 1 SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2) COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw), 1 AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw), 2 SHLINE(kw),XNFPH(kw,2),XNFH(kw) COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw), 1 GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH, 2 IFCONV REAL*8 MIXLTH COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99),XABUND(99),WTMOLE COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20) COMMON /PZERO/PZERO,PCON,PRADK0,PTURB0,KNU(kw),PRADK(kw),EDENS(kw) REAL*8 KNU COMMON /RAD/ACCRAD(kw),PRAD(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP,HCKT(kw) COMMON /TEFF/TEFF,GRAV,GLOG COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB DIMENSION EQ(4),DEQ(4,4),DUMMY(4) DIMENSION TNEW(4),PNEW(4),ENERGY(4),RHON(4) DIMENSION DTDRHX(kw) EQUIVALENCE (DTDRHX(1),DLTDLP(1)) CALL DERIV(RHOX,T,DTDRHX,NRHOX) C CALCULATE DERIVATIVES BY EVALUATING FUNCTIONS AT + AND - .001 C FIRST GUESSES XH= MAX (XABUND(1),1.D-20) XHE= MAX (XABUND(2),1.D-20) C XNHE1=XNATOM(1)*XHE XNHE1=XNFHE(1,1) XNH1=XNFH(1) XNAT=XNATOM(1) XNEL=XNE(1) DO 30 J=1,NRHOX DILUT=1.-EXP(-TAUROS(J)) TNEW(1)=T(J)*1.001 PNEW(1)=P(J) TNEW(2)=T(J)*.999 PNEW(2)=P(J) TNEW(3)=T(J) PNEW(3)=P(J)*1.001 TNEW(4)=T(J) PNEW(4)=P(J)*.999 DO 15 I=1,4 TN=TNEW(I) TKN=TN*1.3804E-16 TKEVN=TN*8.6171E-5 XNTOT=PNEW(I)/TKN CT32=2.4148D15*TN*SQRT(TN) CEQH2=CT32*EXP(-13.595/TKEVN) CEQHH=0. IF(TN.LT.10000.)CEQHH=EXP(4.477/TKEVN-4.6628E1+(1.8031E-3+ 1(-5.0239E-7+(8.1424E-11-5.0501E-15*TN)*TN)*TN)*TN-1.5* LOG(TN)) C THE AMIN IS FOR ANY UNFORTUNATE WHO HAS A 360 CEQHE2=4.*CT32*EXP(-MIN(24.580/TKEVN,150.D0)) CEQHE3=4.*CT32**2*EXP(-MIN(78.983/TKEVN,150.D0)) DO 13 K=1,100 XNH2=XNH1*CEQH2/XNEL XNHH=XNH1**2*CEQHH XNHE2=XNHE1*CEQHE2/XNEL XNHE3=XNHE1*CEQHE3/XNEL**2 EQ(1)=XNH1+XNH2+2.*XNHH-XH*XNAT EQ(2)=XNHE1+XNHE2+XNHE3-XHE*XNAT EQ(3)=XNH2+XNHE2+2.*XNHE3-XNEL EQ(4)=XNH1+XNH2+XNHH+XNHE1+XNHE2+XNHE3+XNEL-XNTOT DEQ(1,1)=(XNH1+XNH2+4.*XNHH)/XNH1 DEQ(1,2)=0. DEQ(1,3)=-XH DEQ(1,4)=-XNH2/XNEL DEQ(2,1)=0. DEQ(2,2)=(XNHE1+XNHE2+XNHE3)/XNHE1 DEQ(2,3)=-XHE DEQ(2,4)=(-XNHE2-2.*XNHE3)/XNEL DEQ(3,1)=XNH2/XNH1 DEQ(3,2)=(XNHE2+XNHE3)/XNHE1 DEQ(3,3)=0. DEQ(3,4)=(-XNH2-XNHE2-4.*XNHE3-XNEL)/XNEL DEQ(4,1)=(XNH1+XNH2+2.*XNHH)/XNH1 DEQ(4,2)=(XNHE1+XNHE2+XNHE3)/XNHE1 DEQ(4,3)=0. DEQ(4,4)=(-XNH2-XNHE2-2.*XNHE3+XNEL)/XNEL C CALL SOLVIT(DEQ,4,EQ,DUMMY) Q1311=DEQ(1,3)/DEQ(1,1) Q1411=DEQ(1,4)/DEQ(1,1) E111=EQ(1)/DEQ(1,1) Q2322=DEQ(2,3)/DEQ(2,2) Q2422=DEQ(2,4)/DEQ(2,2) E222=EQ(2)/DEQ(2,2) Q3431=DEQ(3,4)/DEQ(3,1) Q3231=DEQ(3,2)/DEQ(3,1) E331=EQ(3)/DEQ(3,1) Q4441=DEQ(4,4)/DEQ(4,1) Q4241=DEQ(4,2)/DEQ(4,1) E441=EQ(4)/DEQ(4,1) QQQ3=Q1311+Q2322*Q3231 QQQ4=Q1311+Q2322*Q4241 QQQQ3=(Q1411+Q2422*Q3231-Q3431)/QQQ3 EQQQ3=(E111+E222*Q3231-E331)/QQQ3 QQQQ4=(Q1411+Q2422*Q4241-Q4441)/QQQ4 EQQQ4=(E111+E222*Q4241-E441)/QQQ4 EQ(4)=(EQQQ4-EQQQ3)/(QQQQ4-QQQQ3) EQ(3)=EQQQ3-QQQQ3*EQ(4) EQ(2)=E222-Q2422*EQ(4)-Q2322*EQ(3) EQ(1)=E111-Q1411*EQ(4)-Q1311*EQ(3) ERROR=ABS(EQ(1)/XNH1)+ABS(EQ(2)/XNHE1)+ABS(EQ(3)/XNAT)+ 1ABS(EQ(4)/XNEL) XNH1=XNH1-EQ(1) XNHE1=XNHE1-EQ(2) XNAT=XNAT-EQ(3) XNEL=XNEL-EQ(4) IF(ERROR.LT..00001)GO TO 14 13 CONTINUE CALL EXIT 14 XNH2=XNH1*CEQH2/XNEL XNHH=XNH1**2*CEQHH XNHE2=XNHE1*CEQHE2/XNEL XNHE3=XNHE1*CEQHE3/XNEL**2 EHH=-4.476/TKEVN+(1.*(1.8031E-3)+(2.*(-5.0739E-7)+(3.*(8.1424E-11) 1+4.*(-5.0501E-15)*TN)*TN)*TN)*TN RHON(I)=XNAT*WTMOLE*1.660E-24 DEDENS=(TN/T(J))**4-1. 15 ENERGY(I)=((1.5*XNTOT+13.595/TKEVN*XNH2+EHH*XNHH+ 1 24.580/TKEVN*XNHE2+78.983/TKEVN*XNHE3)*TKN+ 2 3.*PRADK(J)*(1.+DEDENS*DILUT))/RHON(I) C 2 EDENS(J)*(1.+DEDENS*DILUT))/RHON(I) C 2 3.*PRAD(J)*(TN/T(J))**4)/RHON(I) DEDT=(ENERGY(1)-ENERGY(2))/T(J)*500. DRDT=(RHON(1)-RHON(2))/T(J)*500. DEDPG=(ENERGY(3)-ENERGY(4))/P(J)*500. DRDPG=(RHON(3)-RHON(4))/P(J)*500. C C CALCULATE THERMODYNAMIC QUANTITIES AND CONVECTIVE FLUX C IGNORING PTURB AND ASSUMING PRAD PROPORTIONAL TO T**4 DPDPG=1. DPDT=4.*PRAD(J)/T(J)*DILUT C DPDT=4.*PRAD(J)/T(J) DLTDLP(J)=PTOTAL(J)/T(J)/GRAV*DTDRHX(J) HEATCV=DEDT-DEDPG*DRDT/DRDPG HEATCP(J)=DEDT-DEDPG*DPDT/DPDPG-PTOTAL(J)/RHO(J)**2*(DRDT- 1DRDPG*DPDT/DPDPG) VELSND(J)=SQRT(HEATCP(J)/HEATCV*DPDPG/DRDPG) DLRDLT(J)=T(J)/RHO(J)*(DRDT-DRDPG*DPDT/DPDPG) GRDADB(J)=-PTOTAL(J)/RHO(J)/T(J)*DLRDLT(J)/HEATCP(J) HSCALE(J)=PTOTAL(J)/RHO(J)/GRAV VCONV(J)=0. FLXCNV(J)=0. IF(MIXLTH.EQ.0.)GO TO 30 DEL=DLTDLP(J)-GRDADB(J) IF(DEL.LT.0.)GO TO 30 VCO=.5*MIXLTH*SQRT(-.5*PTOTAL(J)/RHO(J)*DLRDLT(J)) FLUXCO=.5*RHO(J)*HEATCP(J)*T(J)*MIXLTH/12.5664 D=8.*5.6697E-5*T(J)**4/(ABROSS(J)*HSCALE(J)*RHO(J))/ 1(FLUXCO*12.5664)/VCO D=D**2/2. DDD=(DEL/(D+DEL))**2 IF(DDD.LT..5)GO TO 24 DELTA=(1.-SQRT(1.-DDD))/DDD GO TO 26 24 DELTA=.5 TERM=.5 UP=-1. DOWN=2. 25 UP=UP+2. DOWN=DOWN+2. TERM=UP/DOWN*DDD*TERM DELTA=DELTA+TERM IF(TERM.GT.1.E-6)GO TO 25 26 DELTA=DELTA*DEL**2/(D+DEL) VCONV(J)=VCO*SQRT(DELTA) FLXCNV(J)=FLUXCO*VCONV(J)*DELTA 30 CONTINUE RETURN END SUBROUTINE HIGH IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /ABTOT/ABTOT(kw),ALPHA(kw) COMMON /HEIGHT/HEIGHT(kw) COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) DIMENSION RHOINV(kw) EQUIVALENCE (RHOINV(1),ABTOT(1)) DO 1 J=1,NRHOX 1 RHOINV(J)=1.E-5/RHO(J) CALL INTEG(RHOX,RHOINV,HEIGHT,NRHOX,0.) C CALL INTEG(RHOX,RHOINV,HEIGHT,NRHOX) RETURN END SUBROUTINE TURB IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw), 1 GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH, 2 IFCONV REAL*8 MIXLTH COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw) COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND, 1 IFTURB DO 10 J=1,NRHOX VTURB(J)=(TRBFDG*RHO(J)**TRBPOW+TRBSND*VELSND(J)/1.E5+TRBCON)*1.E5 10 PTURB(J)=RHO(J)*VTURB(J)**2*0.5 RETURN END