/[MITgcm]/MITgcm_contrib/MPMice/beaufort/code/cpl_mpmice.F
ViewVC logotype

Annotation of /MITgcm_contrib/MPMice/beaufort/code/cpl_mpmice.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.12 - (hide annotations) (download)
Thu Mar 8 21:52:27 2012 UTC (13 years, 4 months ago) by dimitri
Branch: MAIN
Changes since 1.11: +203 -112 lines
adding more diagnostics

1 dimitri 1.12 #define CPL_MONITOR
2 dimitri 1.1 #define FIX_FOR_EDGE_WINDS
3     #include "PACKAGES_CONFIG.h"
4     #include "CPP_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: CPL_MPMICE
8     C !INTERFACE:
9     SUBROUTINE CPL_MPMICE( myTime, myIter, myThid )
10    
11     C !DESCRIPTION: \bv
12     C *==================================================================
13     C | SUBROUTINE cpl_mpmice
14     C | o Couple MITgcm ocean model with MPMice sea ice model
15     C *==================================================================
16     C \ev
17    
18     C !USES:
19     IMPLICIT NONE
20     C == Global variables ==
21     #include "SIZE.h"
22     #include "EEPARAMS.h"
23     #include "PARAMS.h"
24     #include "DYNVARS.h"
25     #include "GRID.h"
26 dimitri 1.9 #include "FFIELDS.h"
27 dimitri 1.1 #ifdef ALLOW_EXF
28     # include "EXF_OPTIONS.h"
29     # include "EXF_FIELDS.h"
30     #endif
31     #ifdef ALLOW_SEAICE
32     # include "SEAICE_OPTIONS.h"
33     # include "SEAICE.h"
34     #endif
35    
36     LOGICAL DIFFERENT_MULTIPLE
37     EXTERNAL DIFFERENT_MULTIPLE
38    
39     C !LOCAL VARIABLES:
40     C mytime - time counter for this thread (seconds)
41     C myiter - iteration counter for this thread
42     C mythid - thread number for this instance of the routine.
43     _RL mytime
44     INTEGER myiter, mythid
45     CEOP
46    
47     #ifdef ALLOW_CPL_MPMICE
48     # include "EESUPPORT.h"
49     # include "CPL_MPMICE.h"
50     COMMON /CPL_MPI_ID/
51     & myworldid, local_ocean_leader, local_ice_leader
52     integer myworldid, local_ocean_leader, local_ice_leader
53 dimitri 1.12 #ifdef ALLOW_USE_MPI
54 dimitri 1.1 integer mpistatus(MPI_STATUS_SIZE), mpierr
55 dimitri 1.12 #endif /* ALLOW_USE_MPI */
56 dimitri 1.1 integer xfer_gridsize(2)
57     integer i, j, bi, bj, buffsize, idx
58     Real*8 xfer_scalar
59     Real*8 xfer_array(Nx,Ny)
60     Real*8 xfer_bc_tracer(2*(Nx+Ny)-4)
61     Real*8 xfer_bc_veloc(2*(Nx+Ny)-6)
62     _RL local(1:sNx,1:sNy,nSx,nSy)
63 dimitri 1.5
64 dimitri 1.8 COMMON /FFIELDS_tmp/ fu_tmp, fv_tmp, Qnet_tmp, Qsw_tmp, EmPmR_tmp
65 dimitri 1.5 _RS fu_tmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
66     _RS fv_tmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
67     _RS Qnet_tmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
68     _RS Qsw_tmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
69     _RS EmPmR_tmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
70    
71 dimitri 1.1 IF( myTime .EQ. startTime ) THEN
72    
73     C Send deltatimestep
74     _BEGIN_MASTER( myThid )
75 dimitri 1.12 xfer_scalar = deltat
76     buffsize = 1
77     #ifdef CPL_DEBUG
78     print*,'MITgcm send TimeInterval', xfer_scalar
79     #else /* CPL_DEBUG */
80 dimitri 1.1 IF ( myworldid .EQ. local_ocean_leader ) THEN
81     CALL MPI_SEND(xfer_scalar,buffsize,MPI_DOUBLE_PRECISION,
82     & local_ice_leader,TimeIntervalTag,MPI_COMM_WORLD,mpierr)
83     ENDIF
84 dimitri 1.12 #endif /* CPL_DEBUG */
85 dimitri 1.1 _END_MASTER( myThid )
86    
87     C Send grid dimensions (Nx,Ny)
88     _BEGIN_MASTER( myThid )
89 dimitri 1.12 xfer_gridsize(1)=Nx
90     xfer_gridsize(2)=Ny
91     buffsize = 2
92     #ifdef CPL_DEBUG
93     print*,'MITgcm send OceanGridsize', xfer_gridsize
94     #else /* CPL_DEBUG */
95 dimitri 1.1 IF ( myworldid .EQ. local_ocean_leader ) THEN
96     CALL MPI_SEND(xfer_gridsize,buffsize,MPI_INTEGER,
97     & local_ice_leader,OceanGridsizeTag,MPI_COMM_WORLD,mpierr)
98     ENDIF
99 dimitri 1.12 #endif /* CPL_DEBUG */
100 dimitri 1.1 _END_MASTER( myThid )
101    
102     C Send ice area
103     DO bj=1,nSy
104     DO bi=1,nSx
105     DO j=1,sNy
106     DO i=1,sNx
107 dimitri 1.6 local(i,j,bi,bj) = AREA(i,j,bi,bj)
108 dimitri 1.1 ENDDO
109     ENDDO
110     ENDDO
111     ENDDO
112     CALL GATHER_2D( xfer_array, local, myThid )
113 dimitri 1.12 #ifdef CPL_DEBUG
114     CALL PLOT_FIELD_XYRL( AREA, 'AREA', myIter, myThid )
115     #else /* CPL_DEBUG */
116 dimitri 1.1 _BEGIN_MASTER( myThid )
117     IF ( myworldid .EQ. local_ocean_leader ) THEN
118     buffsize = Nx*Ny
119     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
120     & local_ice_leader,AreaTag,MPI_COMM_WORLD,mpierr)
121     ENDIF
122     _END_MASTER( myThid )
123 dimitri 1.12 #endif /* CPL_DEBUG */
124 dimitri 1.1
125     C Send ice thickness
126     DO bj=1,nSy
127     DO bi=1,nSx
128     DO j=1,sNy
129     DO i=1,sNx
130 dimitri 1.6 local(i,j,bi,bj) = HEFF(i,j,bi,bj)
131 dimitri 1.1 ENDDO
132     ENDDO
133     ENDDO
134     ENDDO
135     CALL GATHER_2D( xfer_array, local, myThid )
136 dimitri 1.12 #ifdef CPL_DEBUG
137     CALL PLOT_FIELD_XYRL( HEFF, 'HEFF', myIter, myThid )
138     #else /* CPL_DEBUG */
139 dimitri 1.1 _BEGIN_MASTER( myThid )
140     IF ( myworldid .EQ. local_ocean_leader ) THEN
141     buffsize = Nx*Ny
142     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
143     & local_ice_leader,HeffTag,MPI_COMM_WORLD,mpierr)
144     ENDIF
145     _END_MASTER( myThid )
146 dimitri 1.12 #endif /* CPL_DEBUG */
147 dimitri 1.1
148     C Send ice salinity
149     DO bj=1,nSy
150     DO bi=1,nSx
151     DO j=1,sNy
152     DO i=1,sNx
153     local(i,j,bi,bj) = HSALT(i,j,bi,bj)
154     ENDDO
155     ENDDO
156     ENDDO
157     ENDDO
158     CALL GATHER_2D( xfer_array, local, myThid )
159 dimitri 1.12 #ifdef CPL_DEBUG
160     CALL PLOT_FIELD_XYRL( HSALT, 'HSALT', myIter, myThid )
161     #else /* CPL_DEBUG */
162 dimitri 1.1 _BEGIN_MASTER( myThid )
163     IF ( myworldid .EQ. local_ocean_leader ) THEN
164     buffsize = Nx*Ny
165     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
166     & local_ice_leader,HsaltTag,MPI_COMM_WORLD,mpierr)
167     ENDIF
168     _END_MASTER( myThid )
169 dimitri 1.12 #endif /* CPL_DEBUG */
170 dimitri 1.1
171     C Send snow thickness
172     DO bj=1,nSy
173     DO bi=1,nSx
174     DO j=1,sNy
175     DO i=1,sNx
176     local(i,j,bi,bj) = HSNOW(i,j,bi,bj)
177     ENDDO
178     ENDDO
179     ENDDO
180     ENDDO
181     CALL GATHER_2D( xfer_array, local, myThid )
182 dimitri 1.12 #ifdef CPL_DEBUG
183     CALL PLOT_FIELD_XYRL( HSNOW, 'HSNOW', myIter, myThid )
184     #else /* CPL_DEBUG */
185 dimitri 1.1 _BEGIN_MASTER( myThid )
186     IF ( myworldid .EQ. local_ocean_leader ) THEN
187     buffsize = Nx*Ny
188     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
189     & local_ice_leader,HsnowTag,MPI_COMM_WORLD,mpierr)
190     ENDIF
191     _END_MASTER( myThid )
192 dimitri 1.12 #endif /* CPL_DEBUG */
193 dimitri 1.1
194     ENDIF ! ( myTime .EQ. startTime )
195    
196     C Send ocean model time
197     _BEGIN_MASTER( myThid )
198 dimitri 1.12 xfer_scalar = myTime
199     buffsize = 1
200     #ifdef CPL_DEBUG
201     print*,'MITgcm send OceanTime', xfer_scalar
202     #else /* CPL_DEBUG */
203 dimitri 1.1 IF ( myworldid .EQ. local_ocean_leader ) THEN
204     CALL MPI_SEND(xfer_scalar,buffsize,MPI_DOUBLE_PRECISION,
205     & local_ice_leader,OceanTimeTag,MPI_COMM_WORLD,mpierr)
206     ENDIF
207 dimitri 1.12 #endif /* CPL_DEBUG */
208 dimitri 1.1 _END_MASTER( myThid )
209    
210     C Send boundary ice area
211     DO bj=1,nSy
212     DO bi=1,nSx
213     DO j=1,sNy
214     DO i=1,sNx
215 dimitri 1.6 local(i,j,bi,bj) = AREA(i,j,bi,bj)
216 dimitri 1.1 ENDDO
217     ENDDO
218     ENDDO
219     ENDDO
220     CALL GATHER_2D( xfer_array, local, myThid )
221     idx = 0
222     DO i = 1, Nx
223     idx = idx + 1
224     xfer_bc_tracer(idx) = xfer_array(i,1)
225     ENDDO
226     DO j = 2, Ny
227     idx = idx + 1
228     xfer_bc_tracer(idx) = xfer_array(Nx,j)
229     ENDDO
230 dimitri 1.3 DO i = (Nx-1), 1, -1
231 dimitri 1.1 idx = idx + 1
232     xfer_bc_tracer(idx) = xfer_array(i,Ny)
233     ENDDO
234 dimitri 1.3 DO j = (Ny-1), 2, -1
235 dimitri 1.1 idx = idx + 1
236     xfer_bc_tracer(idx) = xfer_array(1,j)
237     ENDDO
238 dimitri 1.12 #ifdef CPL_DEBUG
239     CALL PLOT_FIELD_XYRL( AREA, 'AREA obcs', myIter, myThid )
240     #else /* CPL_DEBUG */
241 dimitri 1.1 _BEGIN_MASTER( myThid )
242     IF ( myworldid .EQ. local_ocean_leader ) THEN
243     buffsize = 2*(Nx+Ny)-4
244 dimitri 1.12 cdb print*,'MITgcm is about to send AreaBcTag',buffsize
245 dimitri 1.1 CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
246     & local_ice_leader,AreaBcTag,MPI_COMM_WORLD,mpierr)
247 dimitri 1.12 cdb print*,'MITgcm has sent AreaBcTag',buffsize
248 dimitri 1.1 ENDIF
249     _END_MASTER( myThid )
250 dimitri 1.12 #endif /* CPL_DEBUG */
251 dimitri 1.1
252     C Send boundary ice thickness
253     DO bj=1,nSy
254     DO bi=1,nSx
255     DO j=1,sNy
256     DO i=1,sNx
257 dimitri 1.6 local(i,j,bi,bj) = HEFF(i,j,bi,bj)
258 dimitri 1.1 ENDDO
259     ENDDO
260     ENDDO
261     ENDDO
262     CALL GATHER_2D( xfer_array, local, myThid )
263     idx = 0
264     DO i = 1, Nx
265     idx = idx + 1
266     xfer_bc_tracer(idx) = xfer_array(i,1)
267     ENDDO
268     DO j = 2, Ny
269     idx = idx + 1
270     xfer_bc_tracer(idx) = xfer_array(Nx,j)
271     ENDDO
272 dimitri 1.3 DO i = (Nx-1), 1, -1
273 dimitri 1.1 idx = idx + 1
274     xfer_bc_tracer(idx) = xfer_array(i,Ny)
275     ENDDO
276 dimitri 1.3 DO j = (Ny-1), 2, -1
277 dimitri 1.1 idx = idx + 1
278     xfer_bc_tracer(idx) = xfer_array(1,j)
279     ENDDO
280 dimitri 1.12 #ifdef CPL_DEBUG
281     CALL PLOT_FIELD_XYRL( HEFF, 'HEFF obcs', myIter, myThid )
282     #else /* CPL_DEBUG */
283 dimitri 1.1 _BEGIN_MASTER( myThid )
284     IF ( myworldid .EQ. local_ocean_leader ) THEN
285     buffsize = 2*(Nx+Ny)-4
286     CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
287     & local_ice_leader,HeffBcTag,MPI_COMM_WORLD,mpierr)
288     ENDIF
289     _END_MASTER( myThid )
290 dimitri 1.12 #endif /* CPL_DEBUG */
291 dimitri 1.1
292     C Send boundary ice salinity
293     DO bj=1,nSy
294     DO bi=1,nSx
295     DO j=1,sNy
296     DO i=1,sNx
297     local(i,j,bi,bj) = HSALT(i,j,bi,bj)
298     ENDDO
299     ENDDO
300     ENDDO
301     ENDDO
302     CALL GATHER_2D( xfer_array, local, myThid )
303     idx = 0
304     DO i = 1, Nx
305     idx = idx + 1
306     xfer_bc_tracer(idx) = xfer_array(i,1)
307     ENDDO
308     DO j = 2, Ny
309     idx = idx + 1
310     xfer_bc_tracer(idx) = xfer_array(Nx,j)
311     ENDDO
312 dimitri 1.3 DO i = (Nx-1), 1, -1
313 dimitri 1.1 idx = idx + 1
314     xfer_bc_tracer(idx) = xfer_array(i,Ny)
315     ENDDO
316 dimitri 1.3 DO j = (Ny-1), 2, -1
317 dimitri 1.1 idx = idx + 1
318     xfer_bc_tracer(idx) = xfer_array(1,j)
319     ENDDO
320 dimitri 1.12 #ifdef CPL_DEBUG
321     CALL PLOT_FIELD_XYRL( HSALT, 'HSALT obcs', myIter, myThid )
322     #else /* CPL_DEBUG */
323 dimitri 1.1 _BEGIN_MASTER( myThid )
324     IF ( myworldid .EQ. local_ocean_leader ) THEN
325     buffsize = 2*(Nx+Ny)-4
326     CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
327     & local_ice_leader,HsaltBcTag,MPI_COMM_WORLD,mpierr)
328     ENDIF
329     _END_MASTER( myThid )
330 dimitri 1.12 #endif /* CPL_DEBUG */
331 dimitri 1.1
332     C Send boundary snow thickness
333     DO bj=1,nSy
334     DO bi=1,nSx
335     DO j=1,sNy
336     DO i=1,sNx
337     local(i,j,bi,bj) = HSNOW(i,j,bi,bj)
338     ENDDO
339     ENDDO
340     ENDDO
341     ENDDO
342     CALL GATHER_2D( xfer_array, local, myThid )
343     idx = 0
344     DO i = 1, Nx
345     idx = idx + 1
346     xfer_bc_tracer(idx) = xfer_array(i,1)
347     ENDDO
348     DO j = 2, Ny
349     idx = idx + 1
350     xfer_bc_tracer(idx) = xfer_array(Nx,j)
351     ENDDO
352 dimitri 1.3 DO i = (Nx-1), 1, -1
353 dimitri 1.1 idx = idx + 1
354     xfer_bc_tracer(idx) = xfer_array(i,Ny)
355     ENDDO
356 dimitri 1.3 DO j = (Ny-1), 2, -1
357 dimitri 1.1 idx = idx + 1
358     xfer_bc_tracer(idx) = xfer_array(1,j)
359     ENDDO
360 dimitri 1.12 #ifdef CPL_DEBUG
361     CALL PLOT_FIELD_XYRL( HSNOW, 'HSNOW obcs', myIter, myThid )
362     #else /* CPL_DEBUG */
363 dimitri 1.1 _BEGIN_MASTER( myThid )
364     IF ( myworldid .EQ. local_ocean_leader ) THEN
365     buffsize = 2*(Nx+Ny)-4
366     CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
367     & local_ice_leader,HsnowBcTag,MPI_COMM_WORLD,mpierr)
368     ENDIF
369     _END_MASTER( myThid )
370 dimitri 1.12 #endif /* CPL_DEBUG */
371 dimitri 1.1
372     C Send boundary u ice
373     DO bj=1,nSy
374     DO bi=1,nSx
375     DO j=1,sNy
376     DO i=1,sNx
377 dimitri 1.6 local(i,j,bi,bj) = UICE(i,j,bi,bj)
378 dimitri 1.1 ENDDO
379     ENDDO
380     ENDDO
381     ENDDO
382     CALL GATHER_2D( xfer_array, local, myThid )
383     idx = 0
384     DO i = 2, Nx
385     idx = idx + 1
386     xfer_bc_veloc(idx) = xfer_array(i,1)
387     ENDDO
388     DO j = 2, Ny
389     idx = idx + 1
390     xfer_bc_veloc(idx) = xfer_array(Nx,j)
391     ENDDO
392 dimitri 1.3 DO i = (Nx-1), 2, -1
393 dimitri 1.1 idx = idx + 1
394     xfer_bc_veloc(idx) = xfer_array(i,Ny)
395     ENDDO
396 dimitri 1.3 DO j = (Ny-1), 2, -1
397 dimitri 1.1 idx = idx + 1
398     xfer_bc_veloc(idx) = xfer_array(2,j)
399     ENDDO
400 dimitri 1.12 #ifdef CPL_DEBUG
401     CALL PLOT_FIELD_XYRL( UICE, 'UICE obcs', myIter, myThid )
402     #else /* CPL_DEBUG */
403 dimitri 1.1 _BEGIN_MASTER( myThid )
404     IF ( myworldid .EQ. local_ocean_leader ) THEN
405     buffsize = 2*(Nx+Ny)-6
406     CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,
407     & local_ice_leader,UiceBcTag,MPI_COMM_WORLD,mpierr)
408     ENDIF
409     _END_MASTER( myThid )
410 dimitri 1.12 #endif /* CPL_DEBUG */
411 dimitri 1.1
412     C Send boundary v ice
413     DO bj=1,nSy
414     DO bi=1,nSx
415     DO j=1,sNy
416     DO i=1,sNx
417 dimitri 1.6 local(i,j,bi,bj) = VICE(i,j,bi,bj)
418 dimitri 1.1 ENDDO
419     ENDDO
420     ENDDO
421     ENDDO
422     CALL GATHER_2D( xfer_array, local, myThid )
423     idx = 0
424     DO i = 1, Nx
425     idx = idx + 1
426     xfer_bc_veloc(idx) = xfer_array(i,2)
427     ENDDO
428     DO j = 3, Ny
429     idx = idx + 1
430     xfer_bc_veloc(idx) = xfer_array(Nx,j)
431     ENDDO
432 dimitri 1.3 DO i = (Nx-1), 1, -1
433 dimitri 1.1 idx = idx + 1
434     xfer_bc_veloc(idx) = xfer_array(i,Ny)
435     ENDDO
436 dimitri 1.3 DO j = (Ny-1), 3, -1
437 dimitri 1.1 idx = idx + 1
438     xfer_bc_veloc(idx) = xfer_array(1,j)
439     ENDDO
440 dimitri 1.12 #ifdef CPL_DEBUG
441     CALL PLOT_FIELD_XYRL( VICE, 'VICE obcs', myIter, myThid )
442     #else /* CPL_DEBUG */
443 dimitri 1.1 _BEGIN_MASTER( myThid )
444     IF ( myworldid .EQ. local_ocean_leader ) THEN
445     buffsize = 2*(Nx+Ny)-6
446     CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,
447     & local_ice_leader,ViceBcTag,MPI_COMM_WORLD,mpierr)
448     ENDIF
449     _END_MASTER( myThid )
450 dimitri 1.12 #endif /* CPL_DEBUG */
451 dimitri 1.1
452     C Send u-wind velocity
453     DO bj=1,nSy
454     DO bi=1,nSx
455     DO j=1,sNy
456     DO i=1,sNx
457     local(i,j,bi,bj) = uwind(i,j,bi,bj)
458     ENDDO
459     ENDDO
460     ENDDO
461     ENDDO
462     CALL GATHER_2D( xfer_array, local, myThid )
463 dimitri 1.12 #ifdef CPL_DEBUG
464     CALL PLOT_FIELD_XYRL( UWIND, 'UWIND', myIter, myThid )
465     #else /* CPL_DEBUG */
466 dimitri 1.1 _BEGIN_MASTER( myThid )
467     IF ( myworldid .EQ. local_ocean_leader ) THEN
468 dimitri 1.12 # ifdef FIX_FOR_EDGE_WINDS
469 dimitri 1.1 DO j=1,Ny
470     xfer_array(Nx,j)=xfer_array(Nx-1,j)
471     ENDDO
472 dimitri 1.12 # endif /* FIX_FOR_EDGE_WINDS */
473 dimitri 1.1 buffsize = Nx*Ny
474     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
475     & local_ice_leader,UwindTag,MPI_COMM_WORLD,mpierr)
476     ENDIF
477     _END_MASTER( myThid )
478 dimitri 1.12 #endif /* CPL_DEBUG */
479 dimitri 1.1
480     C Send v-wind velocity
481     DO bj=1,nSy
482     DO bi=1,nSx
483     DO j=1,sNy
484     DO i=1,sNx
485     local(i,j,bi,bj) = vwind(i,j,bi,bj)
486     ENDDO
487     ENDDO
488     ENDDO
489     ENDDO
490     CALL GATHER_2D( xfer_array, local, myThid )
491 dimitri 1.12 #ifdef CPL_DEBUG
492     CALL PLOT_FIELD_XYRL( VWIND, 'VWIND', myIter, myThid )
493     #else /* CPL_DEBUG */
494 dimitri 1.1 _BEGIN_MASTER( myThid )
495     IF ( myworldid .EQ. local_ocean_leader ) THEN
496 dimitri 1.12 # ifdef FIX_FOR_EDGE_WINDS
497 dimitri 1.1 DO i=1,Nx
498     xfer_array(i,Ny)=xfer_array(i,Ny-1)
499     ENDDO
500 dimitri 1.12 # endif /* FIX_FOR_EDGE_WINDS */
501 dimitri 1.1 buffsize = Nx*Ny
502     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
503     & local_ice_leader,VwindTag,MPI_COMM_WORLD,mpierr)
504     ENDIF
505     _END_MASTER( myThid )
506 dimitri 1.12 #endif /* CPL_DEBUG */
507 dimitri 1.1
508     C Send downward longwave radiation
509     DO bj=1,nSy
510     DO bi=1,nSx
511     DO j=1,sNy
512     DO i=1,sNx
513     local(i,j,bi,bj) = lwdown(i,j,bi,bj)
514     ENDDO
515     ENDDO
516     ENDDO
517     ENDDO
518     CALL GATHER_2D( xfer_array, local, myThid )
519 dimitri 1.12 #ifdef CPL_DEBUG
520     CALL PLOT_FIELD_XYRL( LWDOWN, 'LWDOWN', myIter, myThid )
521     #else /* CPL_DEBUG */
522 dimitri 1.1 _BEGIN_MASTER( myThid )
523     IF ( myworldid .EQ. local_ocean_leader ) THEN
524     buffsize = Nx*Ny
525     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
526     & local_ice_leader,LwDownTag,MPI_COMM_WORLD,mpierr)
527     ENDIF
528     _END_MASTER( myThid )
529 dimitri 1.12 #endif /* CPL_DEBUG */
530 dimitri 1.1
531     C Send downward shortwave radiation
532     DO bj=1,nSy
533     DO bi=1,nSx
534     DO j=1,sNy
535     DO i=1,sNx
536     local(i,j,bi,bj) = swdown(i,j,bi,bj)
537     ENDDO
538     ENDDO
539     ENDDO
540     ENDDO
541     CALL GATHER_2D( xfer_array, local, myThid )
542 dimitri 1.12 #ifdef CPL_DEBUG
543     CALL PLOT_FIELD_XYRL( SWDOWN, 'SWDOWN', myIter, myThid )
544     #else /* CPL_DEBUG */
545 dimitri 1.1 _BEGIN_MASTER( myThid )
546     IF ( myworldid .EQ. local_ocean_leader ) THEN
547     buffsize = Nx*Ny
548     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
549     & local_ice_leader,SwDownTag,MPI_COMM_WORLD,mpierr)
550     ENDIF
551     _END_MASTER( myThid )
552 dimitri 1.12 #endif /* CPL_DEBUG */
553 dimitri 1.1
554     C Send air temperature
555     DO bj=1,nSy
556     DO bi=1,nSx
557     DO j=1,sNy
558     DO i=1,sNx
559     local(i,j,bi,bj) = atemp(i,j,bi,bj)
560     ENDDO
561     ENDDO
562     ENDDO
563     ENDDO
564     CALL GATHER_2D( xfer_array, local, myThid )
565 dimitri 1.12 #ifdef CPL_DEBUG
566     CALL PLOT_FIELD_XYRL( ATEMP, 'ATEMP', myIter, myThid )
567     #else /* CPL_DEBUG */
568 dimitri 1.1 _BEGIN_MASTER( myThid )
569     IF ( myworldid .EQ. local_ocean_leader ) THEN
570     buffsize = Nx*Ny
571     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
572     & local_ice_leader,AtempTag,MPI_COMM_WORLD,mpierr)
573     ENDIF
574     _END_MASTER( myThid )
575 dimitri 1.12 #endif /* CPL_DEBUG */
576 dimitri 1.1
577     C Send humidity
578     DO bj=1,nSy
579     DO bi=1,nSx
580     DO j=1,sNy
581     DO i=1,sNx
582     local(i,j,bi,bj) = aqh(i,j,bi,bj)
583     ENDDO
584     ENDDO
585     ENDDO
586     ENDDO
587     CALL GATHER_2D( xfer_array, local, myThid )
588 dimitri 1.12 #ifdef CPL_DEBUG
589     CALL PLOT_FIELD_XYRL( AQH, 'AQH', myIter, myThid )
590     #else /* CPL_DEBUG */
591 dimitri 1.1 _BEGIN_MASTER( myThid )
592     IF ( myworldid .EQ. local_ocean_leader ) THEN
593     buffsize = Nx*Ny
594     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
595     & local_ice_leader,AqhTag,MPI_COMM_WORLD,mpierr)
596     ENDIF
597     _END_MASTER( myThid )
598 dimitri 1.12 #endif /* CPL_DEBUG */
599 dimitri 1.1
600     C Send precipitation
601     DO bj=1,nSy
602     DO bi=1,nSx
603     DO j=1,sNy
604     DO i=1,sNx
605     local(i,j,bi,bj) = precip(i,j,bi,bj)
606     ENDDO
607     ENDDO
608     ENDDO
609     ENDDO
610     CALL GATHER_2D( xfer_array, local, myThid )
611 dimitri 1.12 #ifdef CPL_DEBUG
612     CALL PLOT_FIELD_XYRL( PRECIP, 'PRECIP', myIter, myThid )
613     #else /* CPL_DEBUG */
614 dimitri 1.1 _BEGIN_MASTER( myThid )
615     IF ( myworldid .EQ. local_ocean_leader ) THEN
616     buffsize = Nx*Ny
617     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
618     & local_ice_leader,PrecipTag,MPI_COMM_WORLD,mpierr)
619     ENDIF
620     _END_MASTER( myThid )
621 dimitri 1.12 #endif /* CPL_DEBUG */
622 dimitri 1.1
623     C Send ocean surface temperature
624     DO bj=1,nSy
625     DO bi=1,nSx
626     DO j=1,sNy
627     DO i=1,sNx
628     local(i,j,bi,bj) = theta(i,j,1,bi,bj)
629     ENDDO
630     ENDDO
631     ENDDO
632     ENDDO
633     CALL GATHER_2D( xfer_array, local, myThid )
634 dimitri 1.12 #ifdef CPL_DEBUG
635     CALL PLOT_FIELD_XYZRL( THETA, 'SST', 1, myIter, myThid )
636     #else /* CPL_DEBUG */
637 dimitri 1.1 _BEGIN_MASTER( myThid )
638     IF ( myworldid .EQ. local_ocean_leader ) THEN
639     buffsize = Nx*Ny
640     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
641     & local_ice_leader,SstTag,MPI_COMM_WORLD,mpierr)
642     ENDIF
643     _END_MASTER( myThid )
644 dimitri 1.12 #endif /* CPL_DEBUG */
645 dimitri 1.1
646 dimitri 1.5 C Send ocean surface salinity
647     DO bj=1,nSy
648     DO bi=1,nSx
649     DO j=1,sNy
650     DO i=1,sNx
651     local(i,j,bi,bj) = salt(i,j,1,bi,bj)
652     ENDDO
653     ENDDO
654     ENDDO
655     ENDDO
656     CALL GATHER_2D( xfer_array, local, myThid )
657 dimitri 1.12 #ifdef CPL_DEBUG
658     CALL PLOT_FIELD_XYZRL( SALT, 'SSS', 1, myIter, myThid )
659     #else /* CPL_DEBUG */
660 dimitri 1.5 _BEGIN_MASTER( myThid )
661     IF ( myworldid .EQ. local_ocean_leader ) THEN
662     buffsize = Nx*Ny
663     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
664     & local_ice_leader,SssTag,MPI_COMM_WORLD,mpierr)
665     ENDIF
666     _END_MASTER( myThid )
667 dimitri 1.12 #endif /* CPL_DEBUG */
668 dimitri 1.5
669 dimitri 1.1 C Send surface u current
670     DO bj=1,nSy
671     DO bi=1,nSx
672     DO j=1,sNy
673     DO i=1,sNx
674     local(i,j,bi,bj) = uVel(i,j,1,bi,bj)
675     ENDDO
676     ENDDO
677     ENDDO
678     ENDDO
679     CALL GATHER_2D( xfer_array, local, myThid )
680 dimitri 1.12 #ifdef CPL_DEBUG
681     CALL PLOT_FIELD_XYZRL( uVel, 'uVel(k=1)', 1, myIter, myThid )
682     #else /* CPL_DEBUG */
683 dimitri 1.1 _BEGIN_MASTER( myThid )
684     IF ( myworldid .EQ. local_ocean_leader ) THEN
685     buffsize = Nx*Ny
686     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
687     & local_ice_leader,UvelTag,MPI_COMM_WORLD,mpierr)
688     ENDIF
689     _END_MASTER( myThid )
690 dimitri 1.12 #endif /* CPL_DEBUG */
691 dimitri 1.1
692     C Send surface v current
693     DO bj=1,nSy
694     DO bi=1,nSx
695     DO j=1,sNy
696     DO i=1,sNx
697     local(i,j,bi,bj) = vVel(i,j,1,bi,bj)
698     ENDDO
699     ENDDO
700     ENDDO
701     ENDDO
702     CALL GATHER_2D( xfer_array, local, myThid )
703 dimitri 1.12 #ifdef CPL_DEBUG
704     CALL PLOT_FIELD_XYZRL( vVel, 'vVel(k=1)', 1, myIter, myThid )
705     #else /* CPL_DEBUG */
706 dimitri 1.1 _BEGIN_MASTER( myThid )
707     IF ( myworldid .EQ. local_ocean_leader ) THEN
708     buffsize = Nx*Ny
709     CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
710     & local_ice_leader,VvelTag,MPI_COMM_WORLD,mpierr)
711     ENDIF
712     _END_MASTER( myThid )
713 dimitri 1.12 #endif /* CPL_DEBUG */
714 dimitri 1.1
715     C Receive ice model time
716     _BEGIN_MASTER( myThid )
717 dimitri 1.12 #ifdef CPL_DEBUG
718     print*,'MITgcm receive IceTime'
719     #else /* CPL_DEBUG */
720 dimitri 1.1 IF ( myworldid .EQ. local_ocean_leader ) THEN
721     buffsize = 1
722     CALL MPI_RECV(xfer_scalar,1,MPI_DOUBLE_PRECISION,
723     & local_ice_leader,IceTimeTag,MPI_COMM_WORLD,mpistatus,mpierr)
724     ENDIF
725 dimitri 1.12 #endif /* CPL_DEBUG */
726 dimitri 1.1 _END_MASTER( myThid )
727    
728     C Receive ice area Nx*Ny Real*8
729 dimitri 1.12 #ifdef CPL_DEBUG
730     DO bj=1,nSy
731     DO bi=1,nSx
732     DO j=1,sNy
733     DO i=1,sNx
734     local(i,j,bi,bj) = AREA(i,j,bi,bj)
735     ENDDO
736     ENDDO
737     ENDDO
738     ENDDO
739     #else /* CPL_DEBUG */
740 dimitri 1.1 _BEGIN_MASTER( myThid )
741     IF ( myworldid .EQ. local_ocean_leader ) THEN
742     buffsize = Nx*Ny
743     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
744     & local_ice_leader,AreaTag,MPI_COMM_WORLD,mpistatus,mpierr)
745     ENDIF
746     _END_MASTER( myThid )
747     CALL SCATTER_2D( xfer_array, local, myThid )
748 dimitri 1.12 #endif /* CPL_DEBUG */
749 dimitri 1.5 DO bj=1,nSy
750     DO bi=1,nSx
751     DO j=1,sNy
752     DO i=1,sNx
753     AREA(i,j,bi,bj) = local(i,j,bi,bj)
754     ENDDO
755     ENDDO
756     ENDDO
757     ENDDO
758 dimitri 1.12 #ifdef CPL_MONITOR
759     CALL PLOT_FIELD_XYRL( AREA, 'ice area', myIter, myThid )
760     #endif /* CPL_MONITOR */
761    
762     C Receive ice thickness
763 dimitri 1.2 #ifdef CPL_DEBUG
764 dimitri 1.1 DO bj=1,nSy
765     DO bi=1,nSx
766     DO j=1,sNy
767     DO i=1,sNx
768 dimitri 1.12 local(i,j,bi,bj) = HEFF(i,j,bi,bj)
769 dimitri 1.1 ENDDO
770     ENDDO
771     ENDDO
772     ENDDO
773 dimitri 1.12 #else /* CPL_DEBUG */
774 dimitri 1.1 _BEGIN_MASTER( myThid )
775     IF ( myworldid .EQ. local_ocean_leader ) THEN
776     buffsize = Nx*Ny
777     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
778     & local_ice_leader,HeffTag,MPI_COMM_WORLD,mpistatus,mpierr)
779     ENDIF
780     _END_MASTER( myThid )
781     CALL SCATTER_2D( xfer_array, local, myThid )
782 dimitri 1.12 #endif /* CPL_DEBUG */
783 dimitri 1.5 DO bj=1,nSy
784     DO bi=1,nSx
785     DO j=1,sNy
786     DO i=1,sNx
787     HEFF(i,j,bi,bj) = local(i,j,bi,bj)
788     ENDDO
789     ENDDO
790     ENDDO
791     ENDDO
792 dimitri 1.12 #ifdef CPL_MONITOR
793     CALL PLOT_FIELD_XYRL( HEFF, 'ice thickness', myIter, myThid )
794     #endif /* CPL_MONITOR */
795    
796     C Receive ice salinity
797 dimitri 1.2 #ifdef CPL_DEBUG
798 dimitri 1.1 DO bj=1,nSy
799     DO bi=1,nSx
800     DO j=1,sNy
801     DO i=1,sNx
802 dimitri 1.12 local(i,j,bi,bj) = HSALT(i,j,bi,bj)
803 dimitri 1.1 ENDDO
804     ENDDO
805     ENDDO
806     ENDDO
807 dimitri 1.12 #else /* CPL_DEBUG */
808 dimitri 1.1 _BEGIN_MASTER( myThid )
809     IF ( myworldid .EQ. local_ocean_leader ) THEN
810     buffsize = Nx*Ny
811     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
812     & local_ice_leader,HsaltTag,MPI_COMM_WORLD,mpistatus,mpierr)
813     ENDIF
814     _END_MASTER( myThid )
815     CALL SCATTER_2D( xfer_array, local, myThid )
816 dimitri 1.12 #endif /* CPL_DEBUG */
817 dimitri 1.5 DO bj=1,nSy
818     DO bi=1,nSx
819     DO j=1,sNy
820     DO i=1,sNx
821     HSALT(i,j,bi,bj) = local(i,j,bi,bj)
822     ENDDO
823     ENDDO
824     ENDDO
825     ENDDO
826 dimitri 1.12 #ifdef CPL_MONITOR
827     CALL PLOT_FIELD_XYRL( HSALT, 'ice salinity', myIter, myThid )
828     #endif /* CPL_MONITOR */
829    
830     C Receive snow thickness
831 dimitri 1.2 #ifdef CPL_DEBUG
832 dimitri 1.1 DO bj=1,nSy
833     DO bi=1,nSx
834     DO j=1,sNy
835     DO i=1,sNx
836 dimitri 1.12 local(i,j,bi,bj) = HSNOW(i,j,bi,bj)
837 dimitri 1.1 ENDDO
838     ENDDO
839     ENDDO
840     ENDDO
841 dimitri 1.12 #else /* CPL_DEBUG */
842 dimitri 1.1 _BEGIN_MASTER( myThid )
843     IF ( myworldid .EQ. local_ocean_leader ) THEN
844     buffsize = Nx*Ny
845     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
846     & local_ice_leader,HsnowTag,MPI_COMM_WORLD,mpistatus,mpierr)
847     ENDIF
848     _END_MASTER( myThid )
849     CALL SCATTER_2D( xfer_array, local, myThid )
850 dimitri 1.12 #endif /* CPL_DEBUG */
851 dimitri 1.5 DO bj=1,nSy
852     DO bi=1,nSx
853     DO j=1,sNy
854     DO i=1,sNx
855     HSNOW(i,j,bi,bj) = local(i,j,bi,bj)
856     ENDDO
857     ENDDO
858     ENDDO
859     ENDDO
860 dimitri 1.12 #ifdef CPL_MONITOR
861     CALL PLOT_FIELD_XYRL( HSNOW, 'snow thickness', myIter, myThid )
862     #endif /* CPL_MONITOR */
863    
864     C Receive u surface stress
865 dimitri 1.2 #ifdef CPL_DEBUG
866 dimitri 1.1 DO bj=1,nSy
867     DO bi=1,nSx
868     DO j=1,sNy
869     DO i=1,sNx
870 dimitri 1.12 local(i,j,bi,bj) = fu(i,j,bi,bj)
871 dimitri 1.1 ENDDO
872     ENDDO
873     ENDDO
874     ENDDO
875 dimitri 1.12 #else /* CPL_DEBUG */
876 dimitri 1.1 _BEGIN_MASTER( myThid )
877     IF ( myworldid .EQ. local_ocean_leader ) THEN
878     buffsize = Nx*Ny
879     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
880     & local_ice_leader,UstressTag,MPI_COMM_WORLD,mpistatus,mpierr)
881     ENDIF
882     _END_MASTER( myThid )
883     CALL SCATTER_2D( xfer_array, local, myThid )
884 dimitri 1.5 DO bj=1,nSy
885     DO bi=1,nSx
886     DO j=1,sNy
887     DO i=1,sNx
888 dimitri 1.7 fu(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +
889 dimitri 1.8 & (1.-AREA(i,j,bi,bj)) * fu_tmp(i,j,bi,bj)
890 dimitri 1.5 ENDDO
891     ENDDO
892     ENDDO
893     ENDDO
894 dimitri 1.12 #endif /* CPL_DEBUG */
895     #ifdef CPL_MONITOR
896     CALL PLOT_FIELD_XYRL( local, 'u stress', myIter, myThid )
897     #endif /* CPL_MONITOR */
898    
899     C Receive v surface stress
900 dimitri 1.2 #ifdef CPL_DEBUG
901 dimitri 1.1 DO bj=1,nSy
902     DO bi=1,nSx
903     DO j=1,sNy
904     DO i=1,sNx
905 dimitri 1.12 local(i,j,bi,bj) = fv(i,j,bi,bj)
906 dimitri 1.1 ENDDO
907     ENDDO
908     ENDDO
909     ENDDO
910 dimitri 1.12 #else /* CPL_DEBUG */
911 dimitri 1.1 _BEGIN_MASTER( myThid )
912     IF ( myworldid .EQ. local_ocean_leader ) THEN
913     buffsize = Nx*Ny
914     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
915     & local_ice_leader,VstressTag,MPI_COMM_WORLD,mpistatus,mpierr)
916     ENDIF
917     _END_MASTER( myThid )
918     CALL SCATTER_2D( xfer_array, local, myThid )
919 dimitri 1.5 DO bj=1,nSy
920     DO bi=1,nSx
921     DO j=1,sNy
922     DO i=1,sNx
923 dimitri 1.7 fv(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +
924 dimitri 1.8 & (1.-AREA(i,j,bi,bj)) * fv_tmp(i,j,bi,bj)
925 dimitri 1.5 ENDDO
926     ENDDO
927     ENDDO
928     ENDDO
929 dimitri 1.12 #endif /* CPL_DEBUG */
930     #ifdef CPL_MONITOR
931     CALL PLOT_FIELD_XYRL( local, 'v stress', myIter, myThid )
932     #endif /* CPL_MONITOR */
933    
934     C Receive residual shortwave
935 dimitri 1.2 #ifdef CPL_DEBUG
936 dimitri 1.1 DO bj=1,nSy
937     DO bi=1,nSx
938     DO j=1,sNy
939     DO i=1,sNx
940 dimitri 1.12 local(i,j,bi,bj) = Qsw(i,j,bi,bj)
941 dimitri 1.1 ENDDO
942     ENDDO
943     ENDDO
944     ENDDO
945 dimitri 1.12 #else /* CPL_DEBUG */
946 dimitri 1.1 _BEGIN_MASTER( myThid )
947     IF ( myworldid .EQ. local_ocean_leader ) THEN
948     buffsize = Nx*Ny
949     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
950     & local_ice_leader,SwResidTag,MPI_COMM_WORLD,mpistatus,mpierr)
951     ENDIF
952     _END_MASTER( myThid )
953     CALL SCATTER_2D( xfer_array, local, myThid )
954 dimitri 1.5 DO bj=1,nSy
955     DO bi=1,nSx
956     DO j=1,sNy
957     DO i=1,sNx
958     Qsw(i,j,bi,bj) = -AREA(i,j,bi,bj) * local(i,j,bi,bj) +
959 dimitri 1.8 & (1.-AREA(i,j,bi,bj)) * Qsw_tmp(i,j,bi,bj)
960 dimitri 1.5 ENDDO
961     ENDDO
962     ENDDO
963     ENDDO
964 dimitri 1.12 #endif /* CPL_DEBUG */
965     #ifdef CPL_MONITOR
966     CALL PLOT_FIELD_XYRL( local, 'shortwave', myIter, myThid )
967     #endif /* CPL_MONITOR */
968    
969     C Receive heat flux
970 dimitri 1.4 #ifdef CPL_DEBUG
971     DO bj=1,nSy
972 dimitri 1.1 DO bi=1,nSx
973     DO j=1,sNy
974     DO i=1,sNx
975 dimitri 1.12 local(i,j,bi,bj) = Qnet(i,j,bi,bj)
976 dimitri 1.1 ENDDO
977     ENDDO
978     ENDDO
979     ENDDO
980 dimitri 1.12 #else /* CPL_DEBUG */
981 dimitri 1.1 _BEGIN_MASTER( myThid )
982     IF ( myworldid .EQ. local_ocean_leader ) THEN
983     buffsize = Nx*Ny
984     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
985     & local_ice_leader,HeatFluxTag,MPI_COMM_WORLD,mpistatus,mpierr)
986     ENDIF
987     _END_MASTER( myThid )
988     CALL SCATTER_2D( xfer_array, local, myThid )
989 dimitri 1.5 DO bj=1,nSy
990     DO bi=1,nSx
991     DO j=1,sNy
992     DO i=1,sNx
993 dimitri 1.11 Qnet(i,j,bi,bj) = Qsw(i,j,bi,bj) -
994 dimitri 1.5 & AREA(i,j,bi,bj) * local(i,j,bi,bj) +
995 dimitri 1.8 & (1.-AREA(i,j,bi,bj)) * Qnet_tmp(i,j,bi,bj)
996 dimitri 1.5 ENDDO
997     ENDDO
998     ENDDO
999     ENDDO
1000 dimitri 1.12 #endif /* CPL_DEBUG */
1001     #ifdef CPL_MONITOR
1002     CALL PLOT_FIELD_XYRL( local, 'heat flux', myIter, myThid )
1003     #endif /* CPL_MONITOR */
1004    
1005     C Receive freshwater flux
1006 dimitri 1.2 #ifdef CPL_DEBUG
1007 dimitri 1.1 DO bj=1,nSy
1008     DO bi=1,nSx
1009     DO j=1,sNy
1010     DO i=1,sNx
1011 dimitri 1.12 local(i,j,bi,bj) = EmPmR(i,j,bi,bj)
1012 dimitri 1.1 ENDDO
1013     ENDDO
1014     ENDDO
1015     ENDDO
1016 dimitri 1.12 #else /* CPL_DEBUG */
1017 dimitri 1.1 _BEGIN_MASTER( myThid )
1018     IF ( myworldid .EQ. local_ocean_leader ) THEN
1019     buffsize = Nx*Ny
1020     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
1021     & local_ice_leader,WaterFluxTag,MPI_COMM_WORLD,mpistatus,mpierr)
1022     ENDIF
1023     _END_MASTER( myThid )
1024     CALL SCATTER_2D( xfer_array, local, myThid )
1025 dimitri 1.5 DO bj=1,nSy
1026     DO bi=1,nSx
1027     DO j=1,sNy
1028     DO i=1,sNx
1029 dimitri 1.10 EmPmR(i,j,bi,bj) = - AREA(i,j,bi,bj) * local (i,j,bi,bj) +
1030     & ( 1. - AREA(i,j,bi,bj)) * EmPmR_tmp(i,j,bi,bj)
1031 dimitri 1.5 ENDDO
1032     ENDDO
1033     ENDDO
1034     ENDDO
1035 dimitri 1.12 #endif /* CPL_DEBUG */
1036     #ifdef CPL_MONITOR
1037     CALL PLOT_FIELD_XYRL( local, 'freshwater', myIter, myThid )
1038     #endif /* CPL_MONITOR */
1039    
1040     C Receive salt flux
1041 dimitri 1.2 #ifdef CPL_DEBUG
1042 dimitri 1.1 DO bj=1,nSy
1043     DO bi=1,nSx
1044     DO j=1,sNy
1045     DO i=1,sNx
1046 dimitri 1.12 local(i,j,bi,bj) = fu(i,j,bi,bj)
1047 dimitri 1.1 ENDDO
1048     ENDDO
1049     ENDDO
1050     ENDDO
1051 dimitri 1.12 #else /* CPL_DEBUG */
1052 dimitri 1.1 _BEGIN_MASTER( myThid )
1053     IF ( myworldid .EQ. local_ocean_leader ) THEN
1054     buffsize = Nx*Ny
1055     CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
1056     & local_ice_leader,SaltFluxTag,MPI_COMM_WORLD,mpistatus,mpierr)
1057     ENDIF
1058     _END_MASTER( myThid )
1059     CALL SCATTER_2D( xfer_array, local, myThid )
1060 dimitri 1.5 DO bj=1,nSy
1061     DO bi=1,nSx
1062     DO j=1,sNy
1063     DO i=1,sNx
1064     saltFlux(i,j,bi,bj) = - AREA(i,j,bi,bj) * local(i,j,bi,bj)
1065     ENDDO
1066     ENDDO
1067     ENDDO
1068     ENDDO
1069 dimitri 1.12 #endif /* CPL_DEBUG */
1070     #ifdef CPL_MONITOR
1071     CALL PLOT_FIELD_XYRL( local, 'salt flux', myIter, myThid )
1072     #endif /* CPL_MONITOR */
1073 dimitri 1.1
1074     #endif /* ALLOW_CPL_MPMICE */
1075    
1076     RETURN
1077     END

  ViewVC Help
Powered by ViewVC 1.1.22