C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ SUBROUTINE STRESS(IPCC,SCHGPC,ETOT1,TOTCH,EPC,PCM & ,KOPR,NBZTYP) 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 ZZZ(KNG1,KEG,KNV3),OCCUU(KEG,KNV3) !XOCL LOCAL ZZZ(:,:,/IP),OCCUU(:,/IP) EQUIVALENCE (ZAJ,ZZZ),(OCCUP,OCCUU) DIMENSION OO(3,3,KO) !XOCL INDEX PARTITION IQ=(PS,INDEX=1:KO,PART=BAND) !XOCL LOCAL OO(:,:,/IQ) EQUIVALENCE (OP,OO) C DIMENSION SSS(3,3),TTT(3,3) C STRESS CALCULATION FOR KINETIC, HARTREE, EX-COR, LOCAL AND ETOT1 CCC =2.D0*RVOL/(2.D0*PAI)**3/FLOAT(KV3) DO 1000 IS=1,6 SIGSTR(IS)=0.0D0 1000 CONTINUE RGG(1)=0.0D0 ZXXX(1)=DCMPLX(0.0D0,0.0D0) ZYYY(1)=DCMPLX(0.0D0,0.0D0) ZZZZ(1)=DCMPLX(0.0D0,0.0D0) DO 1001 I=2,KG ZXXX(I)=DCMPLX(0.0D0,0.0D0) ZYYY(I)=DCMPLX(0.0D0,0.0D0) ZZZZ(I)=DCMPLX(0.0D0,0.0D0) RGG(I)=1.0D0/(GR(I)*GR(I)) 1001 CONTINUE C KINETIC PART C VPP-PARALLEL START C!XOCL PARALLEL REGION !XOCL SPREAD DO /IP DO 1100 IK=1,KV3 C IWRT(IK) =IK AKX = VX(IK) AKY = VY(IK) AKZ = VZ(IK) DO 1110 IBAN=NBD1,NBD2 CW=CCC*OCCUU(IBAN,IK) DO 1120 I=1,IBA(IK) I1 = NBASE(I,IK) STMP=CW*DCONJG(ZZZ(I,IBAN,IK))*ZZZ(I,IBAN,IK) SIGSTR(1)=SIGSTR(1)-STMP*(AKX+GX(I1))*(AKX+GX(I1)) SIGSTR(2)=SIGSTR(2)-STMP*(AKX+GX(I1))*(AKY+GY(I1)) SIGSTR(3)=SIGSTR(3)-STMP*(AKX+GX(I1))*(AKZ+GZ(I1)) SIGSTR(4)=SIGSTR(4)-STMP*(AKY+GY(I1))*(AKY+GY(I1)) SIGSTR(5)=SIGSTR(5)-STMP*(AKY+GY(I1))*(AKZ+GZ(I1)) SIGSTR(6)=SIGSTR(6)-STMP*(AKZ+GZ(I1))*(AKZ+GZ(I1)) 1120 CONTINUE 1110 CONTINUE 1100 CONTINUE !XOCL END SPREAD SUM(SIGSTR) C!XOCL END PARALLEL SSS1=SIGSTR(1) SSS2=SIGSTR(2) SSS3=SIGSTR(3) SSS4=SIGSTR(4) SSS5=SIGSTR(5) SSS6=SIGSTR(6) WRITE (6,*) 'TOTAL STR 1 1 = ',SIGSTR(1) WRITE (6,*) ' 2 = ',SIGSTR(2) WRITE (6,*) ' 3 = ',SIGSTR(3) WRITE (6,*) ' 4 = ',SIGSTR(4) WRITE (6,*) ' 5 = ',SIGSTR(5) WRITE (6,*) ' 6 = ',SIGSTR(6) C HARTREE PART I=1 -----> GR(1)=0.0D0 : RGG(1)=INFINITE C EXCHANGE-CORRELATION + LOCAL PS PARTS DO 1250 I=1,KG ZVP(I)=ZVXC(I) 1250 CONTINUE CALL XCFFT(1,SCHGPC) CALL XCFFT(2,SCHGPC) IF (IPCC.EQ.1) CALL XSTPC(1,SCHGPC) STMQ=DCONJG(ZEXC(1))*(ZCHG(1)+ZRHPC(1))-DCONJG(ZVXC(1))*ZCHG(1) & -DCONJG(ZVXC(1))*ZRHPC(1) SS1=-DCONJG(ZEXC(1))*ZRRPC(1) SSX=-DCONJG(ZXXX(1))*(ZCHG(1)+ZRHPC(1)) SSY=-DCONJG(ZYYY(1))*(ZCHG(1)+ZRHPC(1)) SSZ=-DCONJG(ZZZZ(1))*(ZCHG(1)+ZRHPC(1)) SIGSTR(1)=SIGSTR(1)+STMQ+SS1*GX(1)*GX(1)+SSX SIGSTR(4)=SIGSTR(4)+STMQ+SS1*GY(1)*GY(1)+SSY SIGSTR(6)=SIGSTR(6)+STMQ+SS1*GZ(1)*GZ(I)+SSZ TTT1=SIGSTR(1)-SSS1 TTT2=SIGSTR(2)-SSS2 TTT3=SIGSTR(3)-SSS3 TTT4=SIGSTR(4)-SSS4 TTT5=SIGSTR(5)-SSS5 TTT6=SIGSTR(6)-SSS6 SSS1=SIGSTR(1) SSS2=SIGSTR(2) SSS3=SIGSTR(3) SSS4=SIGSTR(4) SSS5=SIGSTR(5) SSS6=SIGSTR(6) WRITE (6,*) 'TOTAL STR 2 1 = ',TTT1 WRITE (6,*) ' 2 = ',TTT2 WRITE (6,*) ' 3 = ',TTT3 WRITE (6,*) ' 4 = ',TTT4 WRITE (6,*) ' 5 = ',TTT5 WRITE (6,*) ' 6 = ',TTT6 STX=0.0D0 STY=0.0D0 STZ=0.0D0 STT=0.0D0 STU=0.0D0 STV=0.0D0 STW=0.0D0 DO 1200 I=2,KG STMP=0.5D0*PAI4*DCONJG(ZCHG(I))*ZCHG(I)*RGG(I) STMQ=DCONJG(ZEXC(I))*(ZCHG(I)+ZRHPC(I))-DCONJG(ZVXC(I))*ZCHG(I) & -DCONJG(ZVXC(I))*ZRHPC(I) STM1= DCONJG(ZEXC(I))*ZRRPC(I) STMX= DCONJG(ZXXX(I))*(ZCHG(I)+ZRHPC(I)) STMY= DCONJG(ZYYY(I))*(ZCHG(I)+ZRHPC(I)) STMZ= DCONJG(ZZZZ(I))*(ZCHG(I)+ZRHPC(I)) C STX=STX+DREAL(DCONJG(ZVXC(I))*ZRRPC(I))*GX(I)*GX(I) C STY=STY+DREAL(DCONJG(ZEXC(I))*ZRRPC(I))*GX(I)*GX(I) C STZ=STZ+STMX C STT=STT+STMY STX=STX+STMP*(2.0D0*GX(I)*GX(I)*RGG(I)-1.0D0)+STMQ & -STMS*2.0D0*GX(I)*GX(I)-STMR-STM1*GX(I)*GX(I)-STMX STY=STY+STMP*(2.0D0*GX(I)*GX(I)*RGG(I)-1.0D0) STZ=STZ+STMQ STT=STT-STMS*2.0D0*GX(I)*GX(I) STU=STU-STMR STV=STV-STM1*GX(I)*GX(I) STW=STW-STMX STMR=ZPSCC(I)*DCONJG(ZCHG(I)) STMS=ZDSCC(I)*DCONJG(ZCHG(I)) SIGSTR(1)=SIGSTR(1)+STMP*(2.0D0*GX(I)*GX(I)*RGG(I)-1.0D0)+STMQ & -STMS*2.0D0*GX(I)*GX(I)-STMR-STM1*GX(I)*GX(I)-STMX SIGSTR(2)=SIGSTR(2)+STMP*(2.0D0*GX(I)*GY(I)*RGG(I)) & -STMS*2.0D0*GX(I)*GY(I) SIGSTR(3)=SIGSTR(3)+STMP*(2.0D0*GX(I)*GZ(I)*RGG(I)) & -STMS*2.0D0*GX(I)*GZ(I) SIGSTR(4)=SIGSTR(4)+STMP*(2.0D0*GY(I)*GY(I)*RGG(I)-1.0D0)+STMQ & -STMS*2.0D0*GY(I)*GY(I)-STMR-STM1*GY(I)*GY(I)-STMY SIGSTR(5)=SIGSTR(5)+STMP*(2.0D0*GY(I)*GZ(I)*RGG(I)) & -STMS*2.0D0*GY(I)*GZ(I) SIGSTR(6)=SIGSTR(6)+STMP*(2.0D0*GZ(I)*GZ(I)*RGG(I)-1.0D0)+STMQ & -STMS*2.0D0*GZ(I)*GZ(I)-STMR-STM1*GZ(I)*GZ(I)-STMZ 1200 CONTINUE WRITE (6,*) 'ZVX,ZEX = ',STX,STY WRITE (6,*) 'STM1(XY)= ',STZ,STT WRITE (6,*) 'STU,V,W = ',STU,STV,STW STOT=STY+STZ+STT+STU+STV+STW WRITE (6,*) 'STOT = ',STOT TTT1=SIGSTR(1)-SSS1 TTT2=SIGSTR(2)-SSS2 TTT3=SIGSTR(3)-SSS3 TTT4=SIGSTR(4)-SSS4 TTT5=SIGSTR(5)-SSS5 TTT6=SIGSTR(6)-SSS6 SSS1=SIGSTR(1) SSS2=SIGSTR(2) SSS3=SIGSTR(3) SSS4=SIGSTR(4) SSS5=SIGSTR(5) SSS6=SIGSTR(6) WRITE (6,*) 'TOTAL STR 3 1 = ',TTT1 WRITE (6,*) ' 2 = ',TTT2 WRITE (6,*) ' 3 = ',TTT3 WRITE (6,*) ' 4 = ',TTT4 WRITE (6,*) ' 5 = ',TTT5 WRITE (6,*) ' 6 = ',TTT6 DO 1251 I=1,KNG ZVXC(I)=ZVP(I) 1251 CONTINUE C CALL NON-LOCAL PART SUBROUTINE CALL STRNL(ETOT1) C NON-LOCAL PS AND EWALD PARTS DO 1400 IS=1,6 SIGSTR(IS)=SIGSTR(IS)+SIGNL(IS)+SIGEWA(IS) 1400 CONTINUE WRITE (6,*) 'SIGEWA 1 = ',SIGEWA(1) WRITE (6,*) 'SIGEWA 2 = ',SIGEWA(2) WRITE (6,*) 'SIGEWA 3 = ',SIGEWA(3) WRITE (6,*) 'SIGEWA 4 = ',SIGEWA(4) WRITE (6,*) 'SIGEWA 5 = ',SIGEWA(5) WRITE (6,*) 'SIGEWA 6 = ',SIGEWA(6) WRITE (6,*) 'SIGNL 1 = ',SIGNL(1) WRITE (6,*) 'SIGNL 2 = ',SIGNL(2) WRITE (6,*) 'SIGNL 3 = ',SIGNL(3) WRITE (6,*) 'SIGNL 4 = ',SIGNL(4) WRITE (6,*) 'SIGNL 5 = ',SIGNL(5) WRITE (6,*) 'SIGNL 6 = ',SIGNL(6) TTT1=SIGSTR(1)-SSS1 TTT2=SIGSTR(2)-SSS2 TTT3=SIGSTR(3)-SSS3 TTT4=SIGSTR(4)-SSS4 TTT5=SIGSTR(5)-SSS5 TTT6=SIGSTR(6)-SSS6 SSS1=SIGSTR(1) SSS2=SIGSTR(2) SSS3=SIGSTR(3) SSS4=SIGSTR(4) SSS5=SIGSTR(5) SSS6=SIGSTR(6) WRITE (6,*) 'TOTAL STR 4 1 = ',TTT1 WRITE (6,*) ' 2 = ',TTT2 WRITE (6,*) ' 3 = ',TTT3 WRITE (6,*) ' 4 = ',TTT4 WRITE (6,*) ' 5 = ',TTT5 WRITE (6,*) ' 6 = ',TTT6 SIGSTR(1)=SIGSTR(1)-ETOT1*TOTCH/UNIVOL SIGSTR(4)=SIGSTR(4)-ETOT1*TOTCH/UNIVOL SIGSTR(6)=SIGSTR(6)-ETOT1*TOTCH/UNIVOL TTT1=SIGSTR(1)-SSS1 TTT2=SIGSTR(2)-SSS2 TTT3=SIGSTR(3)-SSS3 TTT4=SIGSTR(4)-SSS4 TTT5=SIGSTR(5)-SSS5 TTT6=SIGSTR(6)-SSS6 SSS1=SIGSTR(1) SSS2=SIGSTR(2) SSS3=SIGSTR(3) SSS4=SIGSTR(4) SSS5=SIGSTR(5) SSS6=SIGSTR(6) WRITE (6,*) 'TOTAL STR 5 1 = ',TTT1 WRITE (6,*) ' 2 = ',TTT2 WRITE (6,*) ' 3 = ',TTT3 WRITE (6,*) ' 4 = ',TTT4 WRITE (6,*) ' 5 = ',TTT5 WRITE (6,*) ' 6 = ',TTT6 WRITE (6,*) 'TOTAL SUMM 1 = ',SSS1 WRITE (6,*) ' 2 = ',SSS2 WRITE (6,*) ' 3 = ',SSS3 WRITE (6,*) ' 4 = ',SSS4 WRITE (6,*) ' 5 = ',SSS5 WRITE (6,*) ' 6 = ',SSS6 IF (NBZTYP.LE.1) GO TO 9000 DENOM = 1.0D0/FLOAT(KOPR) SSS(1,1)=SIGSTR(1) SSS(2,2)=SIGSTR(4) SSS(3,3)=SIGSTR(6) SSS(1,2)=SIGSTR(2) SSS(1,3)=SIGSTR(3) SSS(2,3)=SIGSTR(5) SSS(2,1)=SSS(1,2) SSS(3,1)=SSS(1,3) SSS(3,2)=SSS(2,3) DO 1210 I=1,3 DO 1220 J=1,3 TTT(I,J)=0.0D0 1220 CONTINUE 1210 CONTINUE !XOCL SPREAD DO /IQ DO 2400 IOP = 1,KOPR DO 2200 I=1,3 DO 2300 J=1,3 SXX=SSS(1,1) SXY=SSS(1,2) SXZ=SSS(1,3) SYY=SSS(2,2) SYZ=SSS(2,3) SZZ=SSS(3,3) TXX=OO(1,I,IOP)*SSS(I,J)*OO(1,J,IOP) TXY=OO(1,I,IOP)*SSS(I,J)*OO(2,J,IOP) TXZ=OO(1,I,IOP)*SSS(I,J)*OO(3,J,IOP) TYY=OO(2,I,IOP)*SSS(I,J)*OO(2,J,IOP) TYZ=OO(2,I,IOP)*SSS(I,J)*OO(3,J,IOP) TZZ=OO(3,I,IOP)*SSS(I,J)*OO(3,J,IOP) TTT(1,1)=TTT(1,1) + OO(1,I,IOP)*SSS(I,J)*OO(1,J,IOP) TTT(1,2)=TTT(1,2) + OO(1,I,IOP)*SSS(I,J)*OO(2,J,IOP) TTT(1,3)=TTT(1,3) + OO(1,I,IOP)*SSS(I,J)*OO(3,J,IOP) TTT(2,2)=TTT(2,2) + OO(2,I,IOP)*SSS(I,J)*OO(2,J,IOP) TTT(2,3)=TTT(2,3) + OO(2,I,IOP)*SSS(I,J)*OO(3,J,IOP) TTT(3,3)=TTT(3,3) + OO(3,I,IOP)*SSS(I,J)*OO(3,J,IOP) 2300 CONTINUE 2200 CONTINUE 2400 CONTINUE !XOCL END SPREAD SUM(TTT) SIGSTR(1)=TTT(1,1)*DENOM SIGSTR(2)=TTT(1,2)*DENOM SIGSTR(3)=TTT(1,3)*DENOM SIGSTR(4)=TTT(2,2)*DENOM SIGSTR(5)=TTT(2,3)*DENOM SIGSTR(6)=TTT(3,3)*DENOM SSS1=SIGSTR(1) SSS2=SIGSTR(2) SSS3=SIGSTR(3) SSS4=SIGSTR(4) SSS5=SIGSTR(5) SSS6=SIGSTR(6) WRITE (6,*) 'TOTAL SUMM OP1 = ',SSS1 WRITE (6,*) ' 2 = ',SSS2 WRITE (6,*) ' 3 = ',SSS3 WRITE (6,*) ' 4 = ',SSS4 WRITE (6,*) ' 5 = ',SSS5 WRITE (6,*) ' 6 = ',SSS6 9000 CONTINUE RETURN END