404 lines
12 KiB
Fortran
404 lines
12 KiB
Fortran
SUBROUTINE NLTSET(MODE,IL,IAT,ION,ALAM0,EXCL,EXCU,QL,QU,
|
|
* ISQL,ILQL,IPQL,ISQU,ILQU,IPQU,IEVEN,INNLT0,ILMATCH)
|
|
C ===============================================================
|
|
C
|
|
C NLTE option - automatic assignement of level indices
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
PARAMETER (MNION = MIOEX,
|
|
* MNLEV = MLEVEL,
|
|
* ECONST= 5.03411142E15)
|
|
PARAMETER (INLLEV = 13)
|
|
COMMON/NL2PAR/ELIMEV(MNION,MNLEV),ELIMOD(MNION,MNLEV),
|
|
* ELIML(MNION,MNLEV),
|
|
* ENREV(MNION,MNLEV),ENROD(MNION,MNLEV),
|
|
* INDEV(MNION,MNLEV),INDOD(MNION,MNLEV),
|
|
C * INDLV(MNION,MNLEV),
|
|
* INDLV(MNION,MNLEV),INDIO(MNION),
|
|
* NEVEN(MNION),NODD(MNION),NODD0,NLEVS(MNION),
|
|
* IATN(MNION),IONN(MNION),NNION
|
|
COMMON/PRINTP/TYPLEV
|
|
CHARACTER*10 TYPLEV(MLEVEL),typ
|
|
character*4 typ1
|
|
character*2 typ2
|
|
character*2 typin(60)
|
|
data typin /' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10',
|
|
* '11','12','13','14','15','16','17','18','19','20',
|
|
* '21','22','23','24','25','26','27','28','29','30',
|
|
* '31','32','33','34','35','36','37','38','39','40',
|
|
* '41','42','43','44','45','46','47','48','49','50',
|
|
* '51','52','53','54','55','56','57','58','59','60'/
|
|
C
|
|
C +++++++++++++++++++++++++++
|
|
C MODE = 0 - initialization
|
|
C +++++++++++++++++++++++++++
|
|
C
|
|
IF(MODE.EQ.0) THEN
|
|
NNION=0
|
|
READ(INLLEV,*,END=55,ERR=55) NNION
|
|
IF(NNION.LE.0) GO TO 55
|
|
DO I=1,NNION
|
|
READ(INLLEV,*) IATN(I),IONN(I)
|
|
READ(INLLEV,*) NEVEN(I)
|
|
IF(NEVEN(I).GT.0) THEN
|
|
DO J=1,NEVEN(I)
|
|
READ(INLLEV,*) ELIMEV(I,J)
|
|
END DO
|
|
READ(INLLEV,*) NODD(I)
|
|
NODD0=NODD(I)
|
|
IF(NODD(I).GT.0) THEN
|
|
DO J=1,NODD(I)
|
|
READ(INLLEV,*) ELIMOD(I,J)
|
|
END DO
|
|
ELSE
|
|
NODD(I)=NEVEN(I)
|
|
DO J=1,NODD(I)
|
|
ELIMOD(I,J)=ELIMEV(I,J)
|
|
END DO
|
|
END IF
|
|
INDION=0
|
|
DO IONEX=1,NION
|
|
N0I=NFIRST(IONEX)
|
|
IA=NUMAT(IATM(N0I))
|
|
IF(IA.EQ.IATN(I).AND.IZ(IONEX)-1.EQ.IONN(I)) INDION=IONEX
|
|
END DO
|
|
IF(INDION.LE.0) THEN
|
|
call quit(' INCONSISTENCY IN UNIT 13 INPUT - NLTE')
|
|
END IF
|
|
NOFF=NFIRST(INDION)-1
|
|
c
|
|
ine=1
|
|
ino=1
|
|
do ii=nfirst(indion),nlast(indion)
|
|
TYP=TYPLEV(II)
|
|
typ1=typ(2:5)
|
|
typ2=typ(8:9)
|
|
iev=0
|
|
if(typ1.eq.'even') iev=1
|
|
do k=1,60
|
|
if(typin(k).eq.typ2) ind=k
|
|
end do
|
|
if(iev.eq.1) then
|
|
indev(i,ine)=ii
|
|
write(11,*) 'super-e ',i,ii,ine,elimev(i,ine)
|
|
ine=ine+1
|
|
else
|
|
indod(i,ino)=ii
|
|
write(11,*) 'super-o ',i,ii,ino,elimod(i,ino)
|
|
ino=ino+1
|
|
end if
|
|
end do
|
|
END IF
|
|
END DO
|
|
C
|
|
55 CONTINUE
|
|
C
|
|
INDION=NNION
|
|
DO 90 IONEX=1,NION
|
|
N0I=NFIRST(IONEX)
|
|
IA=NUMAT(IATM(N0I))
|
|
if(isemex(ia).ge.1) go to 90
|
|
IONM1=IZ(IONEX)-1
|
|
IF(IA.EQ.1.OR.IA.EQ.2) GO TO 90
|
|
DO I=1,NNION
|
|
IF(IA.EQ.IATN(I).AND.IONM1.EQ.IONN(I)) GO TO 90
|
|
END DO
|
|
IF(NFIRST(IONEX).EQ.NLAST(IONEX)) GO TO 90
|
|
INDION=INDION+1
|
|
EION=ENION(NFIRST(IONEX))
|
|
NLEVS(INDION)=NLAST(IONEX)-NFIRST(IONEX)+1
|
|
INDIO(INDION)=IONEX
|
|
NEVEN(INDION)=0
|
|
IATN(INDION)=IA
|
|
IONN(INDION)=IONM1
|
|
DELE=0.
|
|
DO II=NFIRST(IONEX),NLAST(IONEX)
|
|
I=II-NFIRST(IONEX)+1
|
|
E=(EION-ENION(II))*ECONST
|
|
IF(II.LT.NLAST(IONEX)) THEN
|
|
E1=(EION-ENION(II+1))*ECONST
|
|
DELE=0.5*(E1-E)
|
|
ELIML(INDION,I)=E+DELE
|
|
ELSE
|
|
IF(INLTE.GE.2) THEN
|
|
ELIML(INDION,I)=E+DELE
|
|
ELSE
|
|
ELIML(INDION,I)=EION*ECONST
|
|
END IF
|
|
END IF
|
|
INDLV(INDION,I)=II
|
|
END DO
|
|
90 CONTINUE
|
|
NNION=INDION
|
|
|
|
C Header for the table with the level assignments
|
|
C
|
|
if(inlte.gt.0.and.iprin.ge.1)
|
|
* WRITE(11,*)'NLTSET: IAT ION LAMBDA EXCL '//
|
|
* ' EXCU ILWN IUN'
|
|
|
|
RETURN
|
|
END IF
|
|
C
|
|
C
|
|
C ++++++++++++++++++++++++++++++++++++++++++
|
|
C MODE > 0 - level indices for the line IL
|
|
C ++++++++++++++++++++++++++++++++++++++++++
|
|
C
|
|
IF(NNION.LE.0) RETURN
|
|
INION=0
|
|
IONM1=ION-1
|
|
DO I=1,NNION
|
|
IF(IAT.EQ.IATN(I).AND.IONM1.EQ.IONN(I)) INION=I
|
|
END DO
|
|
if(isemex(iat).ge.1) RETURN
|
|
IF(INION.LE.0) RETURN
|
|
IF(NEVEN(INION).EQ.0) IEVEN=2
|
|
IF(NEVEN(INION).LT.0) GOTO 400
|
|
C
|
|
IF(IEVEN.EQ.1) THEN
|
|
IND=0
|
|
DO 110 J=1,NEVEN(INION)
|
|
IF(EXCL.LE.ELIMEV(INION,J)) THEN
|
|
IND=J
|
|
GO TO 120
|
|
END IF
|
|
110 CONTINUE
|
|
ILWN=0
|
|
GO TO 145
|
|
120 CONTINUE
|
|
ILWN=INDEV(INION,IND)
|
|
C
|
|
IND=0
|
|
DO 130 J=1,NODD(INION)
|
|
IF(EXCU.LE.ELIMOD(INION,J)) THEN
|
|
IND=J
|
|
GO TO 140
|
|
END IF
|
|
130 CONTINUE
|
|
IUN=0
|
|
GO TO 145
|
|
140 CONTINUE
|
|
IUN=INDOD(INION,IND)
|
|
|
|
145 CONTINUE
|
|
C
|
|
ELSE IF(IEVEN.EQ.0) THEN
|
|
IND=0
|
|
DO 150 J=1,NODD(INION)
|
|
IF(EXCL.LE.ELIMOD(INION,J)) THEN
|
|
IND=J
|
|
GO TO 160
|
|
END IF
|
|
150 CONTINUE
|
|
ILWN=0
|
|
GO TO 200
|
|
160 CONTINUE
|
|
ILWN=INDOD(INION,IND)
|
|
C
|
|
IND=0
|
|
DO 170 J=1,NEVEN(INION)
|
|
IF(EXCU.LE.ELIMEV(INION,J)) THEN
|
|
IND=J
|
|
GO TO 180
|
|
END IF
|
|
170 CONTINUE
|
|
IUN=0
|
|
GO TO 200
|
|
180 CONTINUE
|
|
IUN=INDEV(INION,IND)
|
|
200 CONTINUE
|
|
c
|
|
c transition between levels without a distinction in parity
|
|
c
|
|
ELSE
|
|
|
|
IF (ILIMITS(INDIO(INION)).EQ.0.OR.INLIST.GE.10) THEN
|
|
C level identification: using only energy limits
|
|
C
|
|
IND=0
|
|
DO 210 J=1,NLEVS(INION)
|
|
IF(EXCL.LE.ELIML(INION,J)) THEN
|
|
IND=J
|
|
GO TO 220
|
|
END IF
|
|
210 CONTINUE
|
|
ILWN=0
|
|
IUN=0
|
|
GO TO 300
|
|
220 CONTINUE
|
|
ILWN=INDLV(INION,IND)
|
|
C
|
|
IND=0
|
|
DO 230 J=1,NLEVS(INION)
|
|
IF(EXCU.LE.ELIML(INION,J)) THEN
|
|
IND=J
|
|
GO TO 240
|
|
END IF
|
|
230 CONTINUE
|
|
IUN=0
|
|
GO TO 300
|
|
240 CONTINUE
|
|
IUN=INDLV(INION,IND)
|
|
300 CONTINUE
|
|
|
|
ELSE IF (ILIMITS(INDIO(INION)).EQ.1.and.inlist.lt.10) THEN
|
|
C
|
|
C level identification: using energy limits and quantum numbers
|
|
C
|
|
|
|
IND=0
|
|
INMATCHL=0
|
|
DO 310 J=1,NLEVS(INION)
|
|
|
|
IF(EXCL.GE.ENION1(INDLV(INION,J)) .AND.
|
|
* EXCL.LE.ENION2(INDLV(INION,J)). AND.
|
|
* ((IPQL.GE.PQUANT1(INDLV(INION,J)).AND.
|
|
* IPQL.LE.PQUANT2(INDLV(INION,J))).OR.
|
|
* (IPQL.EQ.-1)) .AND.
|
|
* ((ISQL.GE.SQUANT1(INDLV(INION,J)).AND.
|
|
* ISQL.LE.SQUANT2(INDLV(INION,J))).OR.
|
|
* (ISQL.EQ.-1)) .AND.
|
|
* ((ILQL.GE.LQUANT1(INDLV(INION,J)).AND.
|
|
* ILQL.LE.LQUANT2(INDLV(INION,J))).OR.
|
|
* (ILQL.EQ.-1))
|
|
* ) THEN
|
|
|
|
IND=J
|
|
INMATCHL=INMATCHL+1
|
|
C GO TO 320
|
|
END IF
|
|
310 CONTINUE
|
|
IF (INMATCHL.GT.1)
|
|
* WRITE(11,'(A55,1X,F12.4)')
|
|
* ' NLTSET: WARNING-- multiple matches for lower level of ',
|
|
* ALAM0
|
|
IF (INMATCHL.GT.0) GO TO 320
|
|
ILWN=0
|
|
IUN=0
|
|
GO TO 350
|
|
320 CONTINUE
|
|
ILWN=INDLV(INION,IND)
|
|
C
|
|
C
|
|
IND=0
|
|
INMATCHU=0
|
|
DO 330 J=1,NLEVS(INION)
|
|
|
|
IF(EXCU.GE.ENION1(INDLV(INION,J)) .AND.
|
|
* EXCU.LE.ENION2(INDLV(INION,J)). AND.
|
|
* ((IPQU.GE.PQUANT1(INDLV(INION,J)).AND.
|
|
* IPQU.LE.PQUANT2(INDLV(INION,J))).OR.
|
|
* (IPQU.EQ.-1)) .AND.
|
|
* ((ISQU.GE.SQUANT1(INDLV(INION,J)).AND.
|
|
* ISQU.LE.SQUANT2(INDLV(INION,J))).OR.
|
|
* (ISQU.EQ.-1)) .AND.
|
|
* ((ILQU.GE.LQUANT1(INDLV(INION,J)).AND.
|
|
* ILQU.LE.LQUANT2(INDLV(INION,J))).OR.
|
|
* (ILQU.EQ.-1))
|
|
* ) THEN
|
|
|
|
IND=J
|
|
INMATCHU=INMATCHU+1
|
|
C GO TO 340
|
|
END IF
|
|
330 CONTINUE
|
|
IF (INMATCHU.GT.1)
|
|
* WRITE(11,'(A55,1X,F12.4)')
|
|
* ' NLTSET: WARNING-- multiple matches for upper level of ',
|
|
* ALAM0
|
|
IF (INMATCHU.GT.0) GO TO 340
|
|
IUN=0
|
|
GO TO 350
|
|
340 CONTINUE
|
|
IUN=INDLV(INION,IND)
|
|
350 CONTINUE
|
|
|
|
IF (INMATCHL.EQ.0.or.INMATCHU.EQ.0) THEN
|
|
ILMATCH=0
|
|
ELSE IF (INMATCHL.GT.1.or.INMATCHU.GT.1) THEN
|
|
ILMATCH=2
|
|
ELSE
|
|
ILMATCH=1
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
write(11,*)('ILIMITS is neither 0 or 1')
|
|
|
|
END IF
|
|
|
|
if(inlte.gt.0.and.iprin.ge.1)
|
|
* WRITE(11,'(10x,2(i2,1x),3x,3(F10.3,1x),2(i4,1x))')IAT,ION,
|
|
* ALAM0,EXCL,EXCU,ILWN,IUN
|
|
|
|
END IF
|
|
C
|
|
400 IF(NEVEN(INION).LT.0) THEN
|
|
NEV1=-NEVEN(INION)
|
|
IF(IEVEN.EQ.1) THEN
|
|
ILWN=0
|
|
J=1
|
|
DO WHILE (ILWN.EQ.0 .AND. J.LE.NEV1)
|
|
IF(QL.EQ.ELIMEV(INION,J)) THEN
|
|
DE=ENREV(INION,J)
|
|
IF(EXCL.NE.0.) DE=(EXCL-DE)/EXCL
|
|
IF(ABS(DE).LT.1.D-5) ILWN=INDEV(INION,J)
|
|
END IF
|
|
J=J+1
|
|
END DO
|
|
IUN=0
|
|
J=1
|
|
DO WHILE (IUN.EQ.0 .AND. J.LE.NODD(INION))
|
|
IF(QU.EQ.ELIMOD(INION,J)) THEN
|
|
DE=(EXCU-ENROD(INION,J))/EXCU
|
|
IF(ABS(DE).LT.1.D-5) IUN=INDOD(INION,J)
|
|
END IF
|
|
J=J+1
|
|
END DO
|
|
ELSE IF(IEVEN.EQ.0) THEN
|
|
ILWN=0
|
|
J=1
|
|
DO WHILE (ILWN.EQ.0 .AND. J.LE.NODD(INION))
|
|
IF(QL.EQ.ELIMOD(INION,J)) THEN
|
|
DE=ENROD(INION,J)
|
|
IF(EXCL.NE.0.) DE=(EXCL-DE)/EXCL
|
|
IF(ABS(DE).LT.1.D-5) ILWN=INDOD(INION,J)
|
|
END IF
|
|
J=J+1
|
|
END DO
|
|
IUN=0
|
|
J=1
|
|
DO WHILE (IUN.EQ.0 .AND. J.LE.NEV1)
|
|
IF(QU.EQ.ELIMEV(INION,J)) THEN
|
|
DE=(EXCU-ENREV(INION,J))/EXCU
|
|
IF(ABS(DE).LT.1.D-5) IUN=INDEV(INION,J)
|
|
END IF
|
|
J=J+1
|
|
END DO
|
|
END IF
|
|
END IF
|
|
C
|
|
IF(INLTE.EQ.5) THEN
|
|
INNLT0=INNLT0+1
|
|
INDNLT(IL)=INNLT0
|
|
ELSE IF(INLTE.EQ.4) THEN
|
|
IF(ILWN.GT.0.AND.IUN.GT.0) THEN
|
|
INDNLT(IL)=-1
|
|
END IF
|
|
ELSE IF(INLTE.EQ.3) THEN
|
|
IF(ILWN.GT.0) THEN
|
|
INDNLT(IL)=-1
|
|
END IF
|
|
ELSE
|
|
INDNLT(IL)=-1
|
|
END IF
|
|
BNUL(IL)=real(BN*(FREQ0(IL)*1.E-15)**3)
|
|
ILOWN(IL)=ILWN
|
|
IUPN(IL)=IUN
|
|
RETURN
|
|
END
|