156 lines
4.6 KiB
Fortran
156 lines
4.6 KiB
Fortran
SUBROUTINE OPAINI(IMOD)
|
|
C =======================
|
|
C
|
|
C initialization of only depth-dependent quantities
|
|
C for evaluation of opacities
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
INCLUDE 'ALIPAR.FOR'
|
|
DIMENSION PRF(MFREQL),POPP(MLEVEL)
|
|
PARAMETER (CFF1=1.3727D-25,CFF2=4.3748D-10,CFF3=2.5993D-7)
|
|
PARAMETER (SIXTH=UN/6.,CCOR=0.09,T32=1.5D0)
|
|
PARAMETER (SGFF0 = 3.694D8)
|
|
DATA ICOMP /0/
|
|
C
|
|
DO ID=1,ND
|
|
WMT=WMM(ID)*YTOT(ID)
|
|
T=TEMP(ID)
|
|
ANE=ELEC(ID)
|
|
ELEC1(ID)=UN/ANE
|
|
DENS1(ID)=UN/DENS(ID)
|
|
DENSI(ID)=DENS1(ID)
|
|
DENSIM(ID)=DENSI(ID)*WMM(ID)
|
|
ELSCAT(ID)=ANE*SIGE
|
|
CALL DWNFR0(ID)
|
|
CALL WNSTOR(ID)
|
|
CALL SABOLF(ID)
|
|
CALL REFLEV(ID,IMOD)
|
|
CALL LEVGRP(ID,IIEXP,0,POPP)
|
|
DO II=1,NLEVEL
|
|
POPINV(II,ID)=0.
|
|
IF(POPUL(II,ID).NE.0.) POPINV(II,ID)=UN/POPUL(II,ID)
|
|
END DO
|
|
DO II=1,NLEVEL
|
|
IIE=IIEXP(II)
|
|
IF(IIE.EQ.0) THEN
|
|
IE=ILTREF(II,ID)
|
|
PP(II,ID)=POPUL(II,ID)*POPINV(IE,ID)
|
|
IF(IABS(IMODL(II)).LE.5) THEN
|
|
PT(II,ID)=POPUL(II,ID)*DSBPST(II,ID)
|
|
PN(II,ID)=POPUL(II,ID)*DSBPSN(II,ID)
|
|
END IF
|
|
ELSE IF(IIE.LT.0) THEN
|
|
PP(II,ID)=SBPSI(II,ID)
|
|
END IF
|
|
END DO
|
|
DO ION=1,NION
|
|
USUMS(ION,ID)=USUM(ION)
|
|
DUSMT(ION,ID)=DUSUMT(ION)
|
|
DUSMN(ION,ID)=DUSUMN(ION)
|
|
ENDDO
|
|
c
|
|
c quantities for the bound-free opacity
|
|
c
|
|
DO IBFT=1,NTRANC
|
|
ITR=ITRBF(IBFT)
|
|
II=ILOW(ITR)
|
|
JJ=IUP(ITR)
|
|
IT=ITRA(JJ,II)
|
|
IE=IEL(II)
|
|
NKE=NNEXT(IE)
|
|
CORR=UN
|
|
IF(NKE.NE.JJ) CORR=G(NKE)/G(JJ)*
|
|
* EXP((ENION(NKE)-ENION(JJ))*TK1(ID))
|
|
ABTRA(ITR,ID)=POPUL(II,ID)
|
|
EMTRA(ITR,ID)=POPUL(JJ,ID)*ANE*SBF(II)*WOP(II,ID)*CORR
|
|
DEMLT(ITR,ID)=-(T32+FR0(ITR)*HKT1(ID))/TEMP(ID)
|
|
END DO
|
|
c
|
|
c quantities for the free-free opacity
|
|
c
|
|
IF(IELHM.GT.0) THEN
|
|
CFFN(ID)=POPUL(NFIRST(IELH),ID)*ANE
|
|
CFFT(ID)=CFF2-CFF3/T
|
|
END IF
|
|
SGFF=SGFF0/SQT1(ID)*ANE
|
|
DO ION=1,NION
|
|
SFF2(ION,ID)=EXP(FF(ION)*HKT1(ID))
|
|
SFF3(ION,ID)=POPUL(NNEXT(ION),ID)*CHARG2(ION)*SGFF
|
|
DSFF(ION,ID)=(FF(ION)*HKT1(ID)+HALF)*TEMP1(ID)
|
|
END DO
|
|
END DO
|
|
if(izscal.eq.1) then
|
|
do id=1,nd
|
|
densi(id)=un
|
|
densim(id)=0.
|
|
end do
|
|
end if
|
|
CALL SGMER0
|
|
C
|
|
C initialization of the line opacity
|
|
C
|
|
LASER=ITER.GT.ITLAS
|
|
DO 200 ITR=1,NTRANS
|
|
INDXA=IABS(INDEXP(ITR))
|
|
IF(.NOT.LINE(ITR)) GO TO 200
|
|
II=ILOW(ITR)
|
|
JJ=IUP(ITR)
|
|
IF(INDXA.NE.0.AND.INTMOD(ITR).NE.0 .AND. ICOMP.EQ.0) THEN
|
|
IJL0=IFR0(ITR)
|
|
IJL1=IFR1(ITR)
|
|
IF(ISPODF.GE.1) THEN
|
|
IJL0=KFR0(ITR)
|
|
IJL1=KFR1(ITR)
|
|
END IF
|
|
IF(INDXA.LT.2.OR.INDXA.GT.4) THEN
|
|
DO ID=1,ND
|
|
CALL LINPRO(ITR,ID,PRF)
|
|
DO IJ=IJL0,IJL1
|
|
PRFLIN(ID,IJ)=real(PRF(IJ-IJL0+1))
|
|
END DO
|
|
END DO
|
|
END IF
|
|
END IF
|
|
GG=G(II)/G(JJ)
|
|
DO ID=1,ND
|
|
IF(IFWOP(JJ).GE.0) THEN
|
|
PI=POPUL(II,ID)*WOP(JJ,ID)
|
|
PJ=GG*POPUL(JJ,ID)*WOP(II,ID)
|
|
ELSE
|
|
PI=POPUL(II,ID)
|
|
PJ=G(II)/GMER(IMRG(JJ),ID)*POPUL(JJ,ID)*WOP(II,ID)
|
|
END IF
|
|
ABTRA(ITR,ID)=PI
|
|
EMTRA(ITR,ID)=PJ*EXP(FR0(ITR)*HKT1(ID))
|
|
DEMLT(ITR,ID)=-FR0(ITR)*HKT21(ID)
|
|
IF(LASER) THEN
|
|
qtt=0.
|
|
if(pi.ne.pj) QTT=PJ/(PI-PJ)*(EXP(FR0(ITR)*HKT1(ID))-UN)
|
|
lfr=fr0(itr).lt.frtabm.and.iadop(iatm(ii)).gt.0
|
|
IF(QTT.LT.0. .OR. QTT.GT.QTLAS .or. lfr) THEN
|
|
ABTRA(ITR,ID)=0.
|
|
EMTRA(ITR,ID)=0.
|
|
DEMLT(ITR,ID)=0.
|
|
END IF
|
|
END IF
|
|
c
|
|
c set up ABTRA and EMTRA to 0 in the range where
|
|
c the hydrogen opacity is calculated from Gomez tables
|
|
c
|
|
if(ihgom.gt.0.and.elec(id).gt.hglim) then
|
|
if(ii.ge.n0hn.and.ii.le.n0hn-1+ihgom) then
|
|
abtra(itr,id)=0.
|
|
emtra(itr,id)=0.
|
|
demlt(itr,id)=0.
|
|
end if
|
|
end if
|
|
END DO
|
|
200 CONTINUE
|
|
ICOMP=1
|
|
RETURN
|
|
END
|