43 lines
1.1 KiB
Fortran
43 lines
1.1 KiB
Fortran
SUBROUTINE NEWPOP(ID,POP1)
|
|
C ==========================
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ITERAT.FOR'
|
|
DIMENSION POP1(MLEVEL),DPOP(MLEVEL),DPMAX(MDEPTH),
|
|
* SBW(MLEVEL)
|
|
c
|
|
if(ioptab.lt.0) return
|
|
C
|
|
DPMAX(ID)=0.
|
|
DO I=1,NLEVEL
|
|
IF(POPUL(I,ID).GT.0.)
|
|
* DPOP(I)=(POP1(I)-POPUL(I,ID))/POPUL(I,ID)
|
|
IF(ABS(DPOP(I)).GT.DPMAX(ID)) THEN
|
|
DPMAX(ID)=ABS(DPOP(I))
|
|
IMAX=I
|
|
END IF
|
|
POPUL(I,ID)=POP1(I)
|
|
END DO
|
|
c WRITE(18,601) ITER,ILAM,ID,DPMAX(ID),IMAX
|
|
c 601 FORMAT(3I5,1PE10.2,I6)
|
|
C
|
|
C array of b-factors
|
|
C
|
|
DO I=1,NLEVEL
|
|
BFAC(I,ID)=UN
|
|
SBW(I)=ELEC(ID)*SBF(I)*WOP(I,ID)
|
|
END DO
|
|
IF(.NOT.LTE.AND.IPSLTE.EQ.0) THEN
|
|
DO ION=1,NION
|
|
DO I=NFIRST(ION),NLAST(ION)
|
|
IF(POPUL(NNEXT(ION),ID).GT.0.)
|
|
* BFAC(I,ID)=POPUL(I,ID)/(POPUL(NNEXT(ION),ID)*SBW(I))
|
|
END DO
|
|
END DO
|
|
END IF
|
|
RETURN
|
|
END
|