      SUBROUTINE FORSAV(TIME,DELDIP,IPT,N3,FMATRX, COORD,NVAR,REFH,
     1                  EVECS,JSTART,FCONST)
      implicit double precision (A-H,O-Z)
      include 'SIZES'
      include 'MOP6FILE'
      dimension FMATRX(*), DELDIP(3,*), COORD(*), EVECS(*), FCONST(*)
************************************************************************
*
*  FORSAV SAVES AND RESTORES DATA USED IN THE FORCE CALCULATION.
*
* ON INPUT TIME = TOTAL TIME ELAPSED SINCE THE START OF THE CALCULATION.
*          IPT  = LINE OF FORCE MATRIX REACHED, IF IN WRITE MODE,
*               = 0 if IN READ MODE.
*        FMATRX = FORCE MATRIX
************************************************************************
      common /DENSTY/ P(MPACK), PA(MPACK), PB(MPACK)
      common /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
     1                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
     2                NCLOSE,NOPEN,NDUMY,FRACT
      character*80 GETNAM
      open(unit=MIOC,file=GETNAM('FOR009')
     +              ,status='UNKNOWN',form='UNFORMATTED')
      rewind MIOC
      open(unit=MIOD,file=GETNAM('FOR010')
     +              ,status='UNKNOWN',form='UNFORMATTED')
      rewind MIOD
      IR=MIOC
      IW=MIOC
      if ( IPT .EQ. 0 ) then
C
C   READ IN FORCE DATA
C
         read(IR,end=20,ERR=20) TIME,IPT,REFH
         LINEAR=(NVAR*(NVAR+1))/2
         read(IR) (COORD(I),I=1,NVAR)
         read(IR,end=10,ERR=10) (FMATRX(I),I=1,LINEAR)
         read(IR) ((DELDIP(J,I),J=1,3),I=1,IPT)
         N33=NVAR*NVAR
         read(IR) (EVECS(I),I=1,N33)
         read(IR) JSTART,(FCONST(I),I=1,NVAR)
         return
      else
C
C    WRITE FORCE DATA
C
         rewind IW
         if (TIME.GT.1.D6) TIME=TIME-1.D6
         write(IW) TIME,IPT,REFH
         LINEAR=(NVAR*(NVAR+1))/2
         write(IW) (COORD(I),I=1,NVAR)
         write(IW) (FMATRX(I),I=1,LINEAR)
         write(IW) ((DELDIP(J,I),J=1,3),I=1,IPT)
         N33=NVAR*NVAR
         write(IR) (EVECS(I),I=1,N33)
         write(IR) JSTART,(FCONST(I),I=1,NVAR)
         LINEAR=(NORBS*(NORBS+1))/2
         write(MIOD) (PA(I),I=1,LINEAR)
         if (NALPHA.NE.0) write(MIOD) (PB(I),I=1,LINEAR)
         close (MIOC)
         close (MIOD)
      end if
      return
   10 write(MIOB,'(10X,''INSUFFICIENT DATA ON DISK FILES FOR A FORCE '',
     1''CALCULATION'',/10X,''RESTART. PERHAPS THIS STARTED OF AS A '',
     2''FORCE CALCULATION '')')
      write(MIOB,'(10X,''BUT THE GEOMETRY HAD TO BE OPTIMIZED FIRST, '',
     1''IN WHICH CASE '',/10X,''REMOVE THE KEY-WORD "FORCE".'')')
c
      call filclo ! J/M
      stop ' in FORSAV - unable to start from restart file supplied!'
c
   20 write(MIOB,'(//10X,''NO RESTART FILE EXISTS!'')')
c
      call filclo ! J/M
      stop ' in FORSAV - there is no restart file !'
c
      end
