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

105 lines
2.4 KiB
Fortran

SUBROUTINE XENINI
C =================
C
C Initializes necessary arrays for evaluating hydrogen line profiles
C from the XENOMORPH tables
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
C
DO I=1,4
DO J=1,22
ILXEN(I,J)=0
END DO
END DO
if(ihxenb.gt.0) then
IHXENB=23
ihxenr=ihxenb+1
open(unit=ihxenb,file='xenomorph.blue.dat',status='old')
open(unit=ihxenr,file='xenomorph.red.dat',status='old')
write(6,641) ihxenb,ihxenr
else
return
end if
c
641 format(' -----------'/
* ' reading XENOMORPH tables; ihxen =',2i3,/
* ' -----------')
C
C ---------------------------------
C read tables - blue wing
C ---------------------------------
C
ILINE=0
READ(IHXENB,*) NTAB
DO ITAB=1,NTAB
ILINEB=ILINE
READ(IHXENB,*) NLXEN
DO ILI=1,NLXEN
ILINE=ILINE+1
READ(IHXENB,*) I,J,ALMIN,ANEMIN,TMIN,DLA,DLE,DLT,
* NWL,NE,NT
XNEMIN=ANEMIN
ILXEN(I,J)=ILINE
NWLXEN(ILINE)=NWL
NTHXEN(ILINE)=NT
NEHXEN(ILINE)=NE
DO IWL=1,NWL
ALXEN(ILINE,IWL)=ALMIN+(IWL-1)*DLA
END DO
DO INE=1,NE
XNEXEN(INE,ILINE)=ANEMIN+(INE-1)*DLE
END DO
DO IT=1,NT
XTXEN(IT,ILINE)=TMIN+(IT-1)*DLT
END DO
END DO
c
DO ILI=1,NLXEN
ILNE=ILINEB+ILI
NWL=NWLXEN(ILNE)
READ(IHXENB,500)
DO INE=1,NEHXEN(ILNE)
DO IT=1,NTHXEN(ILNE)
READ(IHXENB,*) QLT,(PRFXB(ILNE,IWL,IT,INE),IWL=1,NWL)
END DO
END DO
C
END DO
END DO
CLOSE(IHXENB)
500 FORMAT(1X)
C
C ---------------------------------
C read tables - red wing
C ---------------------------------
C
ILINE=0
READ(IHXENR,*) NTAB
DO ITAB=1,NTAB
ILINEB=ILINE
READ(IHXENR,*) NLXEN
DO ILI=1,NLXEN
ILINE=ILINE+1
READ(IHXENR,*) I,J,ALMIN,ANEMIN,TMIN,DLA,DLE,DLT,
* NWL,NE,NT
END DO
c
DO ILI=1,NLXEN
ILNE=ILINEB+ILI
NWL=NWLXEN(ILNE)
READ(IHXENR,500)
DO INE=1,NEHXEN(ILNE)
DO IT=1,NTHXEN(ILNE)
READ(IHXENR,*) QLT,(PRFXR(ILNE,IWL,IT,INE),IWL=1,NWL)
END DO
END DO
C
END DO
END DO
CLOSE(IHXENR)
C
RETURN
END