69 lines
2.0 KiB
Fortran
69 lines
2.0 KiB
Fortran
SUBROUTINE INIMOD
|
|
C
|
|
C SET UP COMMON/RRRVAL/ - VALUES OF N(ION)/U(ION) FOR ALL THE ATOMS
|
|
C AND IONS CONSIDERED
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
|
|
COMMON/HPOPST/HPOP
|
|
C
|
|
c 1. "low-temperature" ionization fractions
|
|
c (using Hamburg partition functions)
|
|
c
|
|
DO 50 ID=1,ND
|
|
IF(IFMOL.EQ.0.OR.TEMP(ID).GE.TMOLIM) THEN
|
|
CALL STATE(ID,TEMP(ID),ELEC(ID),S1)
|
|
HPOP=DENS(ID)/WMM(ID)/YTOT(ID)
|
|
DO J=1,MION0
|
|
DO I=1,MATOM
|
|
RRR(ID,J,I)=RR(I,J)*HPOP
|
|
END DO
|
|
END DO
|
|
DO IAT=1,NATOM
|
|
ATTOT(IAT,ID)=HPOP*ABUND(IAT,ID)
|
|
END DO
|
|
ELSE
|
|
HPOP=ATTOT(1,ID)
|
|
END IF
|
|
IF(ID.NE.IDSTD) GO TO 50
|
|
TSTD=TEMP(ID)
|
|
VTS=VTURB(ID)
|
|
DSTD=SQRT(1.4E7*TSTD+VTS)
|
|
WRITE(6,601) ID,TEMP(ID),ELEC(ID),hpop
|
|
c DO I=1,MATOM
|
|
DO I=1,30
|
|
WRITE(6,602) TYPAT(I),(RRR(ID,J,I),J=1,MION0-1)
|
|
END DO
|
|
c WRITE(6,603)
|
|
c DO I=1,MATOM
|
|
c WRITE(6,602) TYPAT(I),(PFSTD(J,I),J=1,MION0-1)
|
|
c END DO
|
|
50 CONTINUE
|
|
c
|
|
c 2. "high-temperature" ionization fractions
|
|
c (using the Opacity Project ionization fractions)
|
|
c
|
|
if(teff.lt.0.) then
|
|
CALL FRAC1
|
|
ID=IDSTD
|
|
HPOP=DENS(ID)/WMM(ID)/YTOT(ID)
|
|
WRITE(6,604) ID,TEMP(ID),ELEC(ID)
|
|
DO 60 I=1,MATOM
|
|
WRITE(6,605) TYPAT(I),(RRR(ID,J,I)/hpop,J=1,MION)
|
|
ioniz(i)=i+1
|
|
60 continue
|
|
end if
|
|
C
|
|
601 FORMAT(/' N/U AT THE STANDARD DEPTH (ID =',I3,
|
|
* ' ; T,Ne = ',F8.1,1P2E12.3,' )'/
|
|
* ' --------------------------'//)
|
|
602 FORMAT(1H ,A4,1P8E9.2)
|
|
c 603 FORMAT(//' PARTITION FUNCTIONS AT THE STANDARD DEPTH'/
|
|
c * ' ------------------------------------------'//)
|
|
604 FORMAT(/' N/U AT THE STANDARD DEPTH - OP DATA',
|
|
* ' (ID =',I3,' ; T,Ne = ',F8.1,1PE12.3,' )'//)
|
|
605 FORMAT(1H ,A4,(1P8E9.2))
|
|
RETURN
|
|
END
|