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

118 lines
3.7 KiB
Fortran

SUBROUTINE OUTPUT
C =================
C
C Output of computed model atmosphere on file 7
C This file may be used as input file 8 (initial model atmosphere)
C for a subsequent run of the program
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
C
NUMLT=3
IF(IDISK.EQ.1) NUMLT=4
IF(IFMOL.EQ.1) NUMLT=NUMLT+1
NUMPAR=NLEVEL+NUMLT
IF(LTE.AND.IPRINP.EQ.0) NUMPAR=NUMLT
IF(IFMOL.GT.0) NUMPAR=-NUMPAR
C
C NUMPAR - number of model parameters in each depth
C = NUMLT for LTE model, ie. TEMP - temperature
C ELEC - electron density
C DENS - density
C = NUMLT+NLEVEL for NLTE model, ie. the above + populations
C ---------------------------------------------------------------------
C 2. DM(ID),ID=1,ND - mass-depth points for the input model
C ---------------------------------------------------------------------
C 3. for each depth:
C T - temperature
C ANE - electron density
C RHO - mass density
C level populations - only for NLTE input model
C
REWIND 7
WRITE(7,501) ND,NUMPAR
WRITE(7,502) (DM(ID),ID=1,ND)
IF(IDISK.EQ.0) THEN
DO ID=1,ND
IF(LTE.AND.IPRINP.EQ.0) THEN
IF(IFMOL.EQ.0) THEN
WRITE(7,503) TEMP(ID),ELEC(ID),DENS(ID)
ELSE
WRITE(7,503) TEMP(ID),ELEC(ID),DENS(ID),TOTN(ID)
END IF
ELSE
IF(IFMOL.EQ.0) THEN
WRITE(7,503) TEMP(ID),ELEC(ID),DENS(ID),
* (POPUL(J,ID),J=1,NLEVEL)
ELSE
WRITE(7,503) TEMP(ID),ELEC(ID),DENS(ID),TOTN(ID),
* (POPUL(J,ID),J=1,NLEVEL)
END IF
END IF
END DO
ELSE
DO ID=1,ND
IF(LTE.AND.IPRINP.EQ.0) THEN
IF(IFMOL.EQ.0) THEN
WRITE(7,503) TEMP(ID),ELEC(ID),
* DENS(ID),ZD(ID)
ELSE
WRITE(7,503) TEMP(ID),ELEC(ID),
* DENS(ID),TOTN(ID),ZD(ID)
END IF
ELSE
IF(IFMOL.EQ.0) THEN
WRITE(7,503) TEMP(ID),ELEC(ID),DENS(ID),ZD(ID),
* (POPUL(J,ID),J=1,NLEVEL)
ELSE
WRITE(7,503) TEMP(ID),ELEC(ID),DENS(ID),TOTN(ID),ZD(ID),
* (POPUL(J,ID),J=1,NLEVEL)
END IF
END IF
END DO
END IF
CLOSE(7)
IF(IPRIND.GT.0) THEN
WRITE(17,501) ND,NUMPAR
WRITE(17,502) (DM(I),I=1,ND)
IF(IDISK.EQ.0) THEN
IF(LTE) THEN
DO ID=1,ND
WRITE(17,503) TEMP(ID),ELEC(ID),DENS(ID)
END DO
ELSE
WRITE(20,501) ND,NUMPAR
WRITE(20,502) (DM(ID),ID=1,ND)
DO ID=1,ND
WRITE(17,503) TEMP(ID),ELEC(ID),DENS(ID),
* (POPUL(J,ID),J=1,NLEVEL)
WRITE(20,503) TEMP(ID),ELEC(ID),DENS(ID),
* (BFAC(J,ID),J=1,NLEVEL)
END DO
END IF
ELSE
IF(LTE) THEN
DO ID=1,ND
WRITE(17,503) TEMP(ID),ELEC(ID),DENS(ID),ZD(ID)
END DO
ELSE
WRITE(20,501) ND,NUMPAR
WRITE(20,502) (DM(ID),ID=1,ND)
DO ID=1,ND
WRITE(17,503) TEMP(ID),ELEC(ID),DENS(ID),ZD(ID),
* (POPUL(J,ID),J=1,NLEVEL)
WRITE(20,503) TEMP(ID),ELEC(ID),DENS(ID),ZD(ID),
* (BFAC(J,ID),J=1,NLEVEL)
END DO
END IF
END IF
END IF
501 FORMAT(2I5)
502 FORMAT(1P6E13.6)
503 FORMAT(1P5E15.6)
RETURN
END