87 lines
2.8 KiB
Fortran
87 lines
2.8 KiB
Fortran
SUBROUTINE CHCKSE
|
|
C ==================
|
|
C
|
|
C Auxiliary output routine, which enables printing
|
|
C total rates to check statistical equilibrium at each depth.
|
|
C
|
|
C Output: unit 16: <OUT> and <IN> rates, and relative difference,
|
|
C for each level.
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
PARAMETER (MLEVES=mlevel)
|
|
DIMENSION ROUT(MLEVES,MDEPTH),RIN(MLEVES,MDEPTH)
|
|
if(ioptab.lt.0) return
|
|
C
|
|
DO ID=1,ND
|
|
T=TEMP(ID)
|
|
HKT=HK/T
|
|
TK=HKT/H
|
|
ANE=ELEC(ID)
|
|
CALL SABOLF(ID)
|
|
DO IAT=1,NATOM
|
|
N0I=N0A(IAT)
|
|
NKI=NKA(IAT)
|
|
N1I=NKI-1
|
|
DO I=N0I,NKI
|
|
OUT=0.
|
|
XIN=0.
|
|
NKE=NNEXT(IEL(I))
|
|
DO IT=1,NTRANS
|
|
II=ILOW(IT)
|
|
JJ=IUP(IT)
|
|
IF(II.EQ.I) THEN
|
|
J=JJ
|
|
IF(LINE(IT)) THEN
|
|
AIJ=COLTAR(IT,ID)*WOP(I,ID)+RRD(IT,ID)*
|
|
* G(I)/G(J)*WOP(I,ID)*EXP(HKT*FR0(IT))
|
|
ELSE
|
|
CORR=UN
|
|
NKE=NNEXT(IEL(I))
|
|
IF(NKE.NE.J) CORR=G(NKE)/G(J)*
|
|
* EXP((ENION(NKE)-ENION(J))*TK)
|
|
AIJ=COLTAR(IT,ID)+WOP(I,ID)+RRD(IT,ID)*
|
|
* ANE*SBF(I)*CORR*WOP(I,ID)
|
|
END IF
|
|
AJI=(COLRAT(IT,ID)+RRU(IT,ID))*WOP(J,ID)
|
|
XIN=XIN+AIJ*POPUL(J,ID)
|
|
OUT=OUT+AJI
|
|
ELSE IF(JJ.EQ.I) THEN
|
|
J=II
|
|
IF(LINE(IT)) THEN
|
|
AJI=COLTAR(IT,ID)+WOP(J,ID)+RRD(IT,ID)*
|
|
* G(J)/G(I)*WOP(J,ID)*EXP(HKT*FR0(IT))
|
|
ELSE
|
|
CORR=UN
|
|
NKE=NNEXT(IEL(J))
|
|
IF(NKE.NE.I) CORR=G(NKE)/G(I)*
|
|
* EXP((ENION(NKE)-ENION(I))*TK)
|
|
AJI=COLTAR(IT,ID)*WOP(J,ID)+RRD(IT,ID)*
|
|
* ANE*SBF(J)*CORR*WOP(J,ID)
|
|
END IF
|
|
AIJ=(COLRAT(IT,ID)+RRU(IT,ID))*WOP(I,ID)
|
|
XIN=XIN+AIJ*POPUL(J,ID)
|
|
OUT=OUT+AJI
|
|
END IF
|
|
END DO
|
|
RIN(I,ID)=XIN
|
|
ROUT(I,ID)=OUT*POPUL(I,ID)
|
|
END DO
|
|
END DO
|
|
END DO
|
|
DO I=1,NLEVEL
|
|
IF(RIN(I,ND).GT.0.) THEN
|
|
WRITE(16,300) I
|
|
DO ID=1,ND
|
|
DEL=(RIN(I,ID)-ROUT(I,ID))/RIN(I,ID)
|
|
WRITE(16,310) I,ID,RIN(I,ID),ROUT(I,ID),DEL,popul(i,id)
|
|
END DO
|
|
END IF
|
|
END DO
|
|
300 FORMAT('1 Level:',I5///)
|
|
310 FORMAT(2I5,1P3E16.7,2x,e16.7)
|
|
RETURN
|
|
END
|