35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
56 USE elbufdef_mod
57
58
59
60#include "implicit_f.inc"
61
62
63
64#include "comlock.inc"
65
66
67
68 INTEGER ::
69 my_real :: sharedface(6), centroid(3,6)
70
71
72
73 INTEGER :: IsMain, N, IPOS, LEVEL, IIP
76
77
78
79
80
81
82
83
84 ipos = 1
85 level = 3
86 score(1:6) = zero
87
88 ipos = maxloc(sharedface(1:6),1)
89
90 IF(sharedface(ipos) == zero) THEN
92 RETURN
93 ENDIF
94
95 mysum = sum(sharedface(1:ipos-1))
96 IF (ipos/=6)THEN
97 mysum = mysum + sum(sharedface(ipos+1:6))
98 ENDIF
99 IF (mysum == zero)THEN
101 RETURN
102 ENDIF
103
104 xyzmax(1) = maxval(centroid(1,1:6))
105 xyzmax(2) = maxval(centroid(2,1:6))
106 xyzmax(3) = maxval(centroid(3,1:6))
107
108
109 max = sharedface(ipos)
111
112 score(ipos) = 1000*(xyzmax(1)-centroid(1,ipos))+ 100*(xyzmax(2)-centroid(2,ipos))+ 10*(xyzmax(3)-centroid(3,ipos))
113
114
115 IF (ipos == 6)RETURN
116 iip = ipos
117 DO WHILE(iip < 6)
118 iip = maxloc(sharedface(iip+1:6),1)
119 nextmax = sharedface(iip)
120 IF (nextmax ==
max)
THEN
121 score(ipos) = 1000*(xyzmax(1)-centroid(1,iip))+100 * (xyzmax(2)-centroid(2
122 ENDIF
123 ENDDO
124
125 ipos = maxloc(score(1:6),1)
127
128 RETURN
integer function link_with_unique_main_cell(sharedface, centroid)