forsav.f

      SUBROUTINE FORSAV(TIME,DELDIP,IPT,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
************************************************************************
      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
C  aoyama editted
      CHARACTER INF*80 ,OUTF*80,RESF*80,DENF*80,LOGF*80,ARCF*80,
     +               GPTF*80,SYBF*80,ERR0*80,ERR1*80
      COMMON /DECKS/ INF,OUTF,RESF,DENF,LOGF,ARCF,GPTF,SYBF,ERR0,ERR1
      integer RESLEN,DENLEN
      IF(len_trim(RESF)==0) THEN
          RESF='FOR009'
      ENDIF
      IF(len_trim(DENF)==0) THEN
          DENF='FOR010'
      ENDIF
      RESLEN=len_trim(RESF)
      DENLEN=len_trim(DENF)
      OPEN(UNIT=9,FILE=RESF(1:RESLEN)
     +              ,STATUS='UNKNOWN',FORM='UNFORMATTED')
      REWIND 9
      OPEN(UNIT=10,FILE=DENF(1:DENLEN)
     +              ,STATUS='UNKNOWN',FORM='UNFORMATTED')
      REWIND 10
C      CHARACTER*80 GETNAM
C      OPEN(UNIT=9,FILE=GETNAM('FOR009')
C     +              ,STATUS='UNKNOWN',FORM='UNFORMATTED')
C      REWIND 9
C      OPEN(UNIT=10,FILE=GETNAM('FOR010')
C     +              ,STATUS='UNKNOWN',FORM='UNFORMATTED')
C      REWIND 10
C end aoyama editted
      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
         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(10)(PA(I),I=1,LINEAR)
         IF(NALPHA.NE.0)WRITE(10)(PB(I),I=1,LINEAR)
         CLOSE(9)
         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