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

132 lines
3.6 KiB
Fortran

SUBROUTINE IJALI2
C =================
C
C auxiliary routine - sets up the necessary flags for ALI treatment
C of individual transitions (in the fully hybrid CL/ALI scheme)
C
C Version for opacity sampling mode
C
C Output:
C
C IJALI(IJ) = 0 - frequency point IJ is an explicit point
C = 1 - frequency point IJ is an ALI point
C
C LEXP(ITR) = T - at least one point within transition ITR is explicit
C LEXP(ITR) = F - no point within transition ITR is explicit
C LALI(ITR) = T - at least one point within transition ITR is ALI
C LALI(ITR) = F - no point within transition ITR is ALI
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'ATOMIC.FOR'
INCLUDE 'MODELQ.FOR'
INCLUDE 'ODFPAR.FOR'
C
DO IJ=1,NFREQ
IJALI(IJ)=1
IJX(IJ)=1
NLINES(IJ)=0
END DO
NLITOT=0
NLIMAX=0
C
C Overlapping lines at frequency IJ
C
DO 10 IT=1,NTRANS
IF(LINEXP(IT)) GO TO 10
DO IJ=IFR0(IT),IFR1(IT)
NLINES(IJ)=NLINES(IJ)+1
ITRLIN(NLINES(IJ),IJ)=int2(IT)
END DO
10 CONTINUE
DO IJ=1,NFREQ
NLITOT=NLITOT+NLINES(IJ)
IF(NLINES(IJ).GT.MITJ)
* CALL QUIT('Too many overlappins-nlines(ij).gt.mitj',
* nlines(ij),mitj)
IF(NLINES(IJ).GT.NLIMAX) NLIMAX=NLINES(IJ)
END DO
WRITE(10,*) ' Max. number of line overlaps: ',NLIMAX
WRITE(10,*) ' Total number of line overlaps: ',NLITOT
C
C Switches for ALI and explicit transitions
C
IF(NFFIX.EQ.2) THEN
DO ITR=1,NTRANS
LEXP(ITR)=.FALSE.
LALI(ITR)=.TRUE.
END DO
RETURN
END IF
C
XFRMA=DLOG10(FRS1)
DO 100 ITR=1,NTRANS
INDXP=INDEXP(ITR)
I0=IFR0(ITR)
I1=IFR1(ITR)
NF=I1-I0+1
IF(FR0(ITR).GT.FRS1) GO TO 100
IJL=IJTC(ITR)
C
C primarily explicit line transitions
C
IF(LINE(ITR)) THEN
IF(INDXP.GT.0) THEN
LEXP(ITR)=.TRUE.
LALI(ITR)=.FALSE.
IF(IFC0(ITR).EQ.0) THEN
DO IJ=I0,I1
IJALI(IJ)=0
END DO
ELSE
LALI(ITR)=.TRUE.
NFC=IABS(IFC1(ITR)-IFC0(ITR)+1)
IF(NFC.EQ.NF) THEN
LEXP(ITR)=.FALSE.
ELSE
NFC=NFC/2
DO IJ=I0,IJL-NFC
IJALI(IJ)=0
END DO
DO IJ=IJL+NFC,I1
IJALI(IJ)=0
END DO
END IF
END IF
ELSE IF(INDXP.LT.0) THEN
C
C primarily ALI line transitions
C
LEXP(ITR)=.FALSE.
LALI(ITR)=.TRUE.
IF(IFC0(ITR).NE.0) THEN
LEXP(ITR)=.TRUE.
NFC=IABS(IFC1(ITR)-IFC0(ITR)+1)
IF(NFC.EQ.NF) THEN
LALI(ITR)=.FALSE.
DO IJ=I0,I1
IJALI(IJ)=0
END DO
ELSE
NFC=NFC/2
DO IJ=IJL-NFC,IJL+NFC
IJALI(IJ)=0
END DO
END IF
END IF
END IF
C
C continuum transitions
C
ELSE
IF(IFC0(ITR).GT.0) THEN
DO IJ=1,IFC1(ITR)-IFC0(ITR)+1
IJALI(IJL-IJ+1)=0
END DO
END IF
END IF
100 CONTINUE
C
RETURN
END