
      SUBROUTINE FORSYM (NAT,NC,IB,F0,R,NDIM9,FORCE,FORCWK,
     *                   NIONS,NSPEC,NIONSP,FORCESYM)
C
C     APPLY POINT GROUP OPERATIONS TO THE FORCES CALCULATED BY
C     SUMMING OVER SPECIAL POINTS.
C     WRITTEN 12-MAY-82 BY OLE HOLM NIELSEN
C     INPUT: SEE SUBROUTINE ROSYM2.
C     FORCE ..... THE FORCES TO BE SYMMETRIZED. ON RETURN FORCE
C                 CONTAINS THE CORRECT FORCES
C
      INTEGER IB(48),F0(48,NDIM9),NIONSP(NSPEC)       
      REAL R(49,3,3),FORCE(3,NIONS*NSPEC),FORCWK(3,NIONS*NSPEC)
      REAL FORCESYM(3,NIONS,NSPEC)
C-----------------------------------------------------------------------
      ICOUNT = 0
      DO 90 L = 1 , NSPEC
        DO 90 M = 1 , NIONSP(L)
          ICOUNT = ICOUNT + 1
          DO 90 N = 1 , 3
            FORCE(N,ICOUNT) = FORCESYM(N,M,L)
90    CONTINUE
      IZERO = 0
C     KEEP FORCE IN WORKING ARRAY
      DO 100 KAPA = 1 , NAT
        DO 100 J = 1 , 3
          IF (ABS(FORCE(J,KAPA)) .LT. 1.0E-10) IZERO = IZERO + 1
C         DIVIDE BY THE NUMBER OF GROUP OPERATIONS
          FORCWK(J,KAPA) = FORCE(J,KAPA) / FLOAT(NC)
          FORCE(J,KAPA) = 0.0
100   CONTINUE
C
      IF (IZERO .GT. 0) THEN
        WRITE (6,110) IZERO
110     FORMAT(' SUBROUTINE FORSYM - WARNING - ',I3,' FORCES ARE ZERO')
      ENDIF
C
C     LOOP OVER ATOMS
      DO 190 KAPA = 1 , NAT
C     SUM OVER ROTATIONS
        DO 190 IROT = 1 , NC
C     NOTE THAT FROM K290, THE ARRAYS F0 AND V ARE ARRANGED
C     DIFFERENTLY FROM THE ROTATION MATRICES.
          KAPAP = F0(IROT,KAPA)
C     ROTATE THE FORCE VECTOR BY R**(-1)
          IC = IB(IROT)
          DO 190 I = 1 , 3
            DO 190 J = 1 , 3
              FORCE(I,KAPA) = FORCE(I,KAPA) + 
     &                        R(IC,J,I) * FORCWK(J,KAPAP)
190   CONTINUE
      ICOUNT = 0
      DO 91 L = 1 , NSPEC
        DO 91 M = 1 , NIONSP(L)
          ICOUNT = ICOUNT + 1
          DO 91 N = 1 , 3
            FORCESYM(N,M,L) = FORCE(N,ICOUNT)
91    CONTINUE
      RETURN
      END
