340 lines
9.7 KiB
Fortran
340 lines
9.7 KiB
Fortran
SUBROUTINE INITIA
|
|
C =================
|
|
C
|
|
C driver for input and initializations
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
PARAMETER (WI1=911.753578, WI2=227.837832)
|
|
common/dissol/fropc(mlevel),indexp(mlevel)
|
|
CHARACTER*10 TYPLEV(MLEVEL)
|
|
CHARACTER*4 TYPION(MIOEX),TYPIOI
|
|
CHARACTER*40 FIDATA(MION),FIODF1(MION),FIODF2(MION),FIBFCS(MION),
|
|
* FILEI
|
|
CHARACTER*20 FINSTD
|
|
CHARACTER*1 BLNK
|
|
COMMON/PRINTP/TYPLEV
|
|
COMMON/IONDAT/IATI(MION),IZI(MION),NLEVS(MION),NLLIM(MION)
|
|
COMMON/IONFIL/FIDATA,FIODF1,FIODF2,FIBFCS
|
|
COMMON/INUNIT/IUNIT
|
|
COMMON/STRPAR/IMER,ITR,IC,IL,IP,NLASTE,NHOD
|
|
common/quasex/iexpl(mlevel),iltot(mlevel)
|
|
DIMENSION IGLE(18),IGMN(25),IGFE(26),IGNI(28)
|
|
DATA IGLE/2,1,2,1,6,9,4,9,6,1,2,1,6,9,4,9,6,1/
|
|
DATA IGMN/2,1,2,1,6,9,4,9,6,1,2,1,6,9,4,9,6,1,
|
|
* 10,21,28,25,6,7,6/
|
|
DATA IGFE/2,1,2,1,6,9,4,9,6,1,2,1,6,9,4,9,6,1,
|
|
* 10,21,28,25,6,25,30,25/
|
|
DATA IGNI/2,1,2,1,6,9,4,9,6,1,2,1,6,9,4,9,6,1,
|
|
* 10,21,28,25,6,25,28,21,10,21/
|
|
DATA BLNK /' '/
|
|
C
|
|
CALL READBF
|
|
C
|
|
C ------------------------------------
|
|
C Basic input parameters - atmospheres
|
|
C ------------------------------------
|
|
C
|
|
IF(INMOD.LE.1) THEN
|
|
READ(IBUFF,*) TEFF,GRAV
|
|
ELSE IF(INMOD.EQ.2) THEN
|
|
C
|
|
C ------------------------------
|
|
C Basic input parameters - disks
|
|
C ------------------------------
|
|
C
|
|
READ(IBUFF,*) DISPAR
|
|
END IF
|
|
C
|
|
C ----------------------------
|
|
C other basic input parameters
|
|
C ----------------------------
|
|
C
|
|
READ(IBUFF,*) LTE,LTGREY
|
|
READ(IBUFF,*) FINSTD
|
|
CALL NSTPAR(FINSTD)
|
|
C
|
|
C
|
|
C ----------------------------
|
|
C Frequency points and weights
|
|
C ----------------------------
|
|
C
|
|
READ(IBUFF,*) NFREAD
|
|
NJREAD=NFREAD
|
|
C
|
|
IF(NJREAD.LT.0) THEN
|
|
NJREAD=-NJREAD
|
|
NFREQC=NJREAD
|
|
DO IJ=1,NJREAD
|
|
READ(IBUFF,*) FREQEXP
|
|
END DO
|
|
ELSE
|
|
NFREQC=NJREAD
|
|
END IF
|
|
C
|
|
WRITE(6,601) TEFF,GRAV
|
|
C
|
|
C ----------------------------------------------------
|
|
C turbulent velocities
|
|
C ----------------------------------------------------
|
|
C
|
|
IF(VTB.LT.1.E3) VTB=VTB*1.E5
|
|
DO ID=1,ND
|
|
VTURB(ID)=VTB
|
|
END DO
|
|
C
|
|
C ----------------------------------------------------
|
|
C Input parameters for explicit and non-explicit atoms
|
|
C ----------------------------------------------------
|
|
C
|
|
C Input parameters are read by procedure STATE
|
|
C (see description there)
|
|
C
|
|
CALL STATE0(1)
|
|
ID=1
|
|
IF(IPRIN.GE.1) WRITE(6,607) YTOT(ID),WMY(ID),WMM(ID)
|
|
DO I=1,MLEVEL
|
|
ILK(I)=0
|
|
iexpl(i)=0
|
|
iltot(i)=0
|
|
END DO
|
|
C
|
|
C --------------------------------------------------------------
|
|
C Input of parameters for explicit ions, levels, and transitions
|
|
C --------------------------------------------------------------
|
|
C
|
|
ILEV=0
|
|
IATLST=0
|
|
ION=0
|
|
IA=0
|
|
IUNIT=34
|
|
NATOM=0
|
|
WRITE(6,613)
|
|
10 CONTINUE
|
|
READ(IBUFF,*,END=20,ERR=20) IATII,IZII,NLEVSI,ILASTI,ILVLIN,
|
|
* NONSTD,TYPIOI,FILEI
|
|
IF(ILASTI.EQ.0) THEN
|
|
ION=ION+1
|
|
IATI(ION)=IATII
|
|
IZI(ION)=IZII
|
|
NLEVS(ION)=NLEVSI
|
|
TYPION(ION)=TYPIOI
|
|
FIDATA(ION)=FILEI
|
|
NLLIM(ION)=ILVLIN
|
|
ILIMITS(ION)=-1
|
|
IUPSUM(ION)=0
|
|
FIBFCS(ION)=BLNK
|
|
MODEFF=1
|
|
NFF=0
|
|
IF(IATI(ION).EQ.1.AND.IZI(ION).EQ.0) THEN
|
|
IUPSUM(ION)=-100
|
|
MODEFF=2
|
|
END IF
|
|
IF(IATI(ION).EQ.2.AND.IZI(ION).EQ.1) THEN
|
|
MODEFF=2
|
|
END IF
|
|
IF(NONSTD.GE.10) THEN
|
|
WRITE(*,*)'INITIA: QUANTUM NUMBERS AND ENERGY LIMITS WILL'
|
|
WRITE(*,*)' BE IGNORED FOR ION ',IATII,' ',IZII
|
|
ILIMITS(ION)=0
|
|
NONSTD=NONSTD-10
|
|
END IF
|
|
IF(NONSTD.GT.0) THEN
|
|
READ(IBUFF,*) IUPSUM(ION),ICUP,MODEFF,NFF
|
|
ELSE IF(NONSTD.LT.0) THEN
|
|
READ(IBUFF,*) ifil1,ifil2,FIODF1(ION),
|
|
* FIODF2(ION),FIBFCS(ION)
|
|
IF(FIBFCS(ION).NE.' ') THEN
|
|
IUNIT=IUNIT+1
|
|
INBFCS(ION)=IUNIT
|
|
END IF
|
|
IUPSUM(ION)=1
|
|
END IF
|
|
C
|
|
IF(IATI(ION).EQ.IATLST) THEN
|
|
NFIRST(ION)=ILEV
|
|
ELSE
|
|
NFIRST(ION)=ILEV+1
|
|
IATLST=IATI(ION)
|
|
IA=IATEX(IATLST)
|
|
N0A(IA)=NFIRST(ION)
|
|
NATOM=MAX(NATOM,IA)
|
|
END IF
|
|
NLAST(ION)=NFIRST(ION)+NLEVS(ION)-1
|
|
NNEXT(ION)=NLAST(ION)+1
|
|
ILEV=NNEXT(ION)
|
|
IZ(ION)=IZI(ION)+1
|
|
IF(NFF.GT.0) FF(ION)=EH/H*IZ(ION)*IZ(ION)/NFF/NFF
|
|
C
|
|
N0I=NFIRST(ION)
|
|
N1I=NLAST(ION)
|
|
NKI=NNEXT(ION)
|
|
IFREE(ION)=MODEFF
|
|
DO II=N0I,N1I
|
|
IEL(II)=ION
|
|
IATM(II)=IA
|
|
END DO
|
|
ILK(NKI)=ION
|
|
IATM(NKI)=IA
|
|
C
|
|
IF(NUMAT(IA).EQ.1) THEN
|
|
IATH=IA
|
|
IF(IZ(ION).EQ.1) IELH=ION
|
|
IF(IZ(ION).EQ.0) IELHM=ION
|
|
END IF
|
|
IF(NUMAT(IA).EQ.2) THEN
|
|
IATHE=IA
|
|
IF(IZ(ION).EQ.1) IELHE1=ION
|
|
IF(IZ(ION).EQ.2) IELHE2=ION
|
|
END IF
|
|
C
|
|
IF(IPRIN.GE.0)
|
|
* WRITE(6,614) TYPION(ION),N0I,N1I,NKI,IZ(ION)
|
|
C
|
|
ELSE IF(ILASTI.GT.0) THEN
|
|
ENION(ILEV)=0.
|
|
G(ILEV)=ILASTI
|
|
NQUANT(ILEV)=1
|
|
TYPLEV(ILEV)=TYPIOI
|
|
IFWOP(ILEV)=0
|
|
IEL(ILEV)=ION
|
|
NKA(IA)=NNEXT(ION)
|
|
IF(ILASTI.EQ.1.AND.IATII.GT.IZII) THEN
|
|
IF(IATII.LT.25) THEN
|
|
G(ILEV)=IGLE(IATII-IZII)
|
|
ELSE IF(IATII.EQ.25) THEN
|
|
G(ILEV)=IGMN(IATII-IZII)
|
|
ELSE IF(IATII.EQ.26) THEN
|
|
G(ILEV)=IGFE(IATII-IZII)
|
|
ELSE IF(IATII.EQ.28) THEN
|
|
G(ILEV)=IGNI(IATII-IZII)
|
|
ENDIF
|
|
ENDIF
|
|
ELSE
|
|
GO TO 20
|
|
END IF
|
|
GO TO 10
|
|
20 CONTINUE
|
|
NION=ION
|
|
NLEVEL=NKI
|
|
C
|
|
if(iath.gt.0) then
|
|
N0H=N0A(IATH)
|
|
N1H=NLAST(IELH)
|
|
NKH=NNEXT(IELH)
|
|
N0HN=NFIRST(IELH)
|
|
N0M=0
|
|
IF(IELHM.GT.0) THEN
|
|
N0M=NFIRST(IELHM)
|
|
IOPHMI=0
|
|
end if
|
|
else
|
|
n0h=0
|
|
n1h=0
|
|
nkh=0
|
|
n0hn=0
|
|
end if
|
|
C
|
|
IF(IPRIN.GE.1) WRITE(6,603) INMOD,ND,IDSTD,INTRPL,ICHANG,
|
|
* NATOM,NION,NLEVEL,
|
|
* IELH,IELHM,IATH
|
|
C
|
|
C -----------------------------------------
|
|
C Parameters for individual explicit levels
|
|
C -----------------------------------------
|
|
C
|
|
IMER=0
|
|
ITR=0
|
|
IC=0
|
|
IL=0
|
|
IP=0
|
|
C
|
|
DO ION=1,NION
|
|
CALL RDATA(ION)
|
|
NFF=NQUANT(NLAST(ION))+1
|
|
IF(NFF.GT.0) FF(ION)=EH/H*IZ(ION)*IZ(ION)/NFF/NFF
|
|
END DO
|
|
C
|
|
IF(IPRIN.GE.1) WRITE(6,615)
|
|
DO I=1,NLEVEL
|
|
IF(IPRIN.GE.1)
|
|
* WRITE(6,616) I,TYPLEV(I),TYPION(IEL(I)),ENION(I),G(I),
|
|
* NQUANT(I),IEL(I),ILK(I),IATM(I)
|
|
END DO
|
|
C
|
|
C -----------------------------------------
|
|
C Input parameters for additional opacities
|
|
C -----------------------------------------
|
|
C
|
|
IF(IPRIN.GE.0) WRITE(6,605) IOPHMI,IOPH2P,IOPHEM,IOPCH,IOPOH,
|
|
* IOPH2M,IOH2H2,IOH2HE,IOH2H1,IOHHE,
|
|
* IRSCT,IRSCH2,IRSCHE,IOPHLI
|
|
C
|
|
C
|
|
IF(VTB.LT.1.E3) VTB=VTB*1.E5
|
|
DO ID=1,ND
|
|
VTURB(ID)=VTB
|
|
END DO
|
|
WRITE(6,608) VTB*1.E-5
|
|
DO I=1,ND
|
|
VTURB(I)=VTURB(I)*VTURB(I)
|
|
END DO
|
|
C
|
|
601 FORMAT(31X,'*******************************************'/
|
|
* 31X,'I',41X,'I'/
|
|
* 31X,'I S Y N T H E T I C S P E C T R U M I'/
|
|
* 31X,'I',41X,'I'/
|
|
* 31X,'I',8X,'FOR MODEL ATMOSPHERE WITH',8X,'I'/
|
|
* 31X,'I',41X,'I'/
|
|
* 31X,'I',14X,'TEFF =',F7.0,13X,'I'/
|
|
* 31X,'I',14X,'LOG G =',F7.2,13X,'I'/
|
|
* 31X,'I',41X,'I'/
|
|
* 31X,'*******************************************')
|
|
603 FORMAT(//' BASIC INPUT PARAMETERS'/
|
|
* ' ----------------------'/
|
|
* ' INMOD =',I5/
|
|
* ' ND =',I5/
|
|
* ' IDSTD =',I5/
|
|
* ' INTRPL =',I5/
|
|
* ' ICHANG =',I5/
|
|
* ' NATOM =',I5/
|
|
* ' NION =',I5/
|
|
* ' NLEVEL =',I5/
|
|
* ' IELH =',I5/
|
|
* ' IELHM =',I5/
|
|
* ' IATH =',I5)
|
|
605 FORMAT(//' ADDITIONAL OPACITY SOURCES'/
|
|
* ' --------------------------'/
|
|
* ' IOPHMI (H- OPACITY IN LTE) =',I3/
|
|
* ' IOPH2P (H2+ OPACITY) =',I3/
|
|
* ' IOPHEM (HE- B-F AND F-F) =',I3/
|
|
* ' IOPCH (CH OPACITY) =',I3/
|
|
* ' IOPOH (OH OPACITY) =',I3/
|
|
* ' IOPH2M (H2- OPACITY) =',I3/
|
|
* ' IOH2H2 (CIA H2-H2 OPACITY =',I3/
|
|
* ' IOH2HE (CIA H2-He OPACITY =',I3/
|
|
* ' IOH2H1 (CIA H2-H OPACITY =',I3/
|
|
* ' IOHHE (CIA H-He OPACITY =',I3/
|
|
* ' IRSCT (RAYLEIGH SCAT. ON H I) =',I3/
|
|
* ' IRSCH2 (RAYLEIGH SCAT. ON H2 =',I3/
|
|
* ' IRSCHE (RAYLEIGH SCAT. ON HE I) =',I3/
|
|
* ' IOPHLI (LYMAN LINES WINGS) =',I3)
|
|
607 FORMAT(///' YTOT =',F11.5/' WMY =',1PE15.5/
|
|
* ' WMM =',E15.5)
|
|
608 FORMAT(//' TURBULENT VELOCITY - DEPTH-INDEPENDENT VTURB =',
|
|
* 1PE10.3,' KM/S'/
|
|
* ' ------------------'/)
|
|
613 FORMAT(//' EXPLICIT IONS INCLUDED'/
|
|
* ' ----------------------'//
|
|
* ' ION N0 N1 NK IZ'/)
|
|
614 FORMAT(A4,4I6)
|
|
615 FORMAT(//' EXPLICIT ENERGY LEVELS INCLUDED'/
|
|
* ' -------------------------------'//
|
|
* ' NO. LEVEL ION ION.EN.(ERG) G NQUANT',
|
|
* ' IEL ILK IAT'/)
|
|
616 FORMAT(I4,2X,A10,A4,1PE15.7,0PF10.2,4I5)
|
|
C
|
|
RETURN
|
|
END
|