178 lines
5.0 KiB
Fortran
178 lines
5.0 KiB
Fortran
SUBROUTINE LEVSET
|
|
C =================
|
|
C
|
|
C sets up level parameters IIEXP and IIFOR which control the
|
|
C treatment of levels
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
if(ioptab.lt.0) return
|
|
C
|
|
C 1. case - treatment of levels determined by IMODL
|
|
C
|
|
IF(IFLEV.EQ.0) THEN
|
|
DO I=1,NLEVEL
|
|
IIEXP(I)=0
|
|
IIFOR(I)=0
|
|
END DO
|
|
IIE=0
|
|
IIF=0
|
|
DO 20 IAT=1,NATOM
|
|
IGRP=0
|
|
IF(IIFIX(IAT).EQ.1) GO TO 20
|
|
DO I=N0A(IAT),NKA(IAT)
|
|
INEW=1
|
|
IF(IMODL(I).EQ.0) THEN
|
|
IIE=IIE+1
|
|
IIF=IIF+1
|
|
IIEXP(I)=IIE
|
|
IIFOR(I)=IIF
|
|
INDLEV(IIEXP(I))=I
|
|
ELSE IF(IMODL(I).GT.0) THEN
|
|
IIF=IIF+1
|
|
IIFOR(I)=IIF
|
|
IF(ILTLEV(I).GE.1) THEN
|
|
IIE=IIE+1
|
|
IIEXP(I)=IIE
|
|
END IF
|
|
IF(I.EQ.NFIRST(IEL(I)).OR.I.EQ.NNEXT(IEL(I))) THEN
|
|
IIE=IIE+1
|
|
IIEXP(I)=IIE
|
|
END IF
|
|
ELSE IF(IMODL(I).LT.-100) THEN
|
|
IF(I.GT.1) THEN
|
|
IF(IMODL(I).EQ.IMODL(I-1)) INEW=0
|
|
END IF
|
|
IIEXP(I)=-IIE
|
|
IF(INEW.EQ.1) THEN
|
|
IIE=IIE+1
|
|
IIEXP(I)=-IIE
|
|
IM=NFIRST(IEL(I))
|
|
LML=.TRUE.
|
|
DO WHILE (IM.LT.I-1 .AND. LML)
|
|
IF(IMODL(I).EQ.IMODL(IM)) THEN
|
|
IIEXP(I)=IIEXP(IM)
|
|
IIE=IIE-1
|
|
LML=.FALSE.
|
|
END IF
|
|
IM=IM+1
|
|
END DO
|
|
END IF
|
|
IGRP=1
|
|
IIF=IIF+1
|
|
IIFOR(I)=IIF
|
|
ELSE IF(IMODL(I).LT.-200) THEN
|
|
IF(I.GT.1) THEN
|
|
IF(IMODL(I).EQ.IMODL(I-1)) INEW=0
|
|
END IF
|
|
IF(INEW.EQ.1) IIE=IIE+1
|
|
IF(INEW.EQ.1) IIF=IIF+1
|
|
IIEXP(I)=-IIE
|
|
IIFOR(I)=-IIF
|
|
IGRP=1
|
|
END IF
|
|
END DO
|
|
IF(IGRP.EQ.1) THEN
|
|
DO I=N0A(IAT),NKA(IAT)
|
|
IF(IIEXP(I).GT.0) IIEXP(I)=-IIEXP(I)
|
|
IF(IMODL(I).EQ.0) IMODL(I)=7
|
|
END DO
|
|
END IF
|
|
20 CONTINUE
|
|
NLVEXP=IABS(IIE)
|
|
if(nlvexp.gt.mlvexp)
|
|
* CALL QUIT('nlvexp.gt.mlvexp',nlvexp,mlvexp)
|
|
NLVFOR=IABS(IIF)
|
|
DO 30 I=1,NLEVEL
|
|
IF(IMODL(I).EQ.1.OR.IMODL(I).EQ.3) THEN
|
|
IIEXP(I)=0
|
|
ELSE IF(IMODL(I).EQ.4.OR.IMODL(I).EQ.5) THEN
|
|
IIEXP(I)=0
|
|
ELSE IF(IMODL(I).EQ.-1.OR.IMODL(I).EQ.-3) THEN
|
|
IIEXP(I)=0
|
|
IIFOR(I)=0
|
|
ELSE IF(IMODL(I).EQ.6) THEN
|
|
IIEXP(I)=0
|
|
ELSE IF(IMODL(I).EQ.-5.OR.IMODL(I).EQ.-6) THEN
|
|
IIEXP(I)=0
|
|
IIFOR(I)=0
|
|
ELSE IF(IMODL(I).LT.-100) THEN
|
|
IMODL(I)=7
|
|
ELSE IF(IMODL(I).LT.-200) THEN
|
|
IMODL(I)=-7
|
|
END IF
|
|
DO ID=1,ND
|
|
ILTREF(I,ID)=NNEXT(IEL(I))
|
|
END DO
|
|
30 CONTINUE
|
|
IF(IGRP.EQ.1) THEN
|
|
DO I=N0A(IAT),NKA(IAT)
|
|
IMODL(I)=7
|
|
END DO
|
|
END IF
|
|
C
|
|
C 2. case - treatment of levels automatic - all levels with ILK=0
|
|
C in updated LTE mode
|
|
C
|
|
ELSE
|
|
IIF=0
|
|
DO 110 I=1,NLEVEL
|
|
IF(IIFIX(IATM(I)).EQ.1) GO TO 110
|
|
IMODL(I)=5
|
|
IF(I.EQ.NFIRST(IEL(I)).OR.I.EQ.NNEXT(IEL(I))) THEN
|
|
IIF=IIF+1
|
|
IIFOR(I)=IIF
|
|
END IF
|
|
110 CONTINUE
|
|
NLVEXP=IIF
|
|
if(nlvexp.gt.mlvexp)
|
|
* CALL QUIT('nlvexp.gt.mlvexp',nlvexp,mlvexp)
|
|
NLVFOR=IIF
|
|
DO I=1,NLEVEL
|
|
IF(I.NE.NFIRST(IEL(I)).AND.I.NE.NNEXT(IEL(I)))
|
|
* IIFOR(I)=0
|
|
END DO
|
|
DO I=1,NLEVEL
|
|
IIEXP(I)=IIFOR(I)
|
|
IF(IIEXP(I).GT.0) INDLEV(IIEXP(I))=I
|
|
DO ID=1,ND
|
|
ILTREF(I,ID)=NNEXT(IEL(I))
|
|
END DO
|
|
END DO
|
|
if(.not.lte) then
|
|
do i=1,nlevel
|
|
iifor(i)=i
|
|
end do
|
|
nlvfor=nlevel
|
|
end if
|
|
c
|
|
END IF
|
|
C
|
|
C initialize b-factors
|
|
C
|
|
DO I=1,NLEVEL
|
|
DO ID=1,ND
|
|
BFAC(I,ID)=UN
|
|
END DO
|
|
END DO
|
|
C
|
|
do ii=1,nlvexp
|
|
indlev(ii)=0
|
|
do id=1,nd
|
|
igzero(ii,id)=0
|
|
end do
|
|
end do
|
|
do i=1,nlevel
|
|
do id=1,nd
|
|
ipzero(i,id)=0
|
|
end do
|
|
if(iabs(imodl(i)).le.6) then
|
|
IF(IIEXP(I).GT.0) INDLEV(IIEXP(I))=I
|
|
end if
|
|
end do
|
|
C
|
|
RETURN
|
|
END
|