mopac606_nbo/src/parsav.f

   1       SUBROUTINE PARSAV(MODE,N,M)
   2       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
   3       INCLUDE 'SIZES'
   4 **********************************************************************
   5 *
   6 *   PARSAV SAVES AND RESTORES DATA USED IN NLLSQ GRADIENT MINIMIZATION.
   7 *
   8 *    IF MODE IS 0 DATA ARE RESTORED, IF 1 THEN SAVED.
   9 *
  10 **********************************************************************
  11       COMMON /DENSTY/ P(MPACK), PA(MPACK), PB(MPACK)
  12       COMMON /ALPARM/ ALPARM(3,MAXPAR),X0, X1, X2, ILOOP
  13       COMMON /KEYWRD/ KEYWRD
  14       COMMON /ELEMTS/ ELEMNT(107)
  15       COMMON /ERRFN / ERRFN(MAXPAR), AICORR(MAXPAR)
  16       COMMON /GEOSYM/ NDEP,LOCPAR(MAXPAR),IDEPFN(MAXPAR),
  17      1                     LOCDEP(MAXPAR)
  18       COMMON /GEOKST/ NATOMS,LABELS(NUMATM),
  19      1                NA(NUMATM),NB(NUMATM),NC(NUMATM)
  20       COMMON /GEOM  / GEO(3,NUMATM)
  21       COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
  22      1                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
  23      2                NCLOSE,NOPEN,NDUMY,FRACT
  24       COMMON /NLLCOM/ Q(MAXPAR,MAXPAR),R(MAXPAR,MAXPAR*2)
  25       COMMON /NLLCO2/ DDDUM(6),EFSLST(MAXPAR),XLAST(MAXPAR),IIIUM(7)
  26       COMMON /GEOVAR/ NVAR,LOC(2,MAXPAR), JDUMY, DUMY(MAXPAR)
  27       COMMON /LOCVAR/ LOCVAR(2,MAXPAR)
  28       COMMON /VALVAR/ VALVAR(MAXPAR),NUMVAR
  29       DIMENSION COORD(3,NUMATM)
  30       CHARACTER ELEMNT*2, KEYWRD*241, GETNAM*80
  31       OPEN(UNIT=9,FILE=GETNAM('FOR009'),
  32      +     STATUS='UNKNOWN',FORM='UNFORMATTED')
  33       REWIND 9
  34       OPEN(UNIT=10,FILE=GETNAM('FOR010'),
  35      +     STATUS='UNKNOWN',FORM='UNFORMATTED')
  36       REWIND 10
  37       IF(MODE.NE.0) GOTO 10
  38 *
  39 *  MODE=0: RETRIEVE DATA FROM DISK.
  40 *
  41       READ(9,END=30,ERR=30)IIIUM,DDDUM,EFSLST,N,(XLAST(I),I=1,N),M
  42       READ(9)((Q(J,I),J=1,M),I=1,M)
  43       READ(9)((R(J,I),J=1,N),I=1,N)
  44       READ(9)(VALVAR(I),I=1,N)
  45       IF(INDEX(KEYWRD,'AIDER').NE.0) READ(9)(AICORR(I),I=1,N)
  46       RETURN
  47    10 CONTINUE
  48       IF(MODE.EQ.1)THEN
  49          WRITE(6,'(//10X,'' **** TIME UP ****'')')
  50          WRITE(6,'(//10X,'' CURRENT VALUES OF GEOMETRIC VARIABLES'',//)'
  51      1)
  52          IF(NA(1) .EQ. 99) THEN
  53 C
  54 C  CONVERT FROM CARTESIAN COORDINATES TO INTERNAL
  55 C
  56             DO 20 I=1,NATOMS
  57                DO 20 J=1,3
  58    20       COORD(J,I)=GEO(J,I)
  59             CALL XYZINT(COORD,NUMAT,NA,NB,NC,1.D0,GEO)
  60          ENDIF
  61          CALL GEOUT(6)
  62          WRITE(6,'(//10X,
  63      1''TO RESTART CALCULATION USE THE KEYWORD "RESTART".'')')
  64       ENDIF
  65       WRITE(9)IIIUM,DDDUM,EFSLST,N,(XLAST(I),I=1,N),M
  66       WRITE(9)((Q(J,I),J=1,M),I=1,M)
  67       WRITE(9)((R(J,I),J=1,N),I=1,N)
  68       WRITE(9)(VALVAR(I),I=1,N)
  69       IF(INDEX(KEYWRD,'AIDER').NE.0) WRITE(9)(AICORR(I),I=1,N)
  70 C*****
  71 C     The density matrix is required by ITER upon restart .
  72 C
  73       LINEAR=(NORBS*(NORBS+1))/2
  74       WRITE(10)(PA(I),I=1,LINEAR)
  75       IF(NALPHA.NE.0)WRITE(10)(PB(I),I=1,LINEAR)
  76 C*****
  77       CLOSE(9)
  78       CLOSE(10)
  79       RETURN
  80    30 WRITE(6,'(//10X,''NO RESTART FILE EXISTS!'')')
  81       STOP
  82       END