473 lines
14 KiB
Fortran
473 lines
14 KiB
Fortran
SUBROUTINE RDATA(ION)
|
|
C =====================
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
PARAMETER (WI1=911.753578, WI2=227.837832)
|
|
PARAMETER (T15=1.D-15)
|
|
PARAMETER (ECONST= 5.03411142E15)
|
|
PARAMETER (MCFIT=10)
|
|
CHARACTER*10 TYPLEV(MLEVEL)
|
|
CHARACTER*40 FIDATA(MION),FIODF1(MION),FIODF2(MION),FIBFCS(MION)
|
|
CHARACTER*1 A
|
|
CHARACTER*1000 CADENA
|
|
CHARACTER(len=100) :: DUM
|
|
COMMON/IONDAT/IATI(MION),IZI(MION),NLEVS(MION),NLLIM(MION)
|
|
COMMON/IONFIL/FIDATA,FIODF1,FIODF2,FIBFCS
|
|
COMMON/TOPCS/CTOP(MFIT,MCROSS), !sigma=alog10(sigma/10^-18) of fit point
|
|
* XTOP(MFIT,MCROSS) ! x = alog10(nu/nu0) of fit point
|
|
COMMON/PRINTP/TYPLEV
|
|
COMMON/INUNIT/IUNIT
|
|
COMMON/STRPAR/IMER,ITR,IC,IL,IP,NLASTE,NHOD
|
|
common/dissol/fropc(mlevel),indexp(mlevel)
|
|
common/quasex/iexpl(mlevel),iltot(mlevel)
|
|
dimension CTEMP(MCFIT),CRATE(MCFIT)
|
|
|
|
data iexp0/0/
|
|
C
|
|
c IUNIT=IUNIT+1
|
|
IUNIT=94
|
|
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
|
|
C If ILIMITS(ION) < 0, the program finds out whether energy and
|
|
C quantum numbers are included in the input data files
|
|
|
|
IF (ILIMITS(ION).LT.0) THEN
|
|
READ(IUNIT,'(1000A)')CADENA
|
|
BACKSPACE(IUNIT)
|
|
CALL COUNT_WORDS(CADENA,NOW)
|
|
IF (NOW.LT.14) THEN
|
|
ILIMITS(ION)=0
|
|
ELSE
|
|
ILIMITS(ION)=1
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C Standard format: ENION(I),G(I),NQUANT(I),TYPLEV(I),ifwop(i)
|
|
|
|
IF (ILIMITS(ION).EQ.0) THEN
|
|
C
|
|
DO IL=1,NLEVS(ION)
|
|
I=IL+NFIRST(ION)-1
|
|
IE=IEL(I)
|
|
N0I=NFIRST(IE)
|
|
NKI=NNEXT(IE)
|
|
ia=numat(iatm(n0i))
|
|
if(isemex(ia).le.1) then
|
|
iexp0=iexp0+1
|
|
iexpl(i)=iexp0
|
|
iltot(iexp0)=i
|
|
c write(6,671) il,i,ia,ion,isemex(ia),iexp0,iltot(iexp0)
|
|
if(il.eq.nlevs(ion)) then
|
|
if(nki.eq.nka(iatm(i))) then
|
|
iexp0=iexp0+1
|
|
iexpl(nki)=iexp0
|
|
iltot(iexp0)=nki
|
|
c write(6,671) il+1,nki,ia,ion,isemex(ia),iexp0,iltot(iexp0)
|
|
end if
|
|
end if
|
|
c 671 format('il,i,ia,ion,isem,iexp,iltot',7i4)
|
|
end if
|
|
IQ=I-N0I+1
|
|
X=IQ*IQ
|
|
ifwop(i)=0
|
|
IZZ=IZ(IE)
|
|
READ(IUNIT,*)
|
|
* ENION(I),G(I),NQUANT(I),TYPLEV(I),ifwop(i)
|
|
if(ifwop(i).lt.0.and.i.ne.nlast(ie))
|
|
* call quit('conflict in negative ifwop')
|
|
if(ifwop(i).ge.2) ifwop(i)=0
|
|
IF(I.LT.NKI) THEN
|
|
E=ENION(I)
|
|
E0=E
|
|
IF(E.LT.0.) THEN
|
|
E=-E
|
|
E0=E
|
|
END IF
|
|
IF(E.EQ.0.) THEN
|
|
c if(izz.le.2) then
|
|
if(izz.le.-2) then
|
|
w0=wi1
|
|
if(izz.eq.2) w0=wi2
|
|
WL0=W0*X
|
|
IF(WL0.GT.2000.) THEN
|
|
ALM=1.E8/(WL0*WL0)
|
|
XN1=64.328+29498.1/(146.-ALM)+255.4/(41.-ALM)
|
|
WL0=WL0/(XN1*1.D-6+1.D0)
|
|
END IF
|
|
E0=H*CL*1.D8/WL0
|
|
else
|
|
E0=EH*IZZ*IZZ/X
|
|
end if
|
|
END IF
|
|
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
|
|
ENDIF
|
|
IF(G(I).EQ.0.) G(I)=2.D0*X
|
|
IF(NQUANT(I).EQ.0) NQUANT(I)=IQ
|
|
ELSE
|
|
c if(modref.ge.0) nref(iatm(i))=nka(iatm(i))
|
|
IF(G(I).EQ.0..AND.NKI.EQ.NKA(IATM(I))) G(I)=1.
|
|
END IF
|
|
if(ifwop(i).lt.0) then
|
|
enion(i)=0.
|
|
ff(ie)=0.
|
|
IMER=IMER+1
|
|
IMRG(I)=IMER
|
|
IIMER(IMER)=I
|
|
endif
|
|
fropc(i)=0.
|
|
END DO
|
|
|
|
C Upgraded format including limits for energies, and quantum numbers
|
|
|
|
ELSE
|
|
|
|
DO IL=1,NLEVS(ION)
|
|
I=IL+NFIRST(ION)-1
|
|
IE=IEL(I)
|
|
N0I=NFIRST(IE)
|
|
NKI=NNEXT(IE)
|
|
ia=numat(iatm(n0i))
|
|
if(isemex(ia).le.1) then
|
|
iexp0=iexp0+1
|
|
iexpl(i)=iexp0
|
|
iltot(iexp0)=i
|
|
if(il.eq.nlevs(ion)) then
|
|
if(nki.eq.nka(iatm(i))) then
|
|
iexp0=iexp0+1
|
|
iexpl(nki)=iexp0
|
|
iltot(iexp0)=nki
|
|
end if
|
|
end if
|
|
end if
|
|
IQ=I-N0I+1
|
|
X=IQ*IQ
|
|
ifwop(i)=0
|
|
IZZ=IZ(IE)
|
|
READ(IUNIT,*)
|
|
* ENION(I),G(I),NQUANT(I),TYPLEV(I),ifwop(i),frdodf,imodl,
|
|
* ENION1(I),ENION2(I),
|
|
* SQUANT1(I),SQUANT2(I),
|
|
* LQUANT1(I),LQUANT2(I),
|
|
* PQUANT1(I),PQUANT2(I)
|
|
if(ifwop(i).lt.0.and.i.ne.nlast(ie))
|
|
* call quit('conflict in negative ifwop')
|
|
if(ifwop(i).ge.2) ifwop(i)=0
|
|
IF(I.LT.NKI) THEN
|
|
|
|
C check and, if necessary, transform ENION(I)
|
|
|
|
E=ENION(I)
|
|
E0=E
|
|
IF(E.LT.0.) THEN
|
|
E=-E
|
|
E0=E
|
|
END IF
|
|
IF(E.EQ.0.) THEN
|
|
c if(izz.le.2) then
|
|
if(izz.le.-2) then
|
|
w0=wi1
|
|
if(izz.eq.2) w0=wi2
|
|
WL0=W0*X
|
|
IF(WL0.GT.2000.) THEN
|
|
ALM=1.E8/(WL0*WL0)
|
|
XN1=64.328+29498.1/(146.-ALM)+255.4/(41.-ALM)
|
|
WL0=WL0/(XN1*1.D-6+1.D0)
|
|
END IF
|
|
E0=H*CL*1.D8/WL0
|
|
else
|
|
E0=EH*IZZ*IZZ/X
|
|
end if
|
|
END IF
|
|
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
|
|
ENDIF
|
|
|
|
C check and, if necessary, transform ENION1(I)
|
|
|
|
E=ENION1(I)
|
|
E0=E
|
|
IF(E.LT.0.) THEN
|
|
E=-E
|
|
E0=E
|
|
END IF
|
|
IF(E.EQ.0.) THEN
|
|
c if(izz.le.2) then
|
|
if(izz.le.-2) then
|
|
w0=wi1
|
|
if(izz.eq.2) w0=wi2
|
|
WL0=W0*X
|
|
IF(WL0.GT.2000.) THEN
|
|
ALM=1.E8/(WL0*WL0)
|
|
XN1=64.328+29498.1/(146.-ALM)+255.4/(41.-ALM)
|
|
WL0=WL0/(XN1*1.D-6+1.D0)
|
|
END IF
|
|
E0=H*CL*1.D8/WL0
|
|
else
|
|
E0=EH*IZZ*IZZ/X
|
|
end if
|
|
END IF
|
|
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(ENION1(I).GE.0.) THEN
|
|
ENION1(I)=E0
|
|
ELSE
|
|
ENION1(I)=-E0
|
|
ENDIF
|
|
|
|
C check and, if necessary, transform ENION2(I)
|
|
|
|
E=ENION2(I)
|
|
E0=E
|
|
IF(E.LT.0.) THEN
|
|
E=-E
|
|
E0=E
|
|
END IF
|
|
IF(E.EQ.0.) THEN
|
|
c if(izz.le.2) then
|
|
if(izz.le.-2) then
|
|
w0=wi1
|
|
if(izz.eq.2) w0=wi2
|
|
WL0=W0*X
|
|
IF(WL0.GT.2000.) THEN
|
|
ALM=1.E8/(WL0*WL0)
|
|
XN1=64.328+29498.1/(146.-ALM)+255.4/(41.-ALM)
|
|
WL0=WL0/(XN1*1.D-6+1.D0)
|
|
END IF
|
|
E0=H*CL*1.D8/WL0
|
|
else
|
|
E0=EH*IZZ*IZZ/X
|
|
end if
|
|
END IF
|
|
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(ENION2(I).GE.0.) THEN
|
|
ENION2(I)=E0
|
|
ELSE
|
|
ENION2(I)=-E0
|
|
ENDIF
|
|
|
|
C
|
|
C Enforce an energy tolerance of 10% when the input files
|
|
C do not have any (e.g. pure levels in MODION models)
|
|
C
|
|
IF((ENION1(I)-ENION(I))/ENION(I).LT.1e-6)
|
|
* ENION1(I)=ENION(I)*(1.+ERANGE)
|
|
IF((ENION(I)-ENION2(I))/ENION(I).LT.1e-6)
|
|
* ENION2(I)=ENION(I)*(1.-ERANGE)
|
|
|
|
C
|
|
C Convert ENION1,ENION2 to cm-1 from the ground level
|
|
C so they can be directly used in NLTSET
|
|
C
|
|
|
|
ENION1(I)=(ENION(N0I)-ENION1(I))*ECONST
|
|
ENION2(I)=(ENION(N0I)-ENION2(I))*ECONST
|
|
|
|
|
|
IF(G(I).EQ.0.) G(I)=2.D0*X
|
|
IF(NQUANT(I).EQ.0) NQUANT(I)=IQ
|
|
ELSE
|
|
c if(modref.ge.0) nref(iatm(i))=nka(iatm(i))
|
|
IF(G(I).EQ.0..AND.NKI.EQ.NKA(IATM(I))) G(I)=1.
|
|
END IF
|
|
if(ifwop(i).lt.0) then
|
|
write(*,*)'RDATA: IFWOP<0 and ILIMITS is not 0'
|
|
stop
|
|
enion(i)=0.
|
|
ff(ie)=0.
|
|
IMER=IMER+1
|
|
IMRG(I)=IMER
|
|
IIMER(IMER)=I
|
|
endif
|
|
fropc(i)=0.
|
|
END DO
|
|
|
|
END IF
|
|
|
|
c
|
|
C ----------------------------------------------------------------------
|
|
C
|
|
C skip lines if more levels than needed, and skip the continuum transition
|
|
C label
|
|
C
|
|
5 READ(IUNIT,501) A
|
|
IF(A.NE.'*') GO TO 5
|
|
II0=NFIRST(ION)-1
|
|
ILLIM=NLLIM(ION)+II0
|
|
JCORR=0
|
|
C
|
|
C -----------------------------------------------------
|
|
C input parameters for continuum transitions
|
|
C -----------------------------------------------------
|
|
C
|
|
10 CONTINUE
|
|
c READ(IUNIT,*,END=20,ERR=15) II,JJ,MODE,IFANCY,ICOLIS,
|
|
c * IFRQ0,IFRQ1,OSC,CPARAM
|
|
READ(IUNIT,'(A100)',END=20) 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
|
|
IF (NCOL.NE.0) THEN
|
|
DO IIC=1,NCOL
|
|
READ(IUNIT,*) ITYPE, NCTEMP
|
|
READ(IUNIT,*) (CTEMP(IFIT),IFIT=1,NCTEMP)
|
|
READ(IUNIT,*) (CRATE(IFIT),IFIT=1,NCTEMP)
|
|
END DO
|
|
END IF
|
|
c
|
|
IF(II.EQ.0) THEN
|
|
IF(JJ.EQ.0) GO TO 30
|
|
II0=JJ-1
|
|
GO TO 10
|
|
END IF
|
|
IF(IABS(MODE).GT.100) READ(IUNIT,*) FR0INP
|
|
if(iabs(mode).eq.2) then
|
|
READ(IUNIT,*) kdo
|
|
go to 10
|
|
end if
|
|
IF(IFANCY.GT.49.and.ifancy.lt.100) IASV=1
|
|
if(iabs(mode).eq.3.or.iabs(mode).eq.4) go to 10
|
|
IF(IABS(MODE).EQ.5 .OR. IABS(MODE).EQ.15) THEN
|
|
READ(IUNIT,*) FROPCI
|
|
if(ion.eq.ielh) then
|
|
if(ii.eq.1.and.cutlym.ne.0) fropci=-cutlym
|
|
if(ii.eq.2.and.cutbal.ne.0) fropci=-cutbal
|
|
end if
|
|
if(abs(fropci).lt.1.e10) fropci=2.997925e18/fropci
|
|
END IF
|
|
IF(II.EQ.1) JCORR=NLEVS(ION)+1-JJ
|
|
II=II+II0
|
|
JJ=JJ+II0+JCORR
|
|
FROPC(II)=FROPCI
|
|
N0I=NFIRST(IE)
|
|
NKI=NNEXT(IE)
|
|
IF(JJ.GE.NKI) THEN
|
|
LPC=.FALSE.
|
|
IF(IELHE2.GE.0) THEN
|
|
IF(II.GE.NFIRST(IELHE2).AND.II.LE.NLAST(IELHE2)
|
|
* .AND.IFWOP(II).GE.0) LPC=.TRUE.
|
|
END IF
|
|
IF(II.GE.N0HN.AND.II.LE.N1H.AND.IFWOP(II).GE.0) LPC=.TRUE.
|
|
IF(LPC) THEN
|
|
MODE=5
|
|
XI=NQUANT(II)
|
|
X2=XI+3.
|
|
if(ii.ge.8) x2=xi+2.
|
|
IF(FROPC(II).GE.0.) THEN
|
|
FROPC(II)=ENION(II)/6.6256E-27*(1.-XI*XI/(X2*X2))
|
|
ELSE
|
|
FROPC(II)=ABS(FROPC(II))
|
|
END IF
|
|
c write(6,671) ii,fropc(ii),enion(ii)/h,2.997925e18/fropc(ii)
|
|
c 671 format(i4,1p2e13.5,0pf10.1)
|
|
END IF
|
|
END IF
|
|
IF(MODE.EQ.0) THEN
|
|
IF(II.LT.NLAST(ION)) GO TO 10
|
|
IF(II.EQ.NLAST(ION)) GO TO 15
|
|
END IF
|
|
C
|
|
C -----------------------------------------------------
|
|
C Additional input parameters for continuum transitions
|
|
C -----------------------------------------------------
|
|
C
|
|
C Only for IFANCY = 2, 3, or 4
|
|
C S0BF, ALFBF, BETBF, GAMBF - parameters for evaluation the
|
|
C photoionization cross-section
|
|
C
|
|
IF(IFANCY.GE.2.AND.IFANCY.LE.4)
|
|
* READ(IUNIT,*) S0BF(II),ALFBF(II),BETBF(II),GAMBF(II)
|
|
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 too large (TOPBASE fits)')
|
|
READ(IUNIT,*) (XTOP(IFIT,II),IFIT=1,NFIT)
|
|
READ(IUNIT,*) (CTOP(IFIT,II),IFIT=1,NFIT)
|
|
END IF
|
|
IBF(II)=IFANCY
|
|
INDEXP(II)=IABS(MODE)
|
|
IF(II.LT.NLAST(ION)) GO TO 10
|
|
15 READ(IUNIT,501) A
|
|
IF(A.NE.'*') GO TO 15
|
|
C
|
|
C -----------------------------------------------------------
|
|
C Input parameters for line transitions
|
|
C -----------------------------------------------------------
|
|
C
|
|
20 CONTINUE
|
|
READ(IUNIT,*,END=30,ERR=30) II,JJ,MODE,IFANCY,ICOLIS,
|
|
* IFRQ0,IFRQ1,OSC,CPARAM
|
|
IF(IABS(MODE).GT.100) READ(IUNIT,*) FR0INP
|
|
IF(JJ.GT.NLEVS(ION)) THEN
|
|
IF(IABS(MODE).EQ.2) THEN
|
|
READ(IUNIT,*) K1,K2,K3,X1,X2,X3,K4
|
|
GO TO 20
|
|
END IF
|
|
IF(IABS(MODE).EQ.1) READ(IUNIT,*) LCMP
|
|
IF(IABS(IFANCY).EQ.1) READ(IUNIT,*) GAMR,STARK1,STARK2,
|
|
* STARK3,VDWH
|
|
GO TO 20
|
|
END IF
|
|
if(iabs(mode).eq.2) then
|
|
READ(IUNIT,*) K1,K2,K3,X1,X2,X3,K4
|
|
go to 20
|
|
end if
|
|
if(iabs(mode).eq.3.or.iabs(mode).eq.4) go to 20
|
|
IF(MODE.EQ.0) GO TO 20
|
|
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
|
|
READ(IUNIT,*) LCOMP,INTMOD,NF,XMAX,TSTD
|
|
IF(IABS(IFANCY).EQ.1) READ(IUNIT,*) GAMR,STARK1,STARK2,
|
|
* STARK3,VDWH
|
|
GO TO 20
|
|
C
|
|
30 CONTINUE
|
|
close(iunit)
|
|
RETURN
|
|
END
|