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