87 lines
2.2 KiB
Fortran
87 lines
2.2 KiB
Fortran
SUBROUTINE PZERT
|
|
C ================
|
|
C
|
|
C driving routine for super-zeroing, i.e. detecting that
|
|
C a given population is small throughout the whole
|
|
C atmosphere, so it is removed completely from linearization
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
DIMENSION POPMA(MLEVEL),INDLEZ(MLEVEL),GZR(MLEVEL)
|
|
c
|
|
if(ioptab.lt.0) return
|
|
C
|
|
C super-zeroing of the individual levels
|
|
C
|
|
POPZRL=1.E5*POPZER
|
|
NLNZX=0
|
|
DO IAT=1,NATOM
|
|
N1=N0A(IAT)
|
|
NK=NKA(IAT)
|
|
DO II=N1,NK
|
|
POPMA(II)=0.
|
|
END DO
|
|
c
|
|
c set-up quantity POPMA(II), which is the maximum
|
|
C (over depths) of the relative population of given
|
|
C level II to the total population of the atom.
|
|
C
|
|
DO ID=1,ND
|
|
POPM=0.
|
|
DO II=N1,NK
|
|
IF(POPUL(II,ID).GT.POPM) POPM=POPUL(II,ID)
|
|
END DO
|
|
DO II=N1,NK
|
|
POPREL=POPUL(II,ID)/POPM
|
|
IF(POPREL.GT.POPMA(II)) POPMA(II)=POPREL
|
|
END DO
|
|
END DO
|
|
C
|
|
C if POPMA(II) is small, level II is super-zeroed
|
|
C
|
|
DO II=N1,NK
|
|
IPZERT(II)=0
|
|
IF(POPMA(II).LT.POPZRL) THEN
|
|
IPZERT(II)=1
|
|
DO ID=1,ND
|
|
IPZERO(II,ID)=1
|
|
POPUL(II,ID)=0.
|
|
END DO
|
|
ELSE
|
|
IF(IIEXP(II).GT.0) THEN
|
|
NLNZX=NLNZX+1
|
|
INDLEZ(NLNZX)=II
|
|
END IF
|
|
END IF
|
|
END DO
|
|
END DO
|
|
c
|
|
c now, check whether all populations within a group were
|
|
C super-zeroed. If so, super-zero the whole group
|
|
C
|
|
DO II=1,NLVEXP
|
|
GZR(II)=1.
|
|
END DO
|
|
DO I=1,NLEVEL
|
|
II=IABS(IIEXP(I))
|
|
IF(II.NE.0) GZR(II)=GZR(II)*IPZERT(I)
|
|
END DO
|
|
NLVEXZ=0
|
|
DO II=1,NLVEXP
|
|
IF(GZR(II).EQ.0) THEN
|
|
IGZERT(II)=0
|
|
NLVEXZ=NLVEXZ+1
|
|
INDLGZ(NLVEXZ)=II
|
|
IINONZ(II)=NLVEXZ
|
|
ELSE
|
|
IGZERT(II)=1
|
|
IINONZ(II)=0
|
|
END IF
|
|
END DO
|
|
NN=NN0-NLVEXP+NLVEXZ
|
|
c
|
|
RETURN
|
|
END
|