52 lines
1.5 KiB
Fortran
52 lines
1.5 KiB
Fortran
SUBROUTINE ALIFRK(IJ)
|
|
C =====================
|
|
C
|
|
C Simplified routine ALIFR1 for a Kantorovich iteration
|
|
C
|
|
C hydrostatic and radiative equilibrium quantities -
|
|
C derivatives of the total heating and cooling rates in the
|
|
C ALI points with respect to the
|
|
C temperature, electron density, and populations
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ALIPAR.FOR'
|
|
DIMENSION WFL(MDEPTH)
|
|
C
|
|
if(ifali.le.1) return
|
|
WW=WC(IJ)
|
|
|
|
c **** Special expressions for the first depth - id=1
|
|
|
|
ID=1
|
|
LNSKIP=.NOT.LSKIP(ID,IJ)
|
|
WF=WW*(FH(IJ)*RAD1(ID)-HEXTRD(IJ))
|
|
IF(LNSKIP) FPRD(ID)=FPRD(ID)+WF*ABSO1(ID)
|
|
FLFIX(ID)=FLFIX(ID)+WF
|
|
FLRD(ID)=FLRD(ID)+W(IJ)*(FH(IJ)*RAD1(ID)-HALF*EXTRAD(IJ))
|
|
IF(REINT(ID).GT.0) THEN
|
|
ABST=ABSO1(ID)-SCAT1(ID)
|
|
FCOOLI(ID)=FCOOLI(ID)+WW*(EMIS1(ID)-ABST*RAD1(ID))
|
|
END IF
|
|
|
|
c Loop over depths
|
|
|
|
DO ID=2,ND
|
|
LNSKIP=.NOT.LSKIP(ID,IJ)
|
|
DT=UN/((ABSOT(ID)+ABSOT(ID-1))*DELDMZ(ID-1))
|
|
FL=RAD1(ID)*FAK1(ID)-RAD1(ID-1)*FAK1(ID-1)
|
|
WFL(ID)=WW*FL
|
|
IF(LNSKIP) FPRD(ID)=FPRD(ID)+WFL(ID)
|
|
FLFIX(ID)=FLFIX(ID)+WFL(ID)*DT
|
|
FLRD(ID)=FLRD(ID)+FL*W(IJ)*DT
|
|
IF(REINT(ID).GT.0) THEN
|
|
ABST=ABSO1(ID)-SCAT1(ID)
|
|
FCOOLI(ID)=FCOOLI(ID)+WW*(EMIS1(ID)-ABST*RAD1(ID))
|
|
END IF
|
|
END DO
|
|
|
|
RETURN
|
|
END
|