C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                         
      SUBROUTINE FORLOC(KTPCC) 
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      IMPLICIT REAL(A-H,O-Y)                                          
      IMPLICIT COMPLEX(Z)                                            
      INCLUDE 'PACVPP' 
      DIMENSION ZFPC(6)
      INTEGER   KTPCC(KTYP) 
C     FORCE2 AND PRESSURE ADDITION SSN(KNG1)                            
      DO 161 IA=1,KATM                                                  
      DO 162 I=1,KG
        FX = GX(I)                                                      
        FY = GY(I)                                                      
        FZ = GZ(I)                                                      
        ZFORT     =CDEXP(-ZI*(CATX(IA)*FX+CATY(IA)*FY+CATZ(IA)*FZ))    
        ZFTMP     =ZFORT  *PSC(I,KFTYPE(IA))*DCONJG(ZCHG(I))        
      ZFORC2(IA,1)=ZFORC2(IA,1)+GX(I)*ZFTMP                             
      ZFORC2(IA,2)=ZFORC2(IA,2)+GY(I)*ZFTMP                             
      ZFORC2(IA,3)=ZFORC2(IA,3)+GZ(I)*ZFTMP                             
  162 CONTINUE 
      IF (KTPCC(KFTYPE(IA)).EQ.1) THEN                                  
          DO 1000 N=1,6                                                 
            ZFPC(N)=DCMPLX(0.0D0,0.0D0)                                 
 1000     CONTINUE                                                      
          DO 200 I=1,KG
C     4/20, 1999, MODIFIED SERIOUS BUG
            FX = GX(I)
            FY = GY(I)
            FZ = GZ(I)
            ZFORT =CDEXP(-ZI*(CATX(IA)*FX+CATY(IA)*FY+CATZ(IA)*FZ))    
            ZFTMP =ZFORT  *RHPCG(I,KFTYPE(IA))*DCONJG(ZVXC(I))      
            ZFPC(1)=ZFPC(1)+GX(I)*ZFTMP                                 
            ZFPC(2)=ZFPC(2)+GY(I)*ZFTMP                                 
            ZFPC(3)=ZFPC(3)+GZ(I)*ZFTMP                                 
C           [COMMENT OUT](in Japanese, 10/1, 1999)
C            ZFTMP =ZFORT  *RHPCG(I,KFTYPE(IA))*DCONJG(ZVXCPC(I))    
C            ZFPC(4)=ZFPC(4)+GX(I)*ZFTMP                                 
C            ZFPC(5)=ZFPC(5)+GY(I)*ZFTMP                                 
C            ZFPC(6)=ZFPC(6)+GZ(I)*ZFTMP
  200     CONTINUE 
          ZFORC2(IA,1)=ZFORC2(IA,1)+ZFPC(1)-ZFPC(4)                     
          ZFORC2(IA,2)=ZFORC2(IA,2)+ZFPC(2)-ZFPC(5)                     
          ZFORC2(IA,3)=ZFORC2(IA,3)+ZFPC(3)-ZFPC(6)                     
C          IF(MOD(ITER,50).EQ.0) THEN
C              WRITE(6,1100)  IA,ZFPC(1),ZFPC(2),ZFPC(3),               
C     &                          ZFPC(4),ZFPC(5),ZFPC(6)                
C 1100         FORMAT(I4,6D12.4,/,4X,6D12.4)                            
C          END IF 
      END IF                                                            
C     COMBINE THE FORCE1 AND FORCE2.                                    
  161 CONTINUE                                                          
      DO 261 IA=1,KATM
      ZFORC2(IA,1)=UNIVOL*ZI*ZFORC2(IA,1) + DCMPLX(FFF1(IA,1),0.0D0)    
      ZFORC2(IA,2)=UNIVOL*ZI*ZFORC2(IA,2) + DCMPLX(FFF1(IA,2),0.0D0)    
      ZFORC2(IA,3)=UNIVOL*ZI*ZFORC2(IA,3) + DCMPLX(FFF1(IA,3),0.0D0)    
  261 CONTINUE 
      RETURN                                                            
      END