C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
SUBROUTINE FORCES
> (KOPR,NOPR,FORC,FORCW)
C FORCE SYMMETRIZATION
IMPLICIT REAL(A-H,O-Y)
IMPLICIT COMPLEX(Z)
INCLUDE 'PACVPP'
DIMENSION NAAA(KATM,KO)
DIMENSION OO(3,3,KO)
!XOCL SUBPROCESSOR PT(IPARA)=PQ(1:IPARA)
!XOCL INDEX PARTITION IQ=(PT,INDEX=1:KO,PART=BAND)
!XOCL LOCAL NAAA(:,/IQ),OO(:,:,/IQ)
EQUIVALENCE (NAPT,NAAA),(OP,OO)
DIMENSION FORC(KATM,3),FORCW(KATM,3)
C----------------------------------------------------------------------
DENOM = 1.0D0/FLOAT(NOPR)
DO 100 IA = 1,KATM
FORCW(IA,1) = 0.0D0
FORCW(IA,2) = 0.0D0
FORCW(IA,3) = 0.0D0
100 CONTINUE
!XOCL SPREAD DO /IQ
DO 210 IOP = 1,NOPR
DO 200 IA= 1,KATM
IAA= NAAA(IA,IOP)
F1 = FORC(IAA,1)
F2 = FORC(IAA,2)
F3 = FORC(IAA,3)
F4 = OO(1,1,IOP)*F1 +OO(2,1,IOP)*F2 +OO(3,1,IOP)*F3
F5 = OO(1,2,IOP)*F1 +OO(2,2,IOP)*F2 +OO(3,2,IOP)*F3
F6 = OO(1,3,IOP)*F1 +OO(2,3,IOP)*F2 +OO(3,3,IOP)*F3
FORCW(IA,1) = FORCW(IA,1) + F4
FORCW(IA,2) = FORCW(IA,2) + F5
FORCW(IA,3) = FORCW(IA,3) + F6
200 CONTINUE
210 CONTINUE
!XOCL END SPREAD SUM(FORCW)
DO 300 IA = 1,KATM
FORC(IA,1) = FORCW(IA,1) * DENOM
FORC(IA,2) = FORCW(IA,2) * DENOM
FORC(IA,3) = FORCW(IA,3) * DENOM
300 CONTINUE
RETURN
END