mopac606_nbo/src/forsav.f

   1       SUBROUTINE FORSAV(TIME,DELDIP,IPT,FMATRX, COORD,NVAR,REFH,
   2      1                  EVECS,JSTART,FCONST)
   3       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
   4       INCLUDE 'SIZES'
   5       DIMENSION FMATRX(*), DELDIP(3,*), COORD(*), EVECS(*), FCONST(*)
   6 ************************************************************************
   7 *
   8 *  FORSAV SAVES AND RESTORES DATA USED IN THE FORCE CALCULATION.
   9 *
  10 * ON INPUT TIME = TOTAL TIME ELAPSED SINCE THE START OF THE CALCULATION.
  11 *          IPT  = LINE OF FORCE MATRIX REACHED, IF IN WRITE MODE,
  12 *               = 0 IF IN READ MODE.
  13 *        FMATRX = FORCE MATRIX
  14 ************************************************************************
  15       COMMON /DENSTY/ P(MPACK), PA(MPACK), PB(MPACK)
  16       COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
  17      1                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
  18      2                NCLOSE,NOPEN,NDUMY,FRACT
  19       CHARACTER*80 GETNAM
  20       OPEN(UNIT=9,FILE=GETNAM('FOR009')
  21      +              ,STATUS='UNKNOWN',FORM='UNFORMATTED')
  22       REWIND 9
  23       OPEN(UNIT=10,FILE=GETNAM('FOR010')
  24      +              ,STATUS='UNKNOWN',FORM='UNFORMATTED')
  25       REWIND 10
  26       IR=9
  27       IW=9
  28       IF( IPT .EQ. 0 ) THEN
  29 C
  30 C   READ IN FORCE DATA
  31 C
  32          READ(IR,END=20,ERR=20)TIME,IPT,REFH
  33          LINEAR=(NVAR*(NVAR+1))/2
  34          READ(IR)(COORD(I),I=1,NVAR)
  35          READ(IR,END=10,ERR=10)(FMATRX(I),I=1,LINEAR)
  36          READ(IR)((DELDIP(J,I),J=1,3),I=1,IPT)
  37          N33=NVAR*NVAR
  38          READ(IR)(EVECS(I),I=1,N33)
  39          READ(IR)JSTART,(FCONST(I),I=1,NVAR)
  40          RETURN
  41       ELSE
  42 C
  43 C    WRITE FORCE DATA
  44 C
  45          REWIND IW
  46          IF(TIME.GT.1.D6)TIME=TIME-1.D6
  47          WRITE(IW)TIME,IPT,REFH
  48          LINEAR=(NVAR*(NVAR+1))/2
  49          WRITE(IW)(COORD(I),I=1,NVAR)
  50          WRITE(IW)(FMATRX(I),I=1,LINEAR)
  51          WRITE(IW)((DELDIP(J,I),J=1,3),I=1,IPT)
  52          N33=NVAR*NVAR
  53          WRITE(IR)(EVECS(I),I=1,N33)
  54          WRITE(IR)JSTART,(FCONST(I),I=1,NVAR)
  55          LINEAR=(NORBS*(NORBS+1))/2
  56          WRITE(10)(PA(I),I=1,LINEAR)
  57          IF(NALPHA.NE.0)WRITE(10)(PB(I),I=1,LINEAR)
  58          CLOSE(9)
  59          CLOSE(10)
  60       ENDIF
  61       RETURN
  62    10 WRITE(6,'(10X,''INSUFFICIENT DATA ON DISK FILES FOR A FORCE '',
  63      1''CALCULATION'',/10X,''RESTART. PERHAPS THIS STARTED OF AS A '',
  64      2''FORCE CALCULATION '')')
  65       WRITE(6,'(10X,''BUT THE GEOMETRY HAD TO BE OPTIMIZED FIRST, '',
  66      1''IN WHICH CASE '',/10X,''REMOVE THE KEY-WORD "FORCE".'')')
  67       STOP
  68    20 WRITE(6,'(//10X,''NO RESTART FILE EXISTS!'')')
  69       STOP
  70       END