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

49 lines
1.2 KiB
Fortran

SUBROUTINE CONCOR
C =================
C
C Auxiliary procedure called from INILAM
C Initialization of the model parameter DELTA immediately
C after a completed iteration of complete linearization
C
C DELTA is defined as d(lnT)/dln(P)
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'MODELQ.FOR'
C
IF(INDL.EQ.0) RETURN
NDEL=NFREQE+INDL
C
if(idisk.eq.0) then
PRAD0=PRADT(1)-PRD0
DO ID=1,ND
PTOTAL(ID)=DM(ID)*GRAV+PRAD0
END DO
end if
C
DO ID=2,ND
P=PTOTAL(ID)
PM=PTOTAL(ID-1)
DEL1=DELTA(ID)
TM=TEMP(ID-1)
T1=TEMP(ID)
FAC=DEL1*(P-PM)/(P+PM)
T2=TM*(UN+FAC)/(UN-FAC)
DEL2=(T1-TM)/(P-PM)/(T1+TM)*(P+PM)
IF(ITEMP.EQ.1.AND.ID.GE.ICBEG-1) TEMP(ID)=T2
IF(ITEMP.EQ.2) TEMP(ID)=T2
END DO
C
C check whether the corresponding convective flux is less
C than total flux; if not, recalculate tempertaure
C
if(itmcor.ne.0) then
CALL TEMCOR
write(6,603)
call conout(1,ipconf)
end if
c
603 format(' recalculation of convective flux in CONCOR'/)
RETURN
END