SUBROUTINE RDATA(ION) C ===================== C INCLUDE 'IMPLIC.FOR' INCLUDE 'BASICS.FOR' INCLUDE 'ATOMIC.FOR' INCLUDE 'MODELQ.FOR' INCLUDE 'ITERAT.FOR' INCLUDE 'ODFPAR.FOR' INCLUDE 'ALIPAR.FOR' COMMON/STRPAR/IMER,ITR,IC,IL,IP,NLASTE,NHOD,LASV COMMON/INUNIT/IUNIT common/imodlc/imodl0(mlevel) PARAMETER (T15=1.D-15) CHARACTER*1 A CHARACTER(len=100) :: DUM c ihydp0=0 IUNIT=21 OPEN(IUNIT,FILE=FIDATA(ION),STATUS='OLD') C C read the first record - a label for the energy level input C READ(IUNIT,501) A 501 FORMAT(A1) C C ----------------------------------------------------- C input parameters for explicit energy levels C ----------------------------------------------------- C DO IL=1,NLEVS(ION) I=IL+NFIRST(ION)-1 IE=IEL(I) N0I=NFIRST(IE) NKI=NNEXT(IE) IQ=I-N0I+1 X=IQ*IQ READ(IUNIT,*) * ENION(I),G(I),NQUANT(I),TYPLEV(I),ifwop(i),FRODF(I),IMODL(I) if(ifwop(i).lt.0.and.i.ne.nlast(ie)) * CALL QUIT('ifwop(i).lt.0.and.i.ne.nlast(ie)',i,nlast(ie)) imodl0(i)=imodl(i) E=ABS(ENION(I)) E0=E IF(E.EQ.0.) E0=EH*IZ(IE)*IZ(IE)/X IF(E.GT.1.D-7.AND.E.LT.100.) E0=1.6018D-12*E IF(E.GT.100..AND.E.LT.1.D7) E0=1.9857D-16*E IF(E.GT.1.D7) E0=H*E IF(ENION(I).GE.0.) THEN ENION(I)=E0 ELSE ENION(I)=-E0 END IF IF(G(I).EQ.0.) G(I)=2.D0*X IF(NQUANT(I).EQ.0) NQUANT(I)=IQ iltlev(i)=0 if(nquant(i).lt.0) then iltlev(i)=1 nquant(i)=iabs(nquant(i)) end if if(ispodf.eq.0 .and. ifwop(i).ge.2) ifwop(i)=0 if(ifwop(i).lt.0) then enion(i)=0. IMER=IMER+1 IMRG(I)=IMER IIMER(IMER)=I endif LBPFX = LBPFX .AND. IMODL(I).EQ.0 .AND. IIFIX(IATM(I)).EQ.0 if(imodl(i).gt.100) then iguide(i)=imodl(i)-100+NFIRST(ION)-1 imodl(i)=6 end if END DO c C ---------------------------------------------------------------------- C C skip lines if more levels than needed, and skip the continuum C transition label C 5 READ(IUNIT,501) A IF(A.NE.'*') GO TO 5 II0=NFIRST(ION)-1 ILLIM=NLLIM(ION)+II0 JCORR=0 JJCX=0 C C ----------------------------------------------------- C input parameters for continuum transitions C ----------------------------------------------------- C 10 CONTINUE READ(IUNIT,'(A100)',END=19) DUM READ(DUM,*,IOSTAT=KSTAT) II,JJ,MODE, * IFANCY,ICOLIS, * IFRQ0,IFRQ1,OSC,CPARAM,NCOL IF (KSTAT.NE.0) THEN READ(DUM,*,ERR=15) II,JJ,MODE, * IFANCY,ICOLIS, * IFRQ0,IFRQ1,OSC,CPARAM NCOL=0 END IF IFFR0=0 IF(IABS(MODE).GT.100) THEN IF(MODE.GT.0) MODE=MODE-100 IF(MODE.LT.0) MODE=MODE+100 IFFR0=1 READ(IUNIT,*) FR0INP IF(FR0INP.LT.1.E10) FR0INP=2.997925D18/FR0INP END IF ITR=ITR+1 C IF(JJ.LT.1000) THEN IF(II.EQ.1 .OR. JJCX.EQ.1) JCORR=NLEVS(ION)+1-JJ II=II+II0 JJ=JJ+II0+JCORR ELSE II=II+II0 JJCX=1 END IF ILOW(ITR)=II IUP(ITR)=JJ INDEXP(ITR)=MODE OSC0(ITR)=OSC ICOL(ITR)=ICOLIS CPAR(ITR)=CPARAM LALI(ITR)=.FALSE. LEXP(ITR)=.FALSE. FR0PCI=0. IF(IABS(MODE).EQ.5 .OR. IABS(MODE).EQ.15) THEN READ(IUNIT,*) FR0PCI if(ion.eq.ielh) then if(ii.eq.1.and.cutlym.ne.0) fr0pci=cutlym if(ii.eq.2.and.cutbal.ne.0) fr0pci=cutbal end if IF(FR0PCI.LT.1.E10) FR0PCI=2.997925D18/FR0PCI END IF FR0PC(ITR)=FR0PCI INDEXP(ITR)=MODE IC=IC+1 NTRANC=IC if(ifancy.eq.15) then ibf(ic)=ifancy itrbf(ic)=itr call rdatax(itr,ic,IUNIT) go to 10 end if IF(ITRA(II,JJ).EQ.0) THEN ITRA(II,JJ)=ITR ELSE ICOL(ITR)=99 END IF IE=IEL(II) N0I=NFIRST(IE) NKI=NNEXT(IE) LINE(ITR)=.FALSE. IFC0(ITR)=IFRQ0 IFC1(ITR)=IFRQ1 FR0(ITR)=(ENION(II)-ENION(JJ)+ENION(NKI))/H IF(IFFR0.EQ.1) FR0(ITR)=FR0INP C C ----------------------------------------------------- C Additional input parameters for continuum transitions C ----------------------------------------------------- C C Only for IFANCY = 2, 3, or 4 C S0, ALF, BET, GAM - parameters for evaluation the C photoionization cross-section C NTRANC=IC IF(IFANCY.GE.2.AND.IFANCY.LE.4) THEN READ(IUNIT,*) S0CS(IC),ALFCS(IC),BETCS(IC),GAMCS(IC) ELSE IF(IFANCY.EQ.6) THEN READ(IUNIT,*) (CTOP(IFIT,IC),IFIT=1,6) END IF C C ----------------------------------------------------- C Additional input parameters for continuum transitions -TOPBASE DATA C ----------------------------------------------------- C C Only for IFANCY > 100 there are IFANCY-100 fit points C C XTOP(MFIT,MCROSS) - x = alog10(nu/nu0) of a fit point C CTOP(MFIT,MCROSS) - sigma = alog10(sigma/10^-18) of a fit point C C there are IFANCY-100 fit points C IF(IFANCY.GT.100) THEN NFIT=IFANCY-100 IF(NFIT.GT.MFIT) CALL QUIT('nfit.gt.mfit',nfit,mfit) READ(IUNIT,*) (XTOP(IFIT,IC),IFIT=1,NFIT) READ(IUNIT,*) (CTOP(IFIT,IC),IFIT=1,NFIT) END IF C C ----------------------------------------------- C Additional input parameters for continuum transitions -COLLISIONAL DATA C ---------------------------------------------- IF (NCOL.NE.0) THEN DUM1=0 DO IIC=1,NCOL READ(IUNIT,*) ITYPE, NCTEMP IF (ITYPE.GT.MXTCOL) CALL QUIT('itype.gt.mxtcol',ITYPE,MXTCOL) READ(IUNIT,*) (CTEMP(ITYPE,IFIT,ITR),IFIT=1,NCTEMP) READ(IUNIT,*) (CRATE(ITYPE,IFIT,ITR),IFIT=1,NCTEMP) DUM1=DUM1+2**(ITYPE-1) idum1=ifix(real(dum1)) END DO IF (ICOL(ITR).EQ.99) GO TO 10 IF (MOD(DUM1,TWO).EQ.1.and.ICOL(ITR).lt.10) THEN c IN ORDER TO KEEP THE INFO FOR ELECTRON COLLISIONS FROM ICOL ICOL(ITR)=1000*iDUM1 ELSE IF (ICOL(ITR).LT.0) THEN ICOL(ITR)=-1000*iDUM1+ICOL(ITR)-1 ELSE ICOL(ITR)=1000*iDUM1+ICOL(ITR)+1 ENDIF END IF c END IF C IBF(IC)=IFANCY if(ifancy.gt.49.and.ifancy.lt.100) lasv=.true. ITRA(JJ,II)=IC ITRBF(IC)=ITR ITRCON(ITR)=IC IF(FR0(ITR).GT.0.) THEN ALAM=2.997925D18/FR0(ITR) ELSE ALAM=0. END IF C if(icolis.eq.0.and.ifancy.le.1.and.osc.eq.0.) then zz=iz(iel(ii)) xq=nquant(ii) if(fr0(itr).gt.0..and.xq.gt.0.) * sig0=2.815d-20*zz*zz/(fr0(itr)*1.d-16)**3/xq**5 if(zz.gt.1.9) sig0=sig0*2. if(zz.gt.2.9) sig0=sig0*1.5 osc0(itr)=sig0 end if C IF(II.LT.NLAST(ION)) GO TO 10 15 READ(IUNIT,501,end=19,err=19) A IF(A.NE.'*') GO TO 15 C C ----------------------------------------------------------- C Input parameters for line transitions C ----------------------------------------------------------- C 19 CONTINUE IIP=0 JJP=0 20 CONTINUE READ(IUNIT,'(A100)',END=30) DUM READ(DUM,*,IOSTAT=KSTAT) II,JJ,MODE,IFANCY,ICOLIS, * IFRQ0,IFRQ1,OSC,CPARAM,NCOL IF (KSTAT.NE.0) THEN READ(DUM,*,END=30,ERR=30) II,JJ,MODE,IFANCY, * ICOLIS,IFRQ0,IFRQ1,OSC,CPARAM NCOL=0 END IF IF(ISPODF.GE.1) THEN INDXPA=IABS(MODE) LIJP=II.EQ.IIP .AND. JJ.EQ.JJP LOD34=INDXPA.EQ.3 .OR. INDXPA.EQ.4 IF(LIJP .AND. LOD34) THEN IF (NCOL.NE.0) GO TO 29 GO TO 20 ENDIF IIP=II JJP=JJ END IF IFFR0=0 IF(IABS(MODE).GT.100) THEN IF(MODE.GT.0) MODE=MODE-100 IF(MODE.LT.0) MODE=MODE+100 IFFR0=1 READ(IUNIT,*) FR0INP IF(FR0INP.LT.1.E10) FR0INP=2.997925D18/FR0INP END IF IF(JJ.GT.NLEVS(ION)) THEN IF(IABS(MODE).EQ.2) THEN READ(IUNIT,*) K1,K2,K3,X1,X2,X3,K4 IF (NCOL.NE.0) GO TO 29 GO TO 20 END IF IF(IABS(MODE).EQ.1) READ(IUNIT,*) LCMP IF(IABS(IFANCY).EQ.1) READ(IUNIT,*) GAMRL IF (NCOL.NE.0) GO TO 29 GO TO 20 END IF ITR=ITR+1 II=II+II0 JJ=JJ+II0 ILOW(ITR)=II IUP(ITR)=JJ INDEXP(ITR)=MODE OSC0(ITR)=OSC ICOL(ITR)=ICOLIS CPAR(ITR)=CPARAM LALI(ITR)=.FALSE. LEXP(ITR)=.FALSE. IFC0(ITR)=IFRQ0 IFC1(ITR)=IFRQ1 ITRCON(ITR)=0 IF(ITRA(II,JJ).EQ.0) THEN ITRA(II,JJ)=ITR ELSE ICOL(ITR)=99 END IF IE=IEL(II) N0I=NFIRST(IE) NKI=NNEXT(IE) LINE(ITR)=.TRUE. IFR0(ITR)=IFRQ0 IFR1(ITR)=IFRQ1 FR0(ITR)=(ENION(II)-ENION(JJ))/H IF(IFFR0.EQ.1) FR0(ITR)=FR0INP c write(6,632) itr,ilow(itr),iup(itr),ifr0(itr),ifr1(itr) c 632 format(' itr ',5i8) IF(OSC.EQ.0..and.nquant(ii).le.20.and.nquant(jj).le.20) THEN IF(MODE.NE.3.AND.MODE.NE.4) THEN GH=2.D0*NQUANT(II)*NQUANT(II) OSC0(ITR)=OSH(NQUANT(II),NQUANT(JJ))*G(II)/GH ENDIF IF(ifwop(jj).lt.0) THEN OSC0(ITR)=0. JJ0=NQUANT(JJ-1) J20=MIN(20,NLMX) IF(J20.GE.JJ0) THEN DO JTR=JJ0,J20 OSC0(ITR)=OSC0(ITR)+OSH(NQUANT(II),JTR) END DO END IF IF(NLMX.GT.20) THEN XII=NQUANT(II)*NQUANT(II) SUF=0. DO JTR=21,NLMX XJ=JTR XJJ=XJ*XJ XJTR=XJ/(XJJ-XII) SUF=SUF+XJTR*XJTR*XJTR END DO XITR=(400.-XII)/20. OSC0(ITR)=OSC0(ITR)+OSH(NQUANT(II),20)*SUF*XITR*XITR*XITR END IF END IF END IF C IF(FR0(ITR).GT.0.) THEN ALAM=2.997925D18/FR0(ITR) ELSE ALAM=0. END IF IF(MODE.EQ.0) THEN IF (NCOL.NE.0) GO TO 29 GO TO 20 END IF IF(IABS(MODE).EQ.2) GO TO 25 C C change the status of treatment of superlines, C if specified in the "offset-setting" record, or C because of too loo or too high frequency C IF(IABS(MODE).EQ.3.OR.IABS(MODE).EQ.4) THEN IF(II.LT.ILLIM.OR.FR0(ITR).LE.FRLMIN.OR. * FR0(ITR).GE.FRLMAX) INDEXP(ITR)=0 IF (NCOL.NE.0) GO TO 29 GO TO 20 END IF C C ----------------------------------------------------------- C Additional input parameters for "clasical" line transitions C (i.e. those not represented by ODF's - ie ABS(MODE)=1) C ----------------------------------------------------------- C C LCOMP - mode of considering absorption profile: C = false - depth-independent profile C = true - depth-dependent profile C INTMOD - mode of evaluating frequency points in the line C = 0 - means that frequency points and weights have C already been read amongst the NJREAD or NFREAD C frequencies; C ne 0 - frequency points and weights will be evaluated: C the meaning of the individual values: C = 1 - equidistant frequencies, trapezoidal integration C = 2 - equidistant frequencies, Simpson integration C = 3 - modified Simpson integration C 3-point Simpson integrations with each subsequent C integration interval doubled, until the whole C integration area is covered C = 4 - frequencies (in units of standard x) and weights C (for integration over x) are read; C C NF - number of frequency points in the line C (has the meaning only for INTMOD ne 0) C C XMAX = 0 - program sets up default XMAX=4.55 C > 0 - means that the line is assumed symmetric around the C center, frequency points are set up between x=0 and C x=XMAX, where x is frequency difference from the C line center in units of the standard Doppler width C (standard Doppler width is the Doppler width C calculated with standard temperature TSTD and C standard turbulent velocity VTB); C < 0 - frequency points are set between x=XMAX and x=-XMAX C C IMPORTANT NOTE: all lines are C set by default to the full-profile mode. Thefore, if XMAX was C positive, it is reset to XMAX --> -XMAX, and NF --> 2*NF - 1 C C TSTD > 0 - standard temperature (see above); C = 0 - the program assigns for the standard temperature the C default value TSTD = 0.75*TEFF C READ(IUNIT,*) LCOMP(ITR),INTMOD(ITR),NF,XMAX,TSTD IPROF(ITR)=IFANCY IF(IABS(IPROF(ITR)).EQ.1) THEN IP=IP+1 if(ip.gt.mvoigt) CALL QUIT('ip.gt.mvoigt',ip,mvoigt) ITRA(JJ,II)=IP END IF if(ion.eq.ielh) then if(ihydpr.eq.1) then if(nquant(ii).le.4.and.nquant(jj).lt.20) iprof(itr)=3 else if(ihydpr.eq.2) then if(nquant(ii).le.2.and.nquant(jj).le.10) iprof(itr)=4 end if if(iprof(itr).eq.3) ihydp0=1 if(iprof(itr).eq.4) ihydp0=2 end if C C if Voigt profile is assumed (ie. if IPROF = 1), an additional C input record is required which specifies an evaluation of the C relevant damping parameter - see procedure DOPGAM) C C GAMR - for > 0 - has the meaning of natural damping C parameter (=Einstein coefficient for C spontaneous emission) C = 0 - classical natural damping assumed C < 0 - damping is given by a non-standard, C user supplied procedure GAMSP C STARK1 - = 0 - Stark broadening neglected C < 0 - scaled classical expression C (ie gam = -STARK1 * classical Stark) C > 0 - Stark broadening given by C n(el)*[STARK1*T**STARK2 + STARK3] C STARK2, STARK3 - see above C VDWH - .le.0 - Van der Waals broadening neglected C > 0 - scaled classical expression C IF(IABS(IPROF(ITR)).EQ.1) THEN READ(IUNIT,*) GAMAR(IP),STARK1(IP),STARK2(IP),STARK3(IP), * VDWH(IP) IF(GAMAR(IP).GT.0..AND.GAMAR(IP).LT.10.) * GAMAR(IP)=EXP(2.3025851*GAMAR(IP)) IF(STARK1(IP).LT.0.) STARK1(IP)=EXP(2.3025851*STARK1(IP)) END IF c c set the profile coefficient for lines to IPROF=1 (Voigt) profile c if it was not set before, and for IOPTAB=1 c IF(IOPTAB.GT.0.AND.IPROF(ITR).EQ.1) THEN if(nf.lt.25) nf=25 if(xmax.lt.4000.) xmax=4000. END IF C IF(IOPTAB.GT.0.AND.IPROF(ITR).EQ.0.AND.ION.NE.IELH) THEN IPROF(ITR)=1 IP=IP+1 if(ip.gt.mvoigt) CALL QUIT('ip.gt.mvoigt',ip,mvoigt) ITRA(JJ,II)=IP GAMAR(IP)=0. STARK1(IP)=0. VDWH(IP)=1. LCOMP=.TRUE. INTMOD(ITR)=3 if(ii.eq.ii0+1) then if(nf.lt.25) nf=25 if(xmax.lt.4000.) xmax=4000. else if(ii.le.ii0+3) then if(nf.lt.21) nf=21 if(xmax.lt.1000.) xmax=2000. else if(ii.le.ii0+5) then if(nf.lt.17) nf=17 if(xmax.lt.300.) xmax=600. else if(ii.le.ii0+10) then if(nf.lt.13) nf=13 if(xmax.lt.100.) xmax=200. else if(nf.lt.9) nf=9 if(xmax.lt.30.) xmax=60. end if END IF C C change the status of treatment of lines, in virtue of: C a) too low frequency (FRLMIN); or C b) if specified in the "offset-setting" record C IF(II.LT.ILLIM.OR.FR0(ITR).LE.FRLMIN.OR.FR0(ITR).GE.FRLMAX) THEN INDEXP(ITR)=0 IF (NCOL.NE.0) GO TO 29 GO TO 20 END IF C IF(TSTD.EQ.0.) TSTD=0.75*TEFF IF(XMAX.EQ.0.) XMAX=4.55 if(xmax.gt.0.) then xmax=-xmax nf=2*nf-1 end if CALL DOPGAM(ITR,1,TSTD,DOP,AGAM) INTM=INTMOD(ITR) IF(INTM.NE.0) IFR0(ITR)=NLASTE+1 IF(INTM.NE.0) IFR1(ITR)=NLASTE+NF IF(INTM.NE.0) NLASTE=IFR1(ITR) CALL LINSET(ITR,IUNIT,IFRQ0,IFRQ1,XMAX,DOP,AGAM) c write(6,631) itr,ilow(itr),iup(itr),ifr0(itr),ifr1(itr), c * 2.997925e18/freq(ifr0(itr)),2.997925e18/freq(ifr1(itr)) c 631 format(i6,2i5,2i7,2f10.1) IF (NCOL.NE.0) GO TO 29 GO TO 20 C C ----------------------------------------------------------- C Additional input parameters for a "merged superline" transition C (i.e. transition to a merged level, treated by means of an ODF C - i.e. for ABS(MODE)=2) C ----------------------------------------------------------- C C KDO(1),KDO(2),KDO(3),XDO(1),XDO(2),XDO(3),KDO(4) - C have the following meaning: C The superline is represented by four frequency intervals. C Going away from the peak of ODF, the first interval is c represented by a KDO(1)-point Simpson integration, with a C distance XDO(1) fiducial Doppler widths between the points. C The same for the second and third interval. C The rest (the interval between the last point and the C coresponding edge) is represented by a KDO(4)-point C Simpson integration. C The fiducial Doppler width is that corresponding to the C effective temperature and the standard turbulent velocity. C 25 NHOD=NHOD+1 if(ifwop(jj).ge.0) CALL QUIT('ifwop(jj).ge.0',ifwop(jj),jj) READ(IUNIT,*) (KDO(IHI,NHOD),IHI=1,3),(XDO(IHI,NHOD),IHI=1,3), * KDO(4,NHOD) C C again, change status of treatment of lines if required C IF(II.LT.ILLIM.OR.FR0(ITR).LE.FRLMIN.OR.FR0(ITR).GE.FRLMAX) THEN INDEXP(ITR)=0 IF (NCOL.NE.0) GO TO 29 GO TO 20 END IF JNDODF(ITR)=NHOD C ---------------------------------------------- C Additional input parameters for spectral lines - COLLISIONAL DATA C ---------------------------------------------- 29 CONTINUE IF (NCOL.NE.0) THEN DUM1=0 DO IIC=1,NCOL READ(IUNIT,*) ITYPE, NCTEMP IF (ITYPE.GT.MXTCOL) CALL QUIT('itype.gt.mxtcol',ITYPE,MXTCOL) READ(IUNIT,*) (CTEMP(ITYPE,IFIT,ITR),IFIT=1,NCTEMP) READ(IUNIT,*) (CRATE(ITYPE,IFIT,ITR),IFIT=1,NCTEMP) DUM1=DUM1+2**(ITYPE-1) idum1=ifix(real(dum1)) END DO IF (MOD(DUM1,TWO).EQ.1) THEN ICOL(ITR)=1000*iDUM1 ELSE IF (ICOL(ITR).LT.0) THEN ICOL(ITR)=-1000*iDUM1+ICOL(ITR)-1 ELSE ICOL(ITR)=1000*iDUM1+ICOL(ITR)+1 ENDIF ENDIF ENDIF IF(II.LT.NLAST(ION)) GO TO 20 30 CONTINUE C C ----------------------------------------------------------- C Additional input parameters for iron-peak superlevels: C Energy bands (only read in sampling mode!) C ----------------------------------------------------------- C IF(ISPODF.EQ.1 .AND. INODF1(ION).GT.0) THEN READ(IUNIT,*,ERR=50,END=50) NEVKU(ION) DO I=1,NEVKU(ION) READ(IUNIT,*,ERR=50,END=50) XEV(I,ION) END DO READ(IUNIT,*,ERR=50,END=50) NODKU(ION) DO I=1,NODKU(ION) READ(IUNIT,*,ERR=50,END=50) XOD(I,ION) END DO IF(NEVKU(ION).GT.MLEVEL) * CALL QUIT('NEVKU(ION).GT.MLEVEL',NEVKU(ION),MLEVEL) IF(NODKU(ION).GT.MLEVEL) * CALL QUIT('NODKU(ION).GT.MLEVEL',NODKU(ION),MLEVEL) END IF C CLOSE(IUNIT) if(itr.gt.mtrans) CALL QUIT('ntrans.gt.mtrans',itr,mtrans) c c initialization of Lemke hydrogen line broadening tables, if needed c if(ion.eq.ielh) then if(ihydp0.eq.1) ihydpr=21 if(ihydpr.eq.2) ihydpr=22 if(ihydp0.gt.0) then call lemini call xenini end if end if c RETURN 50 CALL QUIT(' Missing data for iron superlevels',0,0) END