C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
SUBROUTINE ETOT_DIV(ISTR,TOTCH,ETOT1,ETOT2,EPC,ETONEW,ZVCOU)
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
IMPLICIT REAL(A-H,O-Y)
IMPLICIT COMPLEX(Z)
INCLUDE 'PACVPP'
C VPP-PARALLEL
!XOCL SUBPROCESSOR PS(IPARA)=PQ(1:IPARA)
!XOCL INDEX PARTITION IP=(PS,INDEX=1:KNV3,PART=BAND)
DIMENSION SSS(KNG1,KNV3,KTYP,10),ZZZ(KNG1,KEG,KNV3)
& ,ZFC(KEG,KNV3,KATM,10)
DIMENSION EKK(KEG,KNV3),OCCUU(KEG,KNV3),RAA(KNG1,KNV3)
!XOCL LOCAL SSS(:,/IP,:,:),ZZZ(:,:,/IP),ZFC(:,/IP,:,:)
!XOCL LOCAL EKK(:,/IP),OCCUU(:,/IP),RAA(:,/IP)
EQUIVALENCE (SNL,SSS),(ZAJ,ZZZ),(ZFBB,ZFC)
& ,(EKO,EKK),(OCCUP,OCCUU),(RAK,RAA)
C EIGEN-VALUE PROBLEM
DIMENSION ZDEVC(KNG1,KEG)
& ,EMAS(KEG),ZVCOU(KNG)
C-----ARRAYS FOR MFFT--------------------------------------------
DIMENSION ZEV3C(IFX2,IFY2,IFZ2),ZV3D(IFX2,IFY2,IFZ2)
DIMENSION IWL(8*IFX2+28),IWM(8*IFY2+28),IWN(8*IFZ2+28)
& ,IWORK(2*IFX2)
C================================================================
EQUIVALENCE (ZV1D(1),ZV3D(1,1,1)),(ZC1D(1),ZEV3C(1,1,1))
C==== ATTN KX1 OR KX11 ==========================================
C REWIND 90
KFT1 = IFX2
KFT2 = IFY2
KFT3 = IFZ2
KSUM=KFT1*KFT2*KFT3
KVOL=(KFT1-1)*KFT2*KFT3
CCC = 2.D0*RVOL/(2.D0*PAI)**3/FLOAT(KV3)
C---------- MASS OF ELECTRON -----
C DO 4 I=1,KG
C ZCHGO(I) = ZCHG(I)
C ZCHG(I) = DCMPLX(0.0D0,0.0D0)
C 4 CONTINUE
C FOR STRESS (CALL KBINT & FORZFB 1992 1/7)
C IF(ISTR.EQ.1) THEN
C WRITE (6,*) 'KBINT ITER>IMD IN MSD'
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
C CALL KBINT
C^^^^^ STRESS ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
C CALL FORZFB
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
C END IF
C ////////////////////////////////////
C // CALCULATE THE VERLET ALGORITHM //
C ////////////////////////////////////
ETOT_EX = DREAL(DCONJG(ZEXC(1))*(ZCHG(1)+ZRHPC(1)))
C ETOT_EX = DREAL(DCONJG(ZEXC(1))*(ZCHG(1)))
ETOT_PSL= DREAL(DCONJG(ZPSCC(1))*ZCHG(1))
ETOT_HRT= 0.0D0
DO 2001 I=2,KG
ZVCOU(I)= PAI4*ZCHG(I)*RGG(I)
C ETOT_DIV, 2/23, 2002
ETOT_EX = ETOT_EX
& + DREAL(DCONJG(ZEXC(I))*(ZCHG(I)+ZRHPC(I)))
C & + DREAL(DCONJG(ZEXC(I))*(ZCHG(I)))
ETOT_PSL= ETOT_PSL
& + DREAL(DCONJG(ZPSCC(I))*ZCHG(I))
ETOT_HRT= ETOT_HRT
& + DREAL(ZVCOU(I)*DCONJG(ZCHG(I)))
2001 CONTINUE
C
ETOT_KIN = 0.0D0
ETOT_VNL = 0.0D0
!XOCL SPREAD NOBARRIER DO /IP
DO 100 NNN=1,KV3
C IWRT(NNN) =NNN
AKX = VX(NNN)
AKY = VY(NNN)
AKZ = VZ(NNN)
IIBA = IBA(NNN)
DO 2002 J=1,IIBA
X(J) = 0.0D0
VKIN =
& ( (AKX+GX(NBASE(J,NNN)))**2
& + (AKY+GY(NBASE(J,NNN)))**2
& + (AKZ+GZ(NBASE(J,NNN)))**2 )/2.D0
Y3(J) = VKIN
2002 CONTINUE
C-----BAND LOOP----------------------------------------------
DO 200 IBAN=NBD1,NBD2
C
DO 71 I=1,KNG1
ETOT_KIN = ETOT_KIN +
& OCCUU(IBAN,NNN)*Y3(I)*DCONJG(ZZZ(I,IBAN,NNN))*ZZZ(I,IBAN,NNN)
71 CONTINUE
DO 401 IA=1,KATM
C
RWS =WS(KFTYPE(IA))*UNIVOL
RWP =WP(KFTYPE(IA))*UNIVOL
CWL(1)= RWS
CWL(2)= RWP
CWL(3)= RWP
CWL(4)= RWP
IF (NLSPD(KFTYPE(IA)).EQ.1) THEN
LNUM = 4
ELSE
LNUM = 9
RWD =WD(KFTYPE(IA))*UNIVOL
CWL(5)= RWD
CWL(6)= RWD
CWL(7)= RWD
CWL(8)= RWD
CWL(9)= RWD
END IF
C
DO 411 L =1,LNUM
ETOT_VNL = ETOT_VNL + CWL(L)*
& OCCUU(IBAN,NNN)*DCONJG(ZFC(IBAN,NNN,IA,L))*ZFC(IBAN,NNN,IA,L)
411 CONTINUE
401 CONTINUE
C-------------------------------------------------------------------
200 CONTINUE
100 CONTINUE
C
C 9/5, 2007, BAND ENERGY
C
FFF = FLOAT(KV3)
TTT = 0.D0
!XOCL SPREAD NOBARRIER DO /IP
DO 500 I=1,KV3
DO 600 IBAN=NBD1,NBD2
TTT = TTT + OCCUU(IBAN,I)*EKK(IBAN,I)
600 CONTINUE
500 CONTINUE
!XOCL END SPREAD SUM(TTT)
EBAND = 2.D0*TTT/FFF
C
ETOTAL2 = ETOT1*TOTCH + ETOT2
WRITE (6,*) '-EPC = ',-EPC
WRITE (6,*) 'ETOT1,2 = ',ETOTAL2
ETOT4 =
& UNIVOL*ETOT_EX + UNIVOL*ETOT_PSL + 0.5D0*UNIVOL*ETOT_HRT
& + 1.0D0*UNIVOL*CCC*ETOT_KIN + 1.0D0*UNIVOL*CCC*ETOT_VNL
& - EPC
ETOTAL2 = ETOTAL2 + ETOT4
WRITE (6,*) 'ETOT_EX = ',ETOT_EX
WRITE (6,*) 'ETOT_PSL= ',ETOT_PSL
WRITE (6,*) 'ETOT_HRT= ',ETOT_HRT
WRITE (6,*) 'ETOT_KIN= ',ETOT_KIN
WRITE (6,*) 'ETOT_VNL= ',ETOT_VNL
WRITE (6,*) 'EBAND === ',EBAND
WRITE (6,*) 'V*E_EX = ',UNIVOL*ETOT_EX
WRITE (6,*) 'V*E_PSL = ',UNIVOL*ETOT_PSL
WRITE (6,*) 'V*E_HRT/2 = ',0.5*UNIVOL*ETOT_HRT
WRITE (6,*) '1*V*C*E_KIN = ',1.0D0*UNIVOL*CCC*ETOT_KIN
WRITE (6,*) '1*V*C*E_VNL=',1.0D0*UNIVOL*CCC*ETOT_VNL
WRITE (6,*) 'ETOTAL2 = ',ETOTAL2
WRITE (6,*) 'ETOTAL = ',ETONEW
!XOCL END SPREAD
C!XOCL END PARALLEL
RETURN
END