110 lines
3.1 KiB
Fortran
110 lines
3.1 KiB
Fortran
SUBROUTINE BPOPC(ID)
|
|
C ====================
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ARRAY1.FOR'
|
|
INCLUDE 'ALIPAR.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
COMMON/ADCHAR/QADD(MDEPTH)
|
|
DIMENSION AJ(MLEVEL)
|
|
C
|
|
NSE=NFREQE+INSE-1
|
|
NPC=NFREQE+INPC
|
|
IF(IELH.GT.0) N0HN=NFIRST(IELH)
|
|
NKH=NREFS(IATREF,ID)
|
|
NKH=IABS(IIEXP(NKH))
|
|
T=TEMP(ID)
|
|
ANE=ELEC(ID)
|
|
HKT=HK/T
|
|
TK=HKT/H
|
|
ANMNE1=WMM(ID)*DENS1(ID)
|
|
DO I=1,NLEVEL
|
|
AJ(I)=0.
|
|
END DO
|
|
C
|
|
C *************************
|
|
C remaining equation - (NFREQE+INPC)-th row
|
|
C linearized charge conservation equation
|
|
C *************************
|
|
C
|
|
C This part is very similar to procedure ELCOR (obviously);
|
|
C array AJ has the meaning of coefficients of the charge conserv.
|
|
C ie. charge conservation is written
|
|
C AJ * (vector of populations) = electron density
|
|
C then
|
|
C APTT = (vector of populations) * (derivative AJ wrt temp)
|
|
C APNN = (vector of populations) * (derivative AJ wrt n(el))
|
|
C APM = (vector of populations) * (derivative AJ wrt N)
|
|
C
|
|
IF(INPC.EQ.0) RETURN
|
|
QQ=0.
|
|
if(ifmol.eq.0.or.t.gt.tmolim) then
|
|
CALL STATE(3,ID,T,ANE)
|
|
QQ=Q*ABUND(IATREF,ID)/YTOT(ID)
|
|
if(ioptab.gt.0) QQ=Q/YTOT(ID)
|
|
else
|
|
qq=qadd(id)*anmne1
|
|
dqt=0.
|
|
dqn=0.
|
|
end if
|
|
C
|
|
APTT=0.
|
|
APNN=0.
|
|
APM=0.
|
|
VPC=QFIX(ID)+QQ/ANMNE1
|
|
DO IAT=1,NATOM
|
|
IF(IIFIX(IAT).NE.1) THEN
|
|
DO I=N0A(IAT),NKA(IAT)
|
|
IF(IPZERO(I,ID).EQ.0) THEN
|
|
IL=ILK(I)
|
|
II=IIEXP(I)
|
|
IF(IL.EQ.0) THEN
|
|
CH=IZ(IEL(I))-1
|
|
DCHT=0.
|
|
DCHN=0.
|
|
ELSE
|
|
CH=IZ(IL)+(IZ(IL)-1)*USUM(IL)*ANE
|
|
DCHT=(IZ(IL)-1)*ANE*DUSUMT(IL)*POPUL(I,ID)
|
|
DCHN=(IZ(IL)-1)*(ANE*DUSUMN(IL)+USUM(IL))*POPUL(I,ID)
|
|
END IF
|
|
IF(IMODL(I).GE.0) VPC=VPC+CH*POPUL(I,ID)
|
|
IF(II.GT.0) THEN
|
|
AJ(II)=AJ(II)+CH
|
|
APTT=APTT+DCHT
|
|
APNN=APNN+DCHN
|
|
ELSE IF(II.LT.0) THEN
|
|
AJ(-II)=AJ(-II)+CH*SBPSI(I,ID)
|
|
APTT=APTT+DCHT*SBPSI(I,ID)
|
|
APNN=APNN+DCHN*SBPSI(I,ID)
|
|
ELSE
|
|
III=IIEXP(ILTREF(I,ID))
|
|
AJ(III)=AJ(III)+CH*SBPSI(I,ID)
|
|
APTT=APTT+CH*POPUL(I,ID)*DSBPST(I,ID)
|
|
APNN=APNN+CH*POPUL(I,ID)*DSBPSN(I,ID)
|
|
END IF
|
|
END IF
|
|
END DO
|
|
END IF
|
|
END DO
|
|
C
|
|
C (NFREQE+INPC)-th row of matrix B
|
|
C
|
|
NPC=NFREQE+INPC
|
|
QQQ=ABUND(IATREF,ID)/YTOT(ID)/ANMNE1
|
|
if(ioptab.gt.0) QQQ=UN/YTOT(ID)/ANMNE1
|
|
IF(INHE.NE.0) B(NPC,NFREQE+INHE)=APM+QQ
|
|
IF(INRE.NE.0) B(NPC,NFREQE+INRE)=APTT+QQQ*DQT
|
|
B(NPC,NPC)=APNN-QQ-UN+QQQ*DQN
|
|
DO II=1,NLVEXP
|
|
B(NPC,NSE+II)=AJ(II)
|
|
END DO
|
|
C
|
|
C (NFREQE+INPC)-th element of the rhs vector VECL
|
|
C
|
|
VECL(NPC)=ANE-VPC
|
|
RETURN
|
|
END
|