SpectraRust/synspec/extracted/inkur.f
2026-03-19 14:05:33 +08:00

66 lines
1.9 KiB
Fortran

SUBROUTINE INKUR
C ================
C
C Input of a Kurucz model atmosphere
C
C Input values (extracted from the Kurucz files):
C TEF, G - effective temperature, log g (appears only in output)
C ND - number of depth points
C and for each depth:
C DM - m, m is the mass depth coordinate
C T - temperature
C P - gass pressure
C ANE - electron density
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
DIMENSION POP(MLEVEL),ES(MLEVEL,MLEVEL),BS(MLEVEL),POPLTE(MLEVEL)
COMMON POP,ES,BS
C
READ(8,501) TEF,GRAV
READ(8,502) ND
ND=ND-1
501 FORMAT(4X,F8.0,9X,F8.5)
c 502 FORMAT(/////////////////////10X,I3)
502 FORMAT(/////////////////////10X,I3/)
WRITE(6,600) TEF,GRAV
DO 10 ID=1,ND
READ(8,*) DM(ID),TEMP(ID),P,ELEC(ID)
AN=P/TEMP(ID)/BOLK
DENS(ID)=WMM(ID)*(AN-ELEC(ID))
WRITE(6,601) ID,DM(ID),TEMP(ID),ELEC(ID),DENS(ID)
T=TEMP(ID)
IF(IFMOL.GT.0.AND.T.LT.TMOLIM) THEN
c AN=TOTN(ID)
AEIN=ELEC(ID)
CALL MOLEQ(ID,T,AN,AEIN,ANE,1)
ELSE
DO IAT=1,NATOM
ATTOT(IAT,ID)=DENS(ID)/WMM(ID)/YTOT(ID)*ABUND(IAT,ID)
END DO
END IF
c WRITE(6,601) ID,DM(ID),TEMP(ID),ELEC(ID),DENS(ID)
CALL WNSTOR(ID)
CALL SABOLF(ID)
CALL RATMAT(ID,ES,BS)
CALL LEVSOL(ES,BS,POPLTE,NLEVEL)
DO J=1,NLEVEL
POPUL(J,ID)=POPLTE(J)
END DO
10 CONTINUE
c WRITE(77,503) ND, 3
c WRITE(77,504) (DM(ID),ID=1,ND)
DO ID=1,ND
WRITE(77,504) TEMP(ID),ELEC(ID),DENS(ID)
END DO
c
CLOSE(8)
c
504 FORMAT(1P6E13.6)
600 FORMAT(' INPUT KURUCZ MODEL FOR TEFF=',F7.0,' LOG G =',
* F7.2//1H ,7X,'MASS',9X,'T',9X,'NE',9X,'DENS'/
* '-----------------------------------------------'/)
601 FORMAT(1H ,I5,1PE10.3,0PF10.1,1P2E12.3)
RETURN
END