1 |
C $Header: /u/gcmpack/MITgcm/eesupp/src/global_vec_sum.F,v 1.4 2006/08/12 03:10:26 edhill Exp $ |
2 |
C $Name: $ |
3 |
#include "CPP_EEOPTIONS.h" |
4 |
|
5 |
C-- File global_vec_sum.F: Perform a global sum on a tiled-array of vectors. |
6 |
C-- Contents |
7 |
C-- o GLOBAL_VEC_SUM_R4 |
8 |
C-- o GLOBAL_VEC_SUM_R8 |
9 |
C-- o GLOBAL_VEC_SUM_INT |
10 |
|
11 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
12 |
CBOP |
13 |
C !ROUTINE: GLOBAL_VEC_SUM_R4 |
14 |
|
15 |
C !INTERFACE: |
16 |
SUBROUTINE GLOBAL_VEC_SUM_R4( |
17 |
I ndim, nval, |
18 |
U sumPhi, |
19 |
I myThid ) |
20 |
|
21 |
C !DESCRIPTION: |
22 |
C Sum the vector over tiles and then sum the result over all MPI |
23 |
C processes. Within a process only one thread (Master) does the sum. |
24 |
C The same thread also does the inter-process sum for example with MPI |
25 |
C and then writes the result into a shared location. All threads wait |
26 |
C until the sum is available. |
27 |
C Warning: Only works if argument array "sumPhi" is shared by all threads. |
28 |
|
29 |
C !USES: |
30 |
IMPLICIT NONE |
31 |
#include "SIZE.h" |
32 |
#include "EEPARAMS.h" |
33 |
#include "EESUPPORT.h" |
34 |
c#include "GLOBAL_SUM.h" |
35 |
|
36 |
C !INPUT/OUTPUT PARAMETERS: |
37 |
C sumPhi :: input/output array |
38 |
C myThid :: thread ID |
39 |
INTEGER ndim, nval, myThid |
40 |
Real*4 sumPhi(ndim,nSx,nSy) |
41 |
CEOP |
42 |
|
43 |
C !LOCAL VARIABLES: |
44 |
C mpiRC :: MPI return code |
45 |
INTEGER i, bi,bj |
46 |
Real*4 tmp1(nval), tmp2(nval) |
47 |
#ifdef ALLOW_USE_MPI |
48 |
INTEGER mpiRC |
49 |
#endif /* ALLOW_USE_MPI */ |
50 |
|
51 |
_BARRIER |
52 |
_BEGIN_MASTER( myThid ) |
53 |
|
54 |
C Sum over all tiles |
55 |
DO i = 1,nval |
56 |
tmp1(i) = 0. |
57 |
ENDDO |
58 |
DO bj = 1,nSy |
59 |
DO bi = 1,nSx |
60 |
DO i = 1,nval |
61 |
tmp1(i) = tmp1(i) + sumPhi( i, bi,bj ) |
62 |
ENDDO |
63 |
ENDDO |
64 |
ENDDO |
65 |
|
66 |
C Invoke MPI if necessary |
67 |
IF ( usingMPI ) THEN |
68 |
|
69 |
#ifdef ALLOW_USE_MPI |
70 |
CALL MPI_Allreduce(tmp1,tmp2,nval,MPI_REAL, |
71 |
& MPI_SUM,MPI_COMM_MODEL,mpiRC) |
72 |
#endif /* ALLOW_USE_MPI */ |
73 |
|
74 |
C Copy the results to the first location of the input array |
75 |
DO i = 1,nval |
76 |
sumPhi( i, 1,1 ) = tmp2(i) |
77 |
ENDDO |
78 |
|
79 |
ELSE |
80 |
C Copy the results to the first location of the input array |
81 |
DO i = 1,nval |
82 |
sumPhi( i, 1,1 ) = tmp1(i) |
83 |
ENDDO |
84 |
|
85 |
ENDIF |
86 |
|
87 |
_END_MASTER( myThid ) |
88 |
_BARRIER |
89 |
|
90 |
RETURN |
91 |
END |
92 |
|
93 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
94 |
CBOP |
95 |
C !ROUTINE: GLOBAL_VEC_SUM_R8 |
96 |
|
97 |
C !INTERFACE: |
98 |
SUBROUTINE GLOBAL_VEC_SUM_R8( |
99 |
I ndim, nval, |
100 |
U sumPhi, |
101 |
I myThid ) |
102 |
|
103 |
C !DESCRIPTION: |
104 |
C Sum the vector over tiles and then sum the result over all MPI |
105 |
C processes. Within a process only one thread (Master) does the sum. |
106 |
C The same thread also does the inter-process sum for example with MPI |
107 |
C and then writes the result into a shared location. All threads wait |
108 |
C until the sum is available. |
109 |
C Warning: Only works if argument array "sumPhi" is shared by all threads. |
110 |
|
111 |
C !USES: |
112 |
IMPLICIT NONE |
113 |
#include "SIZE.h" |
114 |
#include "EEPARAMS.h" |
115 |
#include "EESUPPORT.h" |
116 |
c#include "GLOBAL_SUM.h" |
117 |
|
118 |
C !INPUT/OUTPUT PARAMETERS: |
119 |
C sumPhi :: input/output array |
120 |
C myThid :: thread ID |
121 |
INTEGER ndim, nval, myThid |
122 |
Real*8 sumPhi(ndim,nSx,nSy) |
123 |
CEOP |
124 |
|
125 |
C !LOCAL VARIABLES: |
126 |
C mpiRC :: MPI return code |
127 |
INTEGER i, bi,bj |
128 |
Real*8 tmp1(nval), tmp2(nval) |
129 |
#ifdef ALLOW_USE_MPI |
130 |
INTEGER mpiRC |
131 |
#endif /* ALLOW_USE_MPI */ |
132 |
|
133 |
_BARRIER |
134 |
_BEGIN_MASTER( myThid ) |
135 |
|
136 |
C Sum over all tiles |
137 |
DO i = 1,nval |
138 |
tmp1(i) = 0. |
139 |
ENDDO |
140 |
DO bj = 1,nSy |
141 |
DO bi = 1,nSx |
142 |
DO i = 1,nval |
143 |
tmp1(i) = tmp1(i) + sumPhi( i, bi,bj ) |
144 |
ENDDO |
145 |
ENDDO |
146 |
ENDDO |
147 |
|
148 |
C Invoke MPI if necessary |
149 |
IF ( usingMPI ) THEN |
150 |
|
151 |
#ifdef ALLOW_USE_MPI |
152 |
CALL MPI_Allreduce(tmp1,tmp2,nval,MPI_DOUBLE_PRECISION, |
153 |
& MPI_SUM,MPI_COMM_MODEL,mpiRC) |
154 |
#endif /* ALLOW_USE_MPI */ |
155 |
|
156 |
C Copy the results to the first location of the input array |
157 |
DO i = 1,nval |
158 |
sumPhi( i, 1,1 ) = tmp2(i) |
159 |
ENDDO |
160 |
|
161 |
ELSE |
162 |
C Copy the results to the first location of the input array |
163 |
DO i = 1,nval |
164 |
sumPhi( i, 1,1 ) = tmp1(i) |
165 |
ENDDO |
166 |
|
167 |
ENDIF |
168 |
|
169 |
_END_MASTER( myThid ) |
170 |
_BARRIER |
171 |
|
172 |
RETURN |
173 |
END |
174 |
|
175 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
176 |
CBOP |
177 |
C !ROUTINE: GLOBAL_VEC_SUM_INT |
178 |
|
179 |
C !INTERFACE: |
180 |
SUBROUTINE GLOBAL_VEC_SUM_INT( |
181 |
I ndim, nval, |
182 |
U sumPhi, |
183 |
I myThid ) |
184 |
|
185 |
C !DESCRIPTION: |
186 |
C Sum the vector over tiles and then sum the result over all MPI |
187 |
C processes. Within a process only one thread (Master) does the sum. |
188 |
C The same thread also does the inter-process sum for example with MPI |
189 |
C and then writes the result into a shared location. All threads wait |
190 |
C until the sum is available. |
191 |
C Warning: Only works if argument array "sumPhi" is shared by all threads. |
192 |
|
193 |
C !USES: |
194 |
IMPLICIT NONE |
195 |
#include "SIZE.h" |
196 |
#include "EEPARAMS.h" |
197 |
#include "EESUPPORT.h" |
198 |
c#include "GLOBAL_SUM.h" |
199 |
|
200 |
C !INPUT/OUTPUT PARAMETERS: |
201 |
C sumPhi :: input/output array |
202 |
C myThid :: thread ID |
203 |
INTEGER ndim, nval, myThid |
204 |
INTEGER sumPhi(ndim,nSx,nSy) |
205 |
CEOP |
206 |
|
207 |
C !LOCAL VARIABLES: |
208 |
C mpiRC :: MPI return code |
209 |
INTEGER i, bi,bj |
210 |
INTEGER tmp1(nval), tmp2(nval) |
211 |
#ifdef ALLOW_USE_MPI |
212 |
INTEGER mpiRC |
213 |
#endif /* ALLOW_USE_MPI */ |
214 |
|
215 |
_BARRIER |
216 |
_BEGIN_MASTER( myThid ) |
217 |
|
218 |
C Sum over all tiles |
219 |
DO i = 1,nval |
220 |
tmp1(i) = 0 |
221 |
ENDDO |
222 |
DO bj = 1,nSy |
223 |
DO bi = 1,nSx |
224 |
DO i = 1,nval |
225 |
tmp1(i) = tmp1(i) + sumPhi( i, bi,bj ) |
226 |
ENDDO |
227 |
ENDDO |
228 |
ENDDO |
229 |
|
230 |
C Invoke MPI if necessary |
231 |
IF ( usingMPI ) THEN |
232 |
|
233 |
#ifdef ALLOW_USE_MPI |
234 |
CALL MPI_Allreduce(tmp1,tmp2,nval,MPI_INTEGER, |
235 |
& MPI_SUM,MPI_COMM_MODEL,mpiRC) |
236 |
#endif /* ALLOW_USE_MPI */ |
237 |
|
238 |
C Copy the results to the first location of the input array |
239 |
DO i = 1,nval |
240 |
sumPhi( i, 1,1 ) = tmp2(i) |
241 |
ENDDO |
242 |
|
243 |
ELSE |
244 |
C Copy the results to the first location of the input array |
245 |
DO i = 1,nval |
246 |
sumPhi( i, 1,1 ) = tmp1(i) |
247 |
ENDDO |
248 |
|
249 |
ENDIF |
250 |
|
251 |
_END_MASTER( myThid ) |
252 |
_BARRIER |
253 |
|
254 |
RETURN |
255 |
END |
256 |
|
257 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |