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