107 lines
2.8 KiB
Fortran
107 lines
2.8 KiB
Fortran
SUBROUTINE BPOPF(ID)
|
|
C =====================
|
|
C
|
|
C the part of B-matrix corresponding to the population rows and
|
|
C populations - i.e. derivatives of the ALI points intensities
|
|
C wrt. populations
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ARRAY1.FOR'
|
|
INCLUDE 'ALIPAR.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
C
|
|
NSE=NFREQE+INSE-1
|
|
NRE=NFREQE+INRE
|
|
NPC=NFREQE+INPC
|
|
C
|
|
C matrix B of complete linearization
|
|
C
|
|
DO I=1,NLVEXP
|
|
SUMT=0.
|
|
SUMN=0.
|
|
DO II=1,NLVEXP
|
|
IF(IFPOPR.LE.3) THEN
|
|
SUMT=SUMT-ESEMAT(I,II)*APT(II,ID)
|
|
SUMN=SUMN-ESEMAT(I,II)*APN(II,ID)
|
|
SUM=0.
|
|
DO J=1,NLVEXP
|
|
SUM=SUM-ESEMAT(I,J)*APP(II,J,ID)
|
|
END DO
|
|
ELSE
|
|
SUM=APP(II,I,ID)
|
|
END IF
|
|
B(NSE+I,NSE+II)=B(NSE+I,NSE+II)+SUM
|
|
END DO
|
|
IF(IFPOPR.GT.3) THEN
|
|
SUMT=APT(I,ID)
|
|
SUMN=APN(I,ID)
|
|
END IF
|
|
IF(INRE.NE.0) B(NSE+I,NRE)=B(NSE+I,NRE)+SUMT
|
|
IF(INPC.NE.0) B(NSE+I,NPC)=B(NSE+I,NPC)+SUMN
|
|
END DO
|
|
IF(CRSW(ID).NE.UN) THEN
|
|
DO I=1,NLVEXP
|
|
DO II=1,NLVEXP
|
|
B(NSE+I,NSE+II)=B(NSE+I,NSE+II)*CRSW(ID)
|
|
END DO
|
|
END DO
|
|
END IF
|
|
C
|
|
C matrix A and C of complete linearization
|
|
C
|
|
IF(IFALI.GE.6) THEN
|
|
DO I=1,NLVEXP
|
|
ASUMT=0.
|
|
ASUMN=0.
|
|
CSUMT=0.
|
|
CSUMN=0.
|
|
DO II=1,NLVEXP
|
|
IF(IFPOPR.LE.3) THEN
|
|
ASUMT=ASUMT-ESEMAT(I,II)*AAPT(II,ID)
|
|
ASUMN=ASUMN-ESEMAT(I,II)*AAPN(II,ID)
|
|
CSUMT=CSUMT-ESEMAT(I,II)*CAPT(II,ID)
|
|
CSUMN=CSUMN-ESEMAT(I,II)*CAPN(II,ID)
|
|
ASUM=0.
|
|
CSUM=0.
|
|
DO J=1,NLVEXP
|
|
ASUM=ASUM-ESEMAT(I,J)*AAPP(II,J,ID)
|
|
CSUM=CSUM-ESEMAT(I,J)*CAPP(II,J,ID)
|
|
END DO
|
|
ELSE
|
|
ASUM=AAPP(II,I,ID)
|
|
CSUM=CAPP(II,I,ID)
|
|
END IF
|
|
A(NSE+I,NSE+II)=ASUM
|
|
C(NSE+I,NSE+II)=CSUM
|
|
END DO
|
|
IF(IFPOPR.GT.3) THEN
|
|
ASUMT=AAPT(I,ID)
|
|
ASUMN=AAPN(I,ID)
|
|
CSUMT=CAPT(I,ID)
|
|
CSUMN=CAPN(I,ID)
|
|
END IF
|
|
IF(INRE.NE.0) THEN
|
|
A(NSE+I,NRE)=A(NSE+I,NRE)+ASUMT
|
|
C(NSE+I,NRE)=C(NSE+I,NRE)+CSUMT
|
|
END IF
|
|
IF(INPC.NE.0) THEN
|
|
A(NSE+I,NPC)=A(NSE+I,NPC)+ASUMN
|
|
C(NSE+I,NPC)=C(NSE+I,NPC)+CSUMN
|
|
END IF
|
|
END DO
|
|
C
|
|
IF(CRSW(ID).NE.UN) THEN
|
|
DO I=1,NLVEXP
|
|
DO II=1,NLVEXP
|
|
A(NSE+I,NSE+II)=A(NSE+I,NSE+II)*CRSW(ID)
|
|
C(NSE+I,NSE+II)=C(NSE+I,NSE+II)*CRSW(ID)
|
|
END DO
|
|
END DO
|
|
END IF
|
|
END IF
|
|
RETURN
|
|
END
|