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