SpectraRust/tlusty/extracted/emat.f
2026-03-19 14:05:33 +08:00

40 lines
947 B
Fortran

SUBROUTINE EMAT(ID)
C ===================
C
C Auxiliary procedure for SOLVE
C
C sub-sub-diagonal band matrix E
C
C Input: ID - depth index
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'ATOMIC.FOR'
INCLUDE 'MODELQ.FOR'
INCLUDE 'ARRAY1.FOR'
INCLUDE 'ALIPAR.FOR'
C
IF(IFALI.LE.7) RETURN
IF(ID.LE.2) RETURN
NSE=NFREQE+INSE-1
IF(INHE.GT.0) THEN
NHE=NFREQE+INHE
IF(INRE.GT.0) E(NHE,NFREQE+INRE)=EHET(ID)*PCK
IF(INPC.GT.0) E(NHE,NFREQE+INPC)=EHEN(ID)*PCK
DO II=1,NLVEXP
E(NHE,NSE+II)=EHEP(II,ID)*PCK
END DO
END IF
C
IF(INRE.GT.0.AND.REDIF(ID).GT.0.) THEN
NRE=NFREQE+INRE
IF(INRE.GT.0) E(NRE,NRE)=ERET(ID)*REDIF(ID)
IF(INPC.GT.0) E(NRE,NFREQE+INPC)=EREN(ID)*REDIF(ID)
DO II=1,NLVEXP
E(NRE,NSE+II)=EREP(II,ID)*REDIF(ID)
END DO
END IF
RETURN
END