1*
2* $Id$
3*
4
5      subroutine center_geom(cx,cy,cz)
6      implicit none
7      real*8 cx,cy,cz
8
9*     **** local variables ***
10      integer i,nion
11
12*     **** external functions ****
13      integer  ion_nion
14      real*8   dsum,ion_rion
15      external ion_nion
16      external dsum,ion_rion
17
18*:::::::::::::::::  geometrical center of the cluster  ::::::::::::::::
19      nion = ion_nion()
20      cx =0.0d0
21      cy =0.0d0
22      cz =0.0d0
23      do i=1,nion
24         cx = cx + ion_rion(1,i)
25         cy = cy + ion_rion(2,i)
26         cz = cz + ion_rion(3,i)
27      end do
28      cx = cx/dble(nion)
29      cy = cy/dble(nion)
30      cz = cz/dble(nion)
31
32      return
33      end
34
35
36      subroutine center_mass(gx,gy,gz)
37      implicit none
38      real*8   gx,gy,gz
39
40*     **** local variables ****
41      integer nion
42      integer i
43      real*8 am
44
45*     **** external functions ****
46      integer  ion_nion
47      real*8   ion_amass,ion_rion
48      external ion_nion
49      external ion_amass,ion_rion
50
51      nion = ion_nion()
52      gx=0.0d0
53      gy=0.0d0
54      gz=0.0d0
55      am=0.0d0
56      do i=1,nion
57        gx=gx+ion_amass(i)*ion_rion(1,i)
58        gy=gy+ion_amass(i)*ion_rion(2,i)
59        gz=gz+ion_amass(i)*ion_rion(3,i)
60        am=am+ion_amass(i)
61      end do
62      gx=gx/am
63      gy=gy/am
64      gz=gz/am
65
66      return
67      end
68
69
70
71      subroutine center_v_geom(cx,cy,cz)
72      implicit none
73      real*8 cx,cy,cz
74
75*     **** local variables ***
76      integer i,nion
77
78*     **** external functions ****
79      integer  ion_nion
80      real*8   dsum,ion_vion
81      external ion_nion
82      external dsum,ion_vion
83
84*:::::::::::::::::  geometrical center of the cluster  ::::::::::::::::
85      nion = ion_nion()
86      cx =0.0d0
87      cy =0.0d0
88      cz =0.0d0
89      do i=1,nion
90         cx = cx + ion_vion(1,i)
91         cy = cy + ion_vion(2,i)
92         cz = cz + ion_vion(3,i)
93      end do
94      cx = cx/dble(nion)
95      cy = cy/dble(nion)
96      cz = cz/dble(nion)
97
98      return
99      end
100
101
102      subroutine center_v_mass(gx,gy,gz)
103      implicit none
104      real*8   gx,gy,gz
105
106*     **** local variables ****
107      integer nion
108      integer i
109      real*8 am
110
111*     **** external functions ****
112      integer  ion_nion
113      real*8   ion_amass,ion_vion
114      external ion_nion
115      external ion_amass,ion_vion
116
117      nion = ion_nion()
118      gx=0.0d0
119      gy=0.0d0
120      gz=0.0d0
121      am=0.0d0
122      do i=1,nion
123        gx=gx+ion_amass(i)*ion_vion(1,i)
124        gy=gy+ion_amass(i)*ion_vion(2,i)
125        gz=gz+ion_amass(i)*ion_vion(3,i)
126        am=am+ion_amass(i)
127      end do
128      gx=gx/am
129      gy=gy/am
130      gz=gz/am
131
132      return
133      end
134
135
136      subroutine center_F_mass(F,gx,gy,gz)
137      implicit none
138      real*8   F(3,*)
139      real*8   gx,gy,gz
140
141*     **** local variables ****
142      integer nion
143      integer i,i1
144      real*8 am
145
146*     **** external functions ****
147      integer  ion_nion
148      real*8   ion_amass
149      external ion_nion
150      external ion_amass
151
152      nion = ion_nion()
153      gx=0.0d0
154      gy=0.0d0
155      gz=0.0d0
156      am=0.0d0
157      do i=1,nion
158        gx=gx+ion_amass(i)*F(1,i)
159        gy=gy+ion_amass(i)*F(2,i)
160        gz=gz+ion_amass(i)*F(3,i)
161        am=am+ion_amass(i)
162      end do
163      gx=gx/am
164      gy=gy/am
165      gz=gz/am
166
167      return
168      end
169
170      subroutine remove_center_F_mass(F)
171      implicit none
172      real*8   F(3,*)
173
174*     **** local variables ****
175      integer nion
176      integer i,i1
177      real*8 am
178      real*8   gx,gy,gz
179
180*     **** external functions ****
181      integer  ion_nion
182      real*8   ion_amass
183      external ion_nion
184      external ion_amass
185
186      nion = ion_nion()
187      gx=0.0d0
188      gy=0.0d0
189      gz=0.0d0
190      am=0.0d0
191      do i=1,nion
192        gx=gx+ion_amass(i)*F(1,i)
193        gy=gy+ion_amass(i)*F(2,i)
194        gz=gz+ion_amass(i)*F(3,i)
195        am=am+ion_amass(i)
196      end do
197      gx=gx/am
198      gy=gy/am
199      gz=gz/am
200
201      !**** remove center of mass motion ***
202!$OMP DO
203      do i=1,nion
204         F(1,i) = F(1,i) - gx
205         F(2,i) = F(2,i) - gy
206         F(3,i) = F(3,i) - gz
207      end do
208!$OMP END DO
209
210      return
211      end
212
213
214
215      subroutine remove_center_mass(R2,R1)
216      implicit none
217      real*8   R2(3,*)
218      real*8   R1(3,*)
219
220*     **** local variables ****
221      integer nion
222      integer i,i1
223      real*8   gx,gy,gz
224      real*8   hx,hy,hz
225      real*8 am0,gx0,gy0,gz0,hx0,hy0,hz0
226      common /removecenter_shrd/ am0,gx0,gy0,gz0,hx0,hy0,hz0
227
228*     **** external functions ****
229      integer  ion_nion
230      real*8   ion_amass
231      external ion_nion
232      external ion_amass
233
234      nion = ion_nion()
235!$OMP MASTER
236      hx0 = 0.0d0
237      hy0 = 0.0d0
238      hz0 = 0.0d0
239      gx0 = 0.0d0
240      gy0 = 0.0d0
241      gz0 = 0.0d0
242      am0 = 0.0d0
243!$OMP END MASTER
244!$OMP BARRIER
245!$OMP DO private(i) reduction(+:am0,gx0,gy0,gz0,hx0,hy0,hz0)
246      do i=1,nion
247        am0=am0+ion_amass(i)
248        gx0=gx0+ion_amass(i)*R1(1,i)
249        gy0=gy0+ion_amass(i)*R1(2,i)
250        gz0=gz0+ion_amass(i)*R1(3,i)
251        hx0=hx0+ion_amass(i)*R2(1,i)
252        hy0=hy0+ion_amass(i)*R2(2,i)
253        hz0=hz0+ion_amass(i)*R2(3,i)
254      end do
255!$OMP END DO
256!$OMP BARRIER
257      hx=hx0/am0
258      hy=hy0/am0
259      hz=hz0/am0
260      gx=gx0/am0
261      gy=gy0/am0
262      gz=gz0/am0
263
264      !**** remove center of mass motion ***
265!$OMP DO private(i)
266      do i=1,nion
267         R2(1,i) = R2(1,i) - hx + gx
268         R2(2,i) = R2(2,i) - hy + gy
269         R2(3,i) = R2(3,i) - hz + gz
270      end do
271!$OMP END DO
272
273      return
274      end
275
276