1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
SUBROUTINE POWSAV(HESS, GRAD, XPARAM, PMAT, ILOOP, BMAT, IPOW)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION HESS(MAXPAR,*),GRAD(*),BMAT(MAXPAR,*),IPOW(9),
1 XPARAM(*), PMAT(*)
**********************************************************************
*
* POWSAV STORES AND RESTORES DATA USED IN THE SIGMA GEOMETRY
* OPTIMISATION.
*
* ON INPUT HESS = HESSIAN MATRIX, PARTIAL OR WHOLE.
* GRAD = GRADIENTS.
* XPARAM = CURRENT STATE OF PARAMETERS.
* ILOOP = INDEX OF HESSIAN, OR FLAG OF POINT REACHED SO-FAR.
* BMAT = "B" MATRIX!
* IPOW = INDICES AND FLAGS.
* IPOW(9)= 0 FOR RESTORE, 1 FOR DUMP
*
**********************************************************************
COMMON /GEOVAR/ NVAR,LOC(2,MAXPAR), IDUMY, DUMY(MAXPAR)
COMMON /ERRFN / ERRFN(MAXPAR), AICORR(MAXPAR)
COMMON /ELEMTS/ ELEMNT(107)
COMMON /GEOSYM/ NDEP,LOCPAR(MAXPAR),IDEPFN(MAXPAR),
1 LOCDEP(MAXPAR)
COMMON /GEOKST/ NATOMS,LABELS(NUMATM),
1 NA(NUMATM),NB(NUMATM),NC(NUMATM)
COMMON /GEOM / GEO(3,NUMATM), XCOORD(3,NUMATM)
COMMON /LOCVAR/ LOCVAR(2,MAXPAR)
COMMON /KEYWRD/ KEYWRD
COMMON /VALVAR/ VALVAR(MAXPAR),NUMVAR
DIMENSION COORD(3,NUMATM)
CHARACTER ELEMNT*2, KEYWRD*241, GETNAM*80
COMMON /DENSTY/ P(MPACK), PA(MPACK), PB(MPACK)
COMMON /ALPARM/ ALPARM(3,MAXPAR),X0, X1, X2, JLOOP
COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
1 NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
2 NCLOSE,NOPEN,NDUMY,FRACT
COMMON /PATH / LATOM,LPARAM,REACT(200)
OPEN(UNIT=9,FILE=GETNAM('FOR009'),
+ STATUS='UNKNOWN',FORM='UNFORMATTED')
REWIND 9
OPEN(UNIT=10,FILE=GETNAM('FOR010'),
+ STATUS='UNKNOWN',FORM='UNFORMATTED')
REWIND 10
IR=9
IF(IPOW(9) .NE. 0) THEN
IF(IPOW(9) .EQ. 1) THEN
WRITE(6,'(//10X,''- - - - - - - TIME UP - - - - - - -'',//)'
1)
WRITE(6,'(//10X,'' - THE CALCULATION IS BEING DUMPED TO DISK
1'',/10X,'' RESTART IT USING THE KEY-WORD "RESTART"'')')
FUNCT1=SQRT(DOT(GRAD,GRAD,NVAR))
WRITE(6,'(//10X,''CURRENT VALUE OF GRADIENT NORM =''
1 ,F12.6)')FUNCT1
DO 10 I=1,NVAR
K=LOC(1,I)
L=LOC(2,I)
10 GEO(L,K)=XPARAM(I)
WRITE(6,'(/10X,''CURRENT VALUE OF GEOMETRY'',/)')
IF(NA(1) .EQ. 99) THEN
C
C CONVERT FROM CARTESIAN COORDINATES TO INTERNAL
C
DO 20 I=1,NATOMS
DO 20 J=1,3
20 COORD(J,I)=GEO(J,I)
CALL XYZINT(COORD,NUMAT,NA,NB,NC,1.D0,GEO)
ENDIF
CALL GEOUT(6)
ENDIF
WRITE(IR)IPOW,ILOOP
WRITE(IR)(XPARAM(I),I=1,NVAR)
WRITE(IR)( GRAD(I),I=1,NVAR)
WRITE(IR)((HESS(J,I),J=1,NVAR),I=1,NVAR)
WRITE(IR)((BMAT(J,I),J=1,NVAR),I=1,NVAR)
LINEAR=(NVAR*(NVAR+1))/2
WRITE(IR)(PMAT(I),I=1,LINEAR)
IF(INDEX(KEYWRD,'AIDER').NE.0) WRITE(IR)(AICORR(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)
IF(LATOM .NE. 0) THEN
WRITE(IR)((ALPARM(J,I),J=1,3),I=1,NVAR)
WRITE(IR)JLOOP,X0, X1, X2
ENDIF
CLOSE (9)
CLOSE (10)
RETURN
ELSE
WRITE(6,'(//10X,'' RESTORING DATA FROM DISK''/)')
READ(IR)IPOW,ILOOP
READ(IR)(XPARAM(I),I=1,NVAR)
READ(IR)( GRAD(I),I=1,NVAR)
READ(IR)((HESS(J,I),J=1,NVAR),I=1,NVAR)
READ(IR)((BMAT(J,I),J=1,NVAR),I=1,NVAR)
FUNCT1=SQRT(DOT(GRAD,GRAD,NVAR))
WRITE(6,'(10X,''FUNCTION ='',F13.6//)')FUNCT1
LINEAR=(NVAR*(NVAR+1))/2
READ(IR)(PMAT(I),I=1,LINEAR)
IF(INDEX(KEYWRD,'AIDER').NE.0) READ(IR)(AICORR(I),I=1,NVAR)
LINEAR=(NORBS*(NORBS+1))/2
READ(10)(PA(I),I=1,LINEAR)
IF(NALPHA.NE.0)READ(10)(PB(I),I=1,LINEAR)
IF(LATOM.NE.0) THEN
READ(IR)((ALPARM(J,I),J=1,3),I=1,NVAR)
READ(IR)JLOOP,X0, X1, X2
ILOOP=ILOOP+1
ENDIF
ILOOP=ILOOP+1
RETURN
ENDIF
END
|
