83 lines
2.3 KiB
Fortran
83 lines
2.3 KiB
Fortran
SUBROUTINE LEVGRP(ID,IICAL,IMODE,POPP)
|
|
C ======================================
|
|
C
|
|
C determination of the total population of a the level groups;
|
|
C and of relative populations of the group consituents
|
|
C
|
|
C Input: ID - depth index
|
|
C IICAL - array of level grouping parameters (IIEXP of IIFOR)
|
|
C IMODE - a mode of input populations:
|
|
C = 0 - input populations are POPUL(I,ID)
|
|
C = 1 - input populations are given by the last
|
|
C formal parameter POP
|
|
C POP - array of input populations (for IMODE=1 only)
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ITERAT.FOR'
|
|
DIMENSION POPP(MLEVEL),IICAL(MLEVEL)
|
|
if(ioptab.lt.0) return
|
|
C
|
|
DO I=1,NLVEXP
|
|
POPGRP(I)=0.
|
|
igzero(i,id)=0
|
|
END DO
|
|
IF(IMODE.EQ.0) THEN
|
|
DO I=1,NLEVEL
|
|
POPP(I)=POPUL(I,ID)
|
|
END DO
|
|
END IF
|
|
C
|
|
C total population of the group
|
|
C
|
|
DO I=1,NLEVEL
|
|
II=IABS(IICAL(I))
|
|
IF(II.NE.0) POPGRP(II)=POPGRP(II)+POPP(I)
|
|
END DO
|
|
C
|
|
C ratios of the popultions of the individual group
|
|
C components w.r.t the total group populations
|
|
C this quantity remains fixed during linearization
|
|
C
|
|
DO I=1,NLEVEL
|
|
II=IICAL(I)
|
|
IF(II.LT.0) THEN
|
|
IF(POPGRP(-II).GT.0.) THEN
|
|
SBPSI(I,ID)=POPP(I)/POPGRP(-II)
|
|
ELSE
|
|
SBPSI(I,ID)=0.
|
|
IGZERO(-II,ID)=1
|
|
END IF
|
|
END IF
|
|
END DO
|
|
C
|
|
C zeroing of the whole group - if the total group population
|
|
C is smaller than POPZER times the total atomic population
|
|
C
|
|
IF(ITER.EQ.0) THEN
|
|
LKIT=.TRUE.
|
|
ELSE
|
|
LKIT=KANT(ITER).EQ.0 .AND. ITER.LT.IACC
|
|
ENDIF
|
|
IF(LKIT) THEN
|
|
DO I=1,NLEVEL
|
|
IAT=IATM(I)
|
|
POPM=DENS(ID)/WMM(ID)/YTOT(ID)*ABUND(IAT,ID)
|
|
II=IICAL(I)
|
|
IF(II.LT.0) THEN
|
|
IF(POPGRP(-II)/POPM.LT.POPZER) THEN
|
|
POPGRP(-II)=0.
|
|
IGZERO(-II,ID)=1
|
|
END IF
|
|
rpop0(-ii,id)=popgrp(-ii)/popm
|
|
else if(ii.gt.0) then
|
|
rpop0(ii,id)=popgrp(ii)/popm
|
|
END IF
|
|
END DO
|
|
END IF
|
|
C
|
|
RETURN
|
|
END
|