629 lines
20 KiB
Fortran
629 lines
20 KiB
Fortran
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
|