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