      SUBROUTINE UPFCM(FCM,FCM2,SCR1,SCR2,NCOORD,NIRREP,UPDATE)
C
CEND
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      LOGICAL UPDATE 
C
      DIMENSION FCM(NCOORD,NCOORD),FCM2(NCOORD,NCOORD),SCR1(1),SCR2(1)
C
      COMMON/MACHSP/IINTLN,IFLTLN,IINTFP,IALOBE,IBITWD
C
      DATA ONE/1.D0/
C
      IF(NIRREP.NE.1) THEN
C 
       CALL ZERO(FCM2,NCOORD*NCOORD)
       CALL TRAHES(FCM,FCM2,SCR1,SCR2,NCOORD)
c YAU : old
c      CALL ICOPY(NCOORD*NCOORD*IINTFP,FCM2,1,FCM,1)
c YAU : new
       CALL DCOPY(NCOORD*NCOORD,FCM2,1,FCM,1)
c YAU : end
C
      ENDIF
C
      IF(UPDATE) THEN
 
       OPEN(UNIT=81,FILE='FCM',STATUS='OLD',FORM='FORMATTED')
       READ(81,3000) NATOMS,NATOMS6
       DO 2000 ICOORD=1,NCOORD
        READ(81,3001) (FCM2(ICOORD,J),J=1,NCOORD)
2000   CONTINUE
3000   FORMAT(2I5)
3001   FORMAT(3F20.10)
       CALL SAXPY(NCOORD*NCOORD,ONE,FCM2,1,FCM,1)
      ELSE
       OPEN(UNIT=81,FILE='FCM',STATUS='UNKNOWN',FORM='FORMATTED')
       NATOMS=0
       NATOMS6=0
      ENDIF
C
      REWIND(81)
      WRITE(81,3000) NATOMS,NATOMS6
      DO 2100 ICOORD=1,NCOORD
       WRITE(81,3001) (FCM(ICOORD,J),J=1,NCOORD)
2100  CONTINUE
      CLOSE(UNIT=81,STATUS='KEEP')
C
      CALL PUTREC(20,'JOBARC','HESSIANM',NCOORD*NCOORD*IINTFP,FCM)
C
      RETURN
      END
