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