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