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