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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
SUBROUTINE FRAG__LOOP_THROUGH
+
+ (NATOMS,IFRAG,
+ HOT,IHOT,
+ HOTEQNATOM,
+ INCFRAG,
+ IPRINT,IERR,
+ INITFRAG,
+ FRAGMAT )
+
+
C------------------------------------------------------------------------
C OPERATION : FRAG__LOOP_THROUGH
C MODULE : FRAGMENT DETERMINE
C MODULE-ID : FRAG
C SUBROUTINES :
C
C DESCRIPTION : This flag will check another iteration in the
C bonding pattern and determine if the current
C fragment is filled.
C
C Input:
C
C IPRINT = level of printing variable
C IERR = sets the return error
C IFRAG = current fragment number
C HOT = current atom we're checking
C IHOT = pointer to the current atom
C HOTEQNATOM = if HOT is the last atom in
C this fragment iteration
C INCFRAG = flag that tells if we've
C exhausted the fragment and
C atom space against HOT
C NATOMS = total number of atoms
C INITFRAG = array to hold previous
C fragmentation pattern
C
C Output:
C
C FRAGMAT = contains the fragments for
C an iteration
C
C
C AUTHOR : Thomas Watson Jr.
C------------------------------------------------------------------------
C
C
C ...Declare variables and include files!
C
C
IMPLICIT NONE
LOGICAL INCFRAG,HOTEQNATOM
INTEGER I,J,K,IHOT
INTEGER IHOT2,HOT2
INTEGER IFRAG,IATOM,ILOC
INTEGER ONE,BOND,HOT,NEW
INTEGER IPRINT,IERR
INTEGER NATOMS,LSCR1
INTEGER ZERO
INTEGER CONNECT (1:NATOMS,1:NATOMS)
INTEGER INITFRAG (1:NATOMS,1:NATOMS)
INTEGER FRAGMAT (1:NATOMS,1:NATOMS)
PARAMETER ( ZERO = 0 )
PARAMETER ( ONE = 1 )
C
C
C------------------------------------------------------------------------
C
C
C ...Loop through and move all overlapped
C elements into the proper IFRAG.
C
C
IF (HOT .GT. ZERO) THEN
DO I = 1, NATOMS
DO J = 1, NATOMS
IF (I .NE. IFRAG) THEN
NEW = INITFRAG (I,J)
IF (NEW .EQ. HOT) THEN
DO K = 1, NATOMS
IF (INITFRAG (I,K) .GT. 0) THEN
FRAGMAT (IFRAG,K) = INITFRAG (I,K)
INITFRAG (I,K) = ZERO
FRAGMAT (I,K) = ZERO
ENDIF
ENDDO
ENDIF
ENDIF
ENDDO
ENDDO
ENDIF ! (HOT .GT. ZERO)
C
C
C ...Now look through for at least one more
C overlap. If it exists, we do not increment
C the fragment.
C
C
IF (HOTEQNATOM) THEN
INCFRAG = .TRUE.
DO IHOT2 = IFRAG, NATOMS
HOT2 = FRAGMAT (IFRAG,IHOT2)
IF (HOT2 .GT. ZERO) THEN
DO I = 1, NATOMS
DO J = 1, NATOMS
IF (I .NE. IFRAG) THEN
NEW = INITFRAG (I,J)
IF (NEW .EQ. HOT2) THEN
INCFRAG = .FALSE.
RETURN
ENDIF
ENDIF
ENDDO
ENDDO
ENDIF
ENDDO
ENDIF
C
C
C ...ready!
C
C
RETURN
END
|
