      SUBROUTINE EXPFCM(FCM,NCOORD,ITRANS,NUCIND)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z) 
      INTEGER DIRPRD
C
      DIMENSION FCM(NCOORD,NCOORD),ITRANS(NUCIND-1,3)
C
      COMMON/SYMINF/NSTART,NIRREP,IRREPA(255,2),DIRPRD(8,8)
      COMMON/PERT/NTPERT,NPERT(8),IPERT(8),IXPERT,IYPERT,IZPERT,
     &            IXYPERT,IXZPERT,IYZPERT,ITRANSX,ITRANSY,
     &            ITRANSZ,NUCIND1
C
      DATA AZERO /0.D0/
C
      IOFF=0
      DO 1000 IRREP=1,NIRREP
C
       N=NPERT(IRREP)
       IF(IXPERT.EQ.IRREP) N=N+1
       IF(IYPERT.EQ.IRREP) N=N+1
       IF(IZPERT.EQ.IRREP) N=N+1
C
       IF(IXPERT.EQ.IRREP) THEN
C
        IX=ITRANSX+IOFF
        DO 100 I=IOFF+1,IOFF+N
         FCM(IX,I)=AZERO
         FCM(I,IX)=AZERO
100     CONTINUE
C
        DO 110 INUC=1,NUCIND-1
         IX2=ITRANS(INUC,1)+IOFF
         DO 110 I=IOFF+1,IOFF+N  
          FCM(IX,I)=FCM(IX,I)-FCM(IX2,I)
          FCM(I,IX)=FCM(I,IX)-FCM(I,IX2)
110     CONTINUE
C
        FCM(IX,IX)=AZERO
        DO 120 INUC=1,NUCIND-1
         IX2=ITRANS(INUC,1)+IOFF
         FCM(IX,IX)=FCM(IX,IX)-FCM(IX2,IX)
120     CONTINUE
C      
       ENDIF
C
       IF(IYPERT.EQ.IRREP) THEN
C
        IY=ITRANSY+IOFF
        DO 200 I=IOFF+1,IOFF+N
         FCM(IY,I)=AZERO
         FCM(I,IY)=AZERO
200     CONTINUE
C        
        DO 210 INUC=1,NUCIND-1
         IY2=ITRANS(INUC,2)+IOFF
         DO 210 I=IOFF+1,IOFF+N  
          FCM(IY,I)=FCM(IY,I)-FCM(IY2,I)
          FCM(I,IY)=FCM(I,IY)-FCM(I,IY2)
210     CONTINUE
C
        FCM(IY,IY)=AZERO
        DO 220 INUC=1,NUCIND-1
         IY2=ITRANS(INUC,2)+IOFF
         FCM(IY,IY)=FCM(IY,IY)-FCM(IY2,IY)
220     CONTINUE
C      
       ENDIF
C
       IF(IZPERT.EQ.IRREP) THEN
C
        IZ=ITRANSZ+IOFF
        DO 300 I=IOFF+1,IOFF+N
         FCM(IZ,I)=AZERO
         FCM(I,IZ)=AZERO
300     CONTINUE
C        
        DO 310 INUC=1,NUCIND-1
         IZ2=ITRANS(INUC,3)+IOFF
         DO 310 I=IOFF+1,IOFF+N  
          FCM(IZ,I)=FCM(IZ,I)-FCM(IZ2,I)
          FCM(I,IZ)=FCM(I,IZ)-FCM(I,IZ2)
310     CONTINUE
C
        FCM(IZ,IZ)=AZERO
        DO 320 INUC=1,NUCIND-1
         IZ2=ITRANS(INUC,3)+IOFF
         FCM(IZ,IZ)=FCM(IZ,IZ)-FCM(IZ2,IZ)
320     CONTINUE
C      
       ENDIF
C
       IOFF=IOFF+N
C
1000  CONTINUE
C
      RETURN
      END
