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
113
114
115
116
|
SUBROUTINE JCARIN (COORD,XPARAM,STEP,PRECI,B,NCOL)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
C JACOBIAN dCARTESIAN/dINTERNAL, WORKED OUT BY FINITE DIFFERENCE.
C INPUT
C XPARAM(*) : INTERNAL COORDINATES
C STEP : STEP SIZE FOR FINITE DIFFERENCE METHOD
C PRECI : .TRUE. IF 2-POINTS FINITE DIFFERENCES TO BE USED,
C .FALSE. OTHERWISE.
C OUTPUT
C B(NVAR,NCOL) : JACOBIAN, STEP TIME TOO LARGE.
C
COMMON /GEOSYM/ NDEP, LOCPAR(MAXPAR), IDEPFN(MAXPAR),
1 LOCDEP(MAXPAR)
COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
1 NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
2 NCLOSE,NOPEN,NDUMY,FRACT
3 /GEOVAR/ NVAR,LOC(2,MAXPAR), IDUMY, YPARAM(MAXPAR)
4 /EULER / TVEC(3,3),ID
5 /UCELL / L1L,L2L,L3L,L1U,L2U,L3U
6 /GEOM / GEO(3,NUMATM), XCOORD(3,NUMATM)
DIMENSION COORD(3,*),XPARAM(*),B(NVAR,*), COOLD(3,NUMATM*27)
LOGICAL PRECI
C
NCOL=3*NUMAT
IF(ID.NE.0)
1 NCOL=NCOL*(L1U-L1L+1)*(L2U-L2L+1)*(L3U-L3L+1)
C
C INTERNAL OF CENTRAL POINT
DO 10 IVAR=1,NVAR
10 GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)
C
IF (ID.EQ.0) THEN
C
C MOLECULAR SYSTEM
C ----------------
DO 30 IVAR=1,NVAR
C STEP FORWARD
GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)+STEP
IF(NDEP.NE.0) CALL SYMTRY
CALL GMETRY (GEO,COORD)
DO 20 J=1,NCOL
20 B(IVAR,J)=COORD(J,1)
30 GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)
IF (PRECI) THEN
DO 50 IVAR=1,NVAR
C STEP BACKWARD
GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)-STEP
IF(NDEP.NE.0) CALL SYMTRY
CALL GMETRY (GEO,COORD)
DO 40 J=1,NCOL
40 B(IVAR,J)=B(IVAR,J)-COORD(J,1)
50 GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)
ELSE
C CENTRAL POINT
IF(NDEP.NE.0) CALL SYMTRY
CALL GMETRY (GEO,COORD)
DO 60 IVAR=1,NVAR
DO 60 J=1,NCOL
60 B(IVAR,J)=B(IVAR,J)-COORD(J,1)
ENDIF
ELSE
C
C SOLID STATE
C -----------
DO 80 IVAR=1,NVAR
C STEP FORWARD
GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)+STEP
IF(NDEP.NE.0) CALL SYMTRY
CALL GMETRY (GEO,COORD)
IJ=0
DO 70 II=1,NUMAT
DO 70 IL=L1L,L1U
DO 70 JL=L2L,L2U
DO 70 KL=L3L,L3U
DO 70 LL=1,3
IJ=IJ+1
70 B(IVAR,IJ)=COORD(LL,II)
1 +TVEC(LL,1)*IL+TVEC(LL,2)*JL+TVEC(LL,3)*KL
80 GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)
IF (PRECI) THEN
DO 100 IVAR=1,NVAR
C STEP BACKWARD
GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)-STEP
IF(NDEP.NE.0) CALL SYMTRY
CALL GMETRY (GEO,COORD)
IJ=0
DO 90 II=1,NUMAT
DO 90 IL=L1L,L1U
DO 90 JL=L2L,L2U
DO 90 KL=L3L,L3U
DO 90 LL=1,3
IJ=IJ+1
90 B(IVAR,IJ)=B(IVAR,IJ)-COORD(LL,II)
1 -TVEC(LL,1)*IL-TVEC(LL,2)*JL-TVEC(LL,3)*KL
100 GEO(LOC(2,IVAR),LOC(1,IVAR))=XPARAM(IVAR)
ELSE
C CENTRAL POINT
IF(NDEP.NE.0) CALL SYMTRY
CALL GMETRY (GEO,COORD)
IJ=0
DO 110 II=1,NUMAT
DO 110 IL=L1L,L1U
DO 110 JL=L2L,L2U
DO 110 KL=L3L,L3U
IJ=IJ+1
DO 110 LL=1,3
110 COOLD(LL,IJ)=COORD(LL,II)
1 +TVEC(LL,1)*IL+TVEC(LL,2)*JL+TVEC(LL,3)*KL
DO 120 IVAR=1,NVAR
DO 120 IJ=1,NCOL
120 B(IVAR,IJ)=B(IVAR,IJ)-COOLD(IJ,1)
ENDIF
ENDIF
RETURN
END
|
