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 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,*) '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