SUBROUTINE FORSAV(TIME,DELDIP,IPT,N3,FMATRX, COORD,NVAR,REFH,
     1                  EVECS,JSTART,FCONST)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INCLUDE 'SIZES'
      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
************************************************************************
csgi
        character*32 input_file
        common /input_file/input_file,ipos_bl
csgi
      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
csgi      OPEN(UNIT=9,FILE='FOR009',STATUS='UNKNOWN',FORM='UNFORMATTED')
c	changed to interface with DeFT
c      OPEN(UNIT=9,FILE=input_file(1:ipos_bl)//'.res',
c     &		STATUS='UNKNOWN',FORM='UNFORMATTED')
      OPEN(UNIT=9,FILE='hessian',
     &		STATUS='NEW',FORM='FORMATTED')
      REWIND 9
csgi      OPEN(UNIT=10,FILE='FOR010',STATUS='UNKNOWN',FORM='UNFORMATTED')
c      OPEN(UNIT=10,FILE=input_file(1:ipos_bl)//'.den',
c     &		STATUS='UNKNOWN',FORM='UNFORMATTED')
c      REWIND 10
      IR=9
      IW=9
      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
c	changed to interface with DeFT
         REWIND IW
         IF(TIME.GT.1.D6)TIME=TIME-1.D6
c         WRITE(IW)TIME,IPT,REFH
         LINEAR=(NVAR*(NVAR+1))/2
c         WRITE(IW)(COORD(I),I=1,NVAR)
         WRITE(IW,1230)(COORD(I),I=1,NVAR)
1230		format(3f20.12)
c         WRITE(IW)(FMATRX(I),I=1,LINEAR)
	do 123 i=1,NVAR
	  do 124 j=1,NVAR
	      k=i*(i-1)/2+j
	      if ( j .gt. i ) k=j*(j-1)/2+i
         WRITE(IW,1231) FMATRX(k)
1231		format(f20.12)
124	  continue
123	continue
c         WRITE(IW)((DELDIP(J,I),J=1,3),I=1,IPT)
c         N33=NVAR*NVAR
c         WRITE(IR)(EVECS(I),I=1,N33)
c         WRITE(IR)JSTART,(FCONST(I),I=1,NVAR)
c         LINEAR=(NORBS*(NORBS+1))/2
c         WRITE(10)(PA(I),I=1,LINEAR)
c         IF(NALPHA.NE.0)WRITE(10)(PB(I),I=1,LINEAR)
         CLOSE(9)
c         CLOSE(10)
      ENDIF
      RETURN
   10 WRITE(6,'(10X,''INSUFFICIENT DATA ON DISK FILES FOR A FORCE '',
     1''CALCULATION'',/10X,''RESTART. PERHAPS THIS STARTED OF AS A '',
     2''FORCE CALCULATION '')')
      WRITE(6,'(10X,''BUT THE GEOMETRY HAD TO BE OPTIMIZED FIRST, '',
     1''IN WHICH CASE '',/10X,''REMOVE THE KEY-WORD "FORCE".'')')
      STOP
   20 WRITE(6,'(//10X,''NO RESTART FILE EXISTS!'')')
      STOP
      END