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

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

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

Revision 1.4 - (show annotations) (download)
Fri Dec 4 19:39:27 2009 UTC (15 years, 8 months ago) by dimitri
Branch: MAIN
Changes since 1.3: +3 -3 lines 
fixed missing/extra spaces bug reported by Oksana
1 #define CPL_DEBUG
2 #define FIX_FOR_EDGE_WINDS
3 #include "PACKAGES_CONFIG.h"
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: CPL_MPMICE
8 C !INTERFACE:
9 SUBROUTINE CPL_MPMICE( myTime, myIter, myThid )
10
11 C !DESCRIPTION: \bv
12 C *==================================================================
13 C | SUBROUTINE cpl_mpmice
14 C | o Couple MITgcm ocean model with MPMice sea ice model
15 C *==================================================================
16 C \ev
17
18 C !USES:
19 IMPLICIT NONE
20 C == Global variables ==
21 #include "SIZE.h"
22 #include "EEPARAMS.h"
23 #include "PARAMS.h"
24 #include "DYNVARS.h"
25 #include "GRID.h"
26 #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 # include "SEAICE.h"
33 #endif
34
35 LOGICAL DIFFERENT_MULTIPLE
36 EXTERNAL DIFFERENT_MULTIPLE
37
38 C !LOCAL VARIABLES:
39 C mytime - time counter for this thread (seconds)
40 C myiter - iteration counter for this thread
41 C mythid - thread number for this instance of the routine.
42 _RL mytime
43 INTEGER myiter, mythid
44 CEOP
45
46 #ifdef ALLOW_CPL_MPMICE
47 # include "EESUPPORT.h"
48 # include "CPL_MPMICE.h"
49 COMMON /CPL_MPI_ID/
50 & myworldid, local_ocean_leader, local_ice_leader
51 integer myworldid, local_ocean_leader, local_ice_leader
52 integer mpistatus(MPI_STATUS_SIZE), mpierr
53 integer xfer_gridsize(2)
54 integer i, j, bi, bj, buffsize, idx
55 Real*8 xfer_scalar
56 Real*8 xfer_array(Nx,Ny)
57 Real*8 xfer_bc_tracer(2*(Nx+Ny)-4)
58 Real*8 xfer_bc_veloc(2*(Nx+Ny)-6)
59 _RL local(1:sNx,1:sNy,nSx,nSy)
60
61 #ifdef CPL_DEBUG
62 _RL ScatArray(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
63 DO bj=1,nSy
64 DO bi=1,nSx
65 DO j=1-OLy,sNy+OLy
66 DO i=1-OLx,sNx+OLx
67 ScatArray(i,j,bi,bj) = 0.0 _d 0
68 ENDDO
69 ENDDO
70 ENDDO
71 ENDDO
72 #endif
73
74 IF( myTime .EQ. startTime ) THEN
75
76 C Send deltatimestep
77 _BEGIN_MASTER( myThid )
78 IF ( myworldid .EQ. local_ocean_leader ) THEN
79 xfer_scalar = deltat
80 buffsize = 1
81 CALL MPI_SEND(xfer_scalar,buffsize,MPI_DOUBLE_PRECISION,
82 & local_ice_leader,TimeIntervalTag,MPI_COMM_WORLD,mpierr)
83 #ifdef CPL_DEBUG
84 print*,'MITgcm send TimeInterval', xfer_scalar
85 #endif
86 ENDIF
87 _END_MASTER( myThid )
88
89 C Send grid dimensions (Nx,Ny)
90 _BEGIN_MASTER( myThid )
91 IF ( myworldid .EQ. local_ocean_leader ) THEN
92 xfer_gridsize(1)=Nx
93 xfer_gridsize(2)=Ny
94 buffsize = 2
95 CALL MPI_SEND(xfer_gridsize,buffsize,MPI_INTEGER,
96 & local_ice_leader,OceanGridsizeTag,MPI_COMM_WORLD,mpierr)
97 #ifdef CPL_DEBUG
98 print*,'MITgcm send OceanGridsize', xfer_gridsize
99 #endif
100 ENDIF
101 _END_MASTER( myThid )
102
103 C Send ice area
104 DO bj=1,nSy
105 DO bi=1,nSx
106 DO j=1,sNy
107 DO i=1,sNx
108 local(i,j,bi,bj) = AREA(i,j,1,bi,bj)
109 ENDDO
110 ENDDO
111 ENDDO
112 ENDDO
113 CALL GATHER_2D( xfer_array, local, myThid )
114 _BEGIN_MASTER( myThid )
115 IF ( myworldid .EQ. local_ocean_leader ) THEN
116 buffsize = Nx*Ny
117 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
118 & local_ice_leader,AreaTag,MPI_COMM_WORLD,mpierr)
119 ENDIF
120 _END_MASTER( myThid )
121 #ifdef CPL_DEBUG
122 CALL PLOT_FIELD_XYRL( AREA, 'AREA', myIter, myThid )
123 #endif
124
125 C Send ice thickness
126 DO bj=1,nSy
127 DO bi=1,nSx
128 DO j=1,sNy
129 DO i=1,sNx
130 local(i,j,bi,bj) = HEFF(i,j,1,bi,bj)
131 ENDDO
132 ENDDO
133 ENDDO
134 ENDDO
135 CALL GATHER_2D( xfer_array, local, myThid )
136 _BEGIN_MASTER( myThid )
137 IF ( myworldid .EQ. local_ocean_leader ) THEN
138 buffsize = Nx*Ny
139 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
140 & local_ice_leader,HeffTag,MPI_COMM_WORLD,mpierr)
141 ENDIF
142 _END_MASTER( myThid )
143 #ifdef CPL_DEBUG
144 CALL PLOT_FIELD_XYRL( HEFF, 'HEFF', myIter, myThid )
145 #endif
146
147 C Send ice salinity
148 DO bj=1,nSy
149 DO bi=1,nSx
150 DO j=1,sNy
151 DO i=1,sNx
152 local(i,j,bi,bj) = HSALT(i,j,bi,bj)
153 ENDDO
154 ENDDO
155 ENDDO
156 ENDDO
157 CALL GATHER_2D( xfer_array, local, myThid )
158 _BEGIN_MASTER( myThid )
159 IF ( myworldid .EQ. local_ocean_leader ) THEN
160 buffsize = Nx*Ny
161 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
162 & local_ice_leader,HsaltTag,MPI_COMM_WORLD,mpierr)
163 ENDIF
164 _END_MASTER( myThid )
165 #ifdef CPL_DEBUG
166 CALL PLOT_FIELD_XYRL( HSALT, 'HSALT', myIter, myThid )
167 #endif
168
169 C Send snow thickness
170 DO bj=1,nSy
171 DO bi=1,nSx
172 DO j=1,sNy
173 DO i=1,sNx
174 local(i,j,bi,bj) = HSNOW(i,j,bi,bj)
175 ENDDO
176 ENDDO
177 ENDDO
178 ENDDO
179 CALL GATHER_2D( xfer_array, local, myThid )
180 _BEGIN_MASTER( myThid )
181 IF ( myworldid .EQ. local_ocean_leader ) THEN
182 buffsize = Nx*Ny
183 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
184 & local_ice_leader,HsnowTag,MPI_COMM_WORLD,mpierr)
185 ENDIF
186 _END_MASTER( myThid )
187 #ifdef CPL_DEBUG
188 CALL PLOT_FIELD_XYRL( HSNOW, 'HSNOW', myIter, myThid )
189 #endif
190
191 ENDIF ! ( myTime .EQ. startTime )
192
193 C Send ocean model time
194 _BEGIN_MASTER( myThid )
195 IF ( myworldid .EQ. local_ocean_leader ) THEN
196 xfer_scalar = myTime
197 buffsize = 1
198 CALL MPI_SEND(xfer_scalar,buffsize,MPI_DOUBLE_PRECISION,
199 & local_ice_leader,OceanTimeTag,MPI_COMM_WORLD,mpierr)
200 #ifdef CPL_DEBUG
201 print*,'MITgcm send OceanTime', xfer_scalar
202 #endif
203 ENDIF
204 _END_MASTER( myThid )
205
206 C Send boundary ice area
207 DO bj=1,nSy
208 DO bi=1,nSx
209 DO j=1,sNy
210 DO i=1,sNx
211 local(i,j,bi,bj) = AREA(i,j,1,bi,bj)
212 ENDDO
213 ENDDO
214 ENDDO
215 ENDDO
216 CALL GATHER_2D( xfer_array, local, myThid )
217 idx = 0
218 DO i = 1, Nx
219 idx = idx + 1
220 xfer_bc_tracer(idx) = xfer_array(i,1)
221 ENDDO
222 DO j = 2, Ny
223 idx = idx + 1
224 xfer_bc_tracer(idx) = xfer_array(Nx,j)
225 ENDDO
226 DO i = (Nx-1), 1, -1
227 idx = idx + 1
228 xfer_bc_tracer(idx) = xfer_array(i,Ny)
229 ENDDO
230 DO j = (Ny-1), 2, -1
231 idx = idx + 1
232 xfer_bc_tracer(idx) = xfer_array(1,j)
233 ENDDO
234 _BEGIN_MASTER( myThid )
235 IF ( myworldid .EQ. local_ocean_leader ) THEN
236 buffsize = 2*(Nx+Ny)-4
237 print*,'MITgcm is about to send AreaBcTag',buffsize
238 CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
239 & local_ice_leader,AreaBcTag,MPI_COMM_WORLD,mpierr)
240 print*,'MITgcm has sent AreaBcTag',buffsize
241 ENDIF
242 _END_MASTER( myThid )
243
244 C Send boundary ice thickness
245 DO bj=1,nSy
246 DO bi=1,nSx
247 DO j=1,sNy
248 DO i=1,sNx
249 local(i,j,bi,bj) = HEFF(i,j,1,bi,bj)
250 ENDDO
251 ENDDO
252 ENDDO
253 ENDDO
254 CALL GATHER_2D( xfer_array, local, myThid )
255 idx = 0
256 DO i = 1, Nx
257 idx = idx + 1
258 xfer_bc_tracer(idx) = xfer_array(i,1)
259 ENDDO
260 DO j = 2, Ny
261 idx = idx + 1
262 xfer_bc_tracer(idx) = xfer_array(Nx,j)
263 ENDDO
264 DO i = (Nx-1), 1, -1
265 idx = idx + 1
266 xfer_bc_tracer(idx) = xfer_array(i,Ny)
267 ENDDO
268 DO j = (Ny-1), 2, -1
269 idx = idx + 1
270 xfer_bc_tracer(idx) = xfer_array(1,j)
271 ENDDO
272 _BEGIN_MASTER( myThid )
273 IF ( myworldid .EQ. local_ocean_leader ) THEN
274 buffsize = 2*(Nx+Ny)-4
275 CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
276 & local_ice_leader,HeffBcTag,MPI_COMM_WORLD,mpierr)
277 ENDIF
278 _END_MASTER( myThid )
279
280 C Send boundary ice salinity
281 DO bj=1,nSy
282 DO bi=1,nSx
283 DO j=1,sNy
284 DO i=1,sNx
285 local(i,j,bi,bj) = HSALT(i,j,bi,bj)
286 ENDDO
287 ENDDO
288 ENDDO
289 ENDDO
290 CALL GATHER_2D( xfer_array, local, myThid )
291 idx = 0
292 DO i = 1, Nx
293 idx = idx + 1
294 xfer_bc_tracer(idx) = xfer_array(i,1)
295 ENDDO
296 DO j = 2, Ny
297 idx = idx + 1
298 xfer_bc_tracer(idx) = xfer_array(Nx,j)
299 ENDDO
300 DO i = (Nx-1), 1, -1
301 idx = idx + 1
302 xfer_bc_tracer(idx) = xfer_array(i,Ny)
303 ENDDO
304 DO j = (Ny-1), 2, -1
305 idx = idx + 1
306 xfer_bc_tracer(idx) = xfer_array(1,j)
307 ENDDO
308 _BEGIN_MASTER( myThid )
309 IF ( myworldid .EQ. local_ocean_leader ) THEN
310 buffsize = 2*(Nx+Ny)-4
311 CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
312 & local_ice_leader,HsaltBcTag,MPI_COMM_WORLD,mpierr)
313 ENDIF
314 _END_MASTER( myThid )
315
316 C Send boundary snow thickness
317 DO bj=1,nSy
318 DO bi=1,nSx
319 DO j=1,sNy
320 DO i=1,sNx
321 local(i,j,bi,bj) = HSNOW(i,j,bi,bj)
322 ENDDO
323 ENDDO
324 ENDDO
325 ENDDO
326 CALL GATHER_2D( xfer_array, local, myThid )
327 idx = 0
328 DO i = 1, Nx
329 idx = idx + 1
330 xfer_bc_tracer(idx) = xfer_array(i,1)
331 ENDDO
332 DO j = 2, Ny
333 idx = idx + 1
334 xfer_bc_tracer(idx) = xfer_array(Nx,j)
335 ENDDO
336 DO i = (Nx-1), 1, -1
337 idx = idx + 1
338 xfer_bc_tracer(idx) = xfer_array(i,Ny)
339 ENDDO
340 DO j = (Ny-1), 2, -1
341 idx = idx + 1
342 xfer_bc_tracer(idx) = xfer_array(1,j)
343 ENDDO
344 _BEGIN_MASTER( myThid )
345 IF ( myworldid .EQ. local_ocean_leader ) THEN
346 buffsize = 2*(Nx+Ny)-4
347 CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
348 & local_ice_leader,HsnowBcTag,MPI_COMM_WORLD,mpierr)
349 ENDIF
350 _END_MASTER( myThid )
351
352 C Send boundary u ice
353 DO bj=1,nSy
354 DO bi=1,nSx
355 DO j=1,sNy
356 DO i=1,sNx
357 local(i,j,bi,bj) = UICE(i,j,1,bi,bj)
358 ENDDO
359 ENDDO
360 ENDDO
361 ENDDO
362 CALL GATHER_2D( xfer_array, local, myThid )
363 idx = 0
364 DO i = 2, Nx
365 idx = idx + 1
366 xfer_bc_veloc(idx) = xfer_array(i,1)
367 ENDDO
368 DO j = 2, Ny
369 idx = idx + 1
370 xfer_bc_veloc(idx) = xfer_array(Nx,j)
371 ENDDO
372 DO i = (Nx-1), 2, -1
373 idx = idx + 1
374 xfer_bc_veloc(idx) = xfer_array(i,Ny)
375 ENDDO
376 DO j = (Ny-1), 2, -1
377 idx = idx + 1
378 xfer_bc_veloc(idx) = xfer_array(2,j)
379 ENDDO
380 _BEGIN_MASTER( myThid )
381 IF ( myworldid .EQ. local_ocean_leader ) THEN
382 buffsize = 2*(Nx+Ny)-6
383 CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,
384 & local_ice_leader,UiceBcTag,MPI_COMM_WORLD,mpierr)
385 ENDIF
386 _END_MASTER( myThid )
387
388 C Send boundary v ice
389 DO bj=1,nSy
390 DO bi=1,nSx
391 DO j=1,sNy
392 DO i=1,sNx
393 local(i,j,bi,bj) = VICE(i,j,1,bi,bj)
394 ENDDO
395 ENDDO
396 ENDDO
397 ENDDO
398 CALL GATHER_2D( xfer_array, local, myThid )
399 idx = 0
400 DO i = 1, Nx
401 idx = idx + 1
402 xfer_bc_veloc(idx) = xfer_array(i,2)
403 ENDDO
404 DO j = 3, Ny
405 idx = idx + 1
406 xfer_bc_veloc(idx) = xfer_array(Nx,j)
407 ENDDO
408 DO i = (Nx-1), 1, -1
409 idx = idx + 1
410 xfer_bc_veloc(idx) = xfer_array(i,Ny)
411 ENDDO
412 DO j = (Ny-1), 3, -1
413 idx = idx + 1
414 xfer_bc_veloc(idx) = xfer_array(1,j)
415 ENDDO
416 _BEGIN_MASTER( myThid )
417 IF ( myworldid .EQ. local_ocean_leader ) THEN
418 buffsize = 2*(Nx+Ny)-6
419 CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,
420 & local_ice_leader,ViceBcTag,MPI_COMM_WORLD,mpierr)
421 ENDIF
422 _END_MASTER( myThid )
423
424 C Send u-wind velocity
425 DO bj=1,nSy
426 DO bi=1,nSx
427 DO j=1,sNy
428 DO i=1,sNx
429 local(i,j,bi,bj) = uwind(i,j,bi,bj)
430 ENDDO
431 ENDDO
432 ENDDO
433 ENDDO
434 CALL GATHER_2D( xfer_array, local, myThid )
435 _BEGIN_MASTER( myThid )
436 IF ( myworldid .EQ. local_ocean_leader ) THEN
437 #ifdef FIX_FOR_EDGE_WINDS
438 DO j=1,Ny
439 xfer_array(Nx,j)=xfer_array(Nx-1,j)
440 ENDDO
441 #endif
442 buffsize = Nx*Ny
443 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
444 & local_ice_leader,UwindTag,MPI_COMM_WORLD,mpierr)
445 ENDIF
446 _END_MASTER( myThid )
447
448 C Send v-wind velocity
449 DO bj=1,nSy
450 DO bi=1,nSx
451 DO j=1,sNy
452 DO i=1,sNx
453 local(i,j,bi,bj) = vwind(i,j,bi,bj)
454 ENDDO
455 ENDDO
456 ENDDO
457 ENDDO
458 CALL GATHER_2D( xfer_array, local, myThid )
459 _BEGIN_MASTER( myThid )
460 IF ( myworldid .EQ. local_ocean_leader ) THEN
461 #ifdef FIX_FOR_EDGE_WINDS
462 DO i=1,Nx
463 xfer_array(i,Ny)=xfer_array(i,Ny-1)
464 ENDDO
465 #endif
466 buffsize = Nx*Ny
467 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
468 & local_ice_leader,VwindTag,MPI_COMM_WORLD,mpierr)
469 ENDIF
470 _END_MASTER( myThid )
471
472 C Send downward longwave radiation
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) = lwdown(i,j,bi,bj)
478 ENDDO
479 ENDDO
480 ENDDO
481 ENDDO
482 CALL GATHER_2D( xfer_array, local, myThid )
483 _BEGIN_MASTER( myThid )
484 IF ( myworldid .EQ. local_ocean_leader ) THEN
485 buffsize = Nx*Ny
486 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
487 & local_ice_leader,LwDownTag,MPI_COMM_WORLD,mpierr)
488 ENDIF
489 _END_MASTER( myThid )
490
491 C Send downward shortwave radiation
492 DO bj=1,nSy
493 DO bi=1,nSx
494 DO j=1,sNy
495 DO i=1,sNx
496 local(i,j,bi,bj) = swdown(i,j,bi,bj)
497 ENDDO
498 ENDDO
499 ENDDO
500 ENDDO
501 CALL GATHER_2D( xfer_array, local, myThid )
502 _BEGIN_MASTER( myThid )
503 IF ( myworldid .EQ. local_ocean_leader ) THEN
504 buffsize = Nx*Ny
505 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
506 & local_ice_leader,SwDownTag,MPI_COMM_WORLD,mpierr)
507 ENDIF
508 _END_MASTER( myThid )
509
510 C Send air temperature
511 DO bj=1,nSy
512 DO bi=1,nSx
513 DO j=1,sNy
514 DO i=1,sNx
515 local(i,j,bi,bj) = atemp(i,j,bi,bj)
516 ENDDO
517 ENDDO
518 ENDDO
519 ENDDO
520 CALL GATHER_2D( xfer_array, local, myThid )
521 _BEGIN_MASTER( myThid )
522 IF ( myworldid .EQ. local_ocean_leader ) THEN
523 buffsize = Nx*Ny
524 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
525 & local_ice_leader,AtempTag,MPI_COMM_WORLD,mpierr)
526 ENDIF
527 _END_MASTER( myThid )
528
529 C Send humidity
530 DO bj=1,nSy
531 DO bi=1,nSx
532 DO j=1,sNy
533 DO i=1,sNx
534 local(i,j,bi,bj) = aqh(i,j,bi,bj)
535 ENDDO
536 ENDDO
537 ENDDO
538 ENDDO
539 CALL GATHER_2D( xfer_array, local, myThid )
540 _BEGIN_MASTER( myThid )
541 IF ( myworldid .EQ. local_ocean_leader ) THEN
542 buffsize = Nx*Ny
543 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
544 & local_ice_leader,AqhTag,MPI_COMM_WORLD,mpierr)
545 ENDIF
546 _END_MASTER( myThid )
547
548 C Send precipitation
549 DO bj=1,nSy
550 DO bi=1,nSx
551 DO j=1,sNy
552 DO i=1,sNx
553 local(i,j,bi,bj) = precip(i,j,bi,bj)
554 ENDDO
555 ENDDO
556 ENDDO
557 ENDDO
558 CALL GATHER_2D( xfer_array, local, myThid )
559 _BEGIN_MASTER( myThid )
560 IF ( myworldid .EQ. local_ocean_leader ) THEN
561 buffsize = Nx*Ny
562 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
563 & local_ice_leader,PrecipTag,MPI_COMM_WORLD,mpierr)
564 ENDIF
565 _END_MASTER( myThid )
566
567 C Send ocean surface temperature
568 DO bj=1,nSy
569 DO bi=1,nSx
570 DO j=1,sNy
571 DO i=1,sNx
572 local(i,j,bi,bj) = theta(i,j,1,bi,bj)
573 ENDDO
574 ENDDO
575 ENDDO
576 ENDDO
577 CALL GATHER_2D( xfer_array, local, myThid )
578 _BEGIN_MASTER( myThid )
579 IF ( myworldid .EQ. local_ocean_leader ) THEN
580 buffsize = Nx*Ny
581 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
582 & local_ice_leader,SstTag,MPI_COMM_WORLD,mpierr)
583 ENDIF
584 _END_MASTER( myThid )
585
586 C Send surface u current
587 DO bj=1,nSy
588 DO bi=1,nSx
589 DO j=1,sNy
590 DO i=1,sNx
591 local(i,j,bi,bj) = uVel(i,j,1,bi,bj)
592 ENDDO
593 ENDDO
594 ENDDO
595 ENDDO
596 CALL GATHER_2D( xfer_array, local, myThid )
597 _BEGIN_MASTER( myThid )
598 IF ( myworldid .EQ. local_ocean_leader ) THEN
599 buffsize = Nx*Ny
600 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
601 & local_ice_leader,UvelTag,MPI_COMM_WORLD,mpierr)
602 ENDIF
603 _END_MASTER( myThid )
604
605 C Send surface v current
606 DO bj=1,nSy
607 DO bi=1,nSx
608 DO j=1,sNy
609 DO i=1,sNx
610 local(i,j,bi,bj) = vVel(i,j,1,bi,bj)
611 ENDDO
612 ENDDO
613 ENDDO
614 ENDDO
615 CALL GATHER_2D( xfer_array, local, myThid )
616 _BEGIN_MASTER( myThid )
617 IF ( myworldid .EQ. local_ocean_leader ) THEN
618 buffsize = Nx*Ny
619 CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
620 & local_ice_leader,VvelTag,MPI_COMM_WORLD,mpierr)
621 ENDIF
622 _END_MASTER( myThid )
623 #ifdef CPL_DEBUG
624 CALL PLOT_FIELD_XYZRL( vVel, 'vVel(k=1)', 1, myIter, myThid )
625 #endif
626
627 C Receive ice model time
628 _BEGIN_MASTER( myThid )
629 IF ( myworldid .EQ. local_ocean_leader ) THEN
630 buffsize = 1
631 CALL MPI_RECV(xfer_scalar,1,MPI_DOUBLE_PRECISION,
632 & local_ice_leader,IceTimeTag,MPI_COMM_WORLD,mpistatus,mpierr)
633 #ifdef CPL_DEBUG
634 print*,'MITgcm receive IceTime', xfer_scalar
635 #endif
636 ENDIF
637 _END_MASTER( myThid )
638
639 C Receive ice area Nx*Ny Real*8
640 _BEGIN_MASTER( myThid )
641 IF ( myworldid .EQ. local_ocean_leader ) THEN
642 buffsize = Nx*Ny
643 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
644 & local_ice_leader,AreaTag,MPI_COMM_WORLD,mpistatus,mpierr)
645 ENDIF
646 _END_MASTER( myThid )
647 CALL SCATTER_2D( xfer_array, local, myThid )
648 #ifdef CPL_DEBUG
649 DO bj=1,nSy
650 DO bi=1,nSx
651 DO j=1,sNy
652 DO i=1,sNx
653 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
654 ENDDO
655 ENDDO
656 ENDDO
657 ENDDO
658 CALL PLOT_FIELD_XYRL( ScatArray, 'ice area', myIter, myThid )
659 #endif
660
661 C Receive ice thickness
662 _BEGIN_MASTER( myThid )
663 IF ( myworldid .EQ. local_ocean_leader ) THEN
664 buffsize = Nx*Ny
665 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
666 & local_ice_leader,HeffTag,MPI_COMM_WORLD,mpistatus,mpierr)
667 ENDIF
668 _END_MASTER( myThid )
669 CALL SCATTER_2D( xfer_array, local, myThid )
670 #ifdef CPL_DEBUG
671 DO bj=1,nSy
672 DO bi=1,nSx
673 DO j=1,sNy
674 DO i=1,sNx
675 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
676 ENDDO
677 ENDDO
678 ENDDO
679 ENDDO
680 CALL PLOT_FIELD_XYRL( ScatArray, 'ice thickness', myIter, myThid )
681 #endif
682
683 C Receive ice salinity
684 _BEGIN_MASTER( myThid )
685 IF ( myworldid .EQ. local_ocean_leader ) THEN
686 buffsize = Nx*Ny
687 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
688 & local_ice_leader,HsaltTag,MPI_COMM_WORLD,mpistatus,mpierr)
689 ENDIF
690 _END_MASTER( myThid )
691 CALL SCATTER_2D( xfer_array, local, myThid )
692 #ifdef CPL_DEBUG
693 DO bj=1,nSy
694 DO bi=1,nSx
695 DO j=1,sNy
696 DO i=1,sNx
697 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
698 ENDDO
699 ENDDO
700 ENDDO
701 ENDDO
702 CALL PLOT_FIELD_XYRL( ScatArray, 'ice salinity', myIter, myThid )
703 #endif
704
705 C Receive snow thickness
706 _BEGIN_MASTER( myThid )
707 IF ( myworldid .EQ. local_ocean_leader ) THEN
708 buffsize = Nx*Ny
709 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
710 & local_ice_leader,HsnowTag,MPI_COMM_WORLD,mpistatus,mpierr)
711 ENDIF
712 _END_MASTER( myThid )
713 CALL SCATTER_2D( xfer_array, local, myThid )
714 #ifdef CPL_DEBUG
715 DO bj=1,nSy
716 DO bi=1,nSx
717 DO j=1,sNy
718 DO i=1,sNx
719 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
720 ENDDO
721 ENDDO
722 ENDDO
723 ENDDO
724 CALL PLOT_FIELD_XYRL( ScatArray, 'ice thickness', myIter, myThid )
725 #endif
726
727 C Receive u surface stress
728 _BEGIN_MASTER( myThid )
729 IF ( myworldid .EQ. local_ocean_leader ) THEN
730 buffsize = Nx*Ny
731 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
732 & local_ice_leader,UstressTag,MPI_COMM_WORLD,mpistatus,mpierr)
733 ENDIF
734 _END_MASTER( myThid )
735 CALL SCATTER_2D( xfer_array, local, myThid )
736 #ifdef CPL_DEBUG
737 DO bj=1,nSy
738 DO bi=1,nSx
739 DO j=1,sNy
740 DO i=1,sNx
741 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
742 ENDDO
743 ENDDO
744 ENDDO
745 ENDDO
746 CALL PLOT_FIELD_XYRL( ScatArray, 'u stress', myIter, myThid )
747 #endif
748
749 C Receive v surface stress
750 _BEGIN_MASTER( myThid )
751 IF ( myworldid .EQ. local_ocean_leader ) THEN
752 buffsize = Nx*Ny
753 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
754 & local_ice_leader,VstressTag,MPI_COMM_WORLD,mpistatus,mpierr)
755 ENDIF
756 _END_MASTER( myThid )
757 CALL SCATTER_2D( xfer_array, local, myThid )
758 #ifdef CPL_DEBUG
759 DO bj=1,nSy
760 DO bi=1,nSx
761 DO j=1,sNy
762 DO i=1,sNx
763 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
764 ENDDO
765 ENDDO
766 ENDDO
767 ENDDO
768 CALL PLOT_FIELD_XYRL( ScatArray, 'v stress', myIter, myThid )
769 #endif
770
771 C Receive residual shortwave
772 _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,SwResidTag,MPI_COMM_WORLD,mpistatus,mpierr)
777 ENDIF
778 _END_MASTER( myThid )
779 CALL SCATTER_2D( xfer_array, local, myThid )
780 #ifdef CPL_DEBUG
781 DO bj=1,nSy
782 DO bi=1,nSx
783 DO j=1,sNy
784 DO i=1,sNx
785 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
786 ENDDO
787 ENDDO
788 ENDDO
789 ENDDO
790 CALL PLOT_FIELD_XYRL( ScatArray, 'shortwave', myIter, myThid )
791 #endif
792
793 C Receive heat flux
794 _BEGIN_MASTER( myThid )
795 IF ( myworldid .EQ. local_ocean_leader ) THEN
796 buffsize = Nx*Ny
797 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
798 & local_ice_leader,HeatFluxTag,MPI_COMM_WORLD,mpistatus,mpierr)
799 ENDIF
800 _END_MASTER( myThid )
801 CALL SCATTER_2D( xfer_array, local, myThid )
802 #ifdef CPL_DEBUG
803 DO bj=1,nSy
804 DO bi=1,nSx
805 DO j=1,sNy
806 DO i=1,sNx
807 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
808 ENDDO
809 ENDDO
810 ENDDO
811 ENDDO
812 CALL PLOT_FIELD_XYRL( ScatArray, 'heat flux', myIter, myThid )
813 #endif
814
815 C Receive freshwater flux
816 _BEGIN_MASTER( myThid )
817 IF ( myworldid .EQ. local_ocean_leader ) THEN
818 buffsize = Nx*Ny
819 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
820 & local_ice_leader,WaterFluxTag,MPI_COMM_WORLD,mpistatus,mpierr)
821 ENDIF
822 _END_MASTER( myThid )
823 CALL SCATTER_2D( xfer_array, local, myThid )
824 #ifdef CPL_DEBUG
825 DO bj=1,nSy
826 DO bi=1,nSx
827 DO j=1,sNy
828 DO i=1,sNx
829 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
830 ENDDO
831 ENDDO
832 ENDDO
833 ENDDO
834 CALL PLOT_FIELD_XYRL( ScatArray, 'freshwater', myIter, myThid )
835 #endif
836
837 C Receive salt flux
838 _BEGIN_MASTER( myThid )
839 IF ( myworldid .EQ. local_ocean_leader ) THEN
840 buffsize = Nx*Ny
841 CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
842 & local_ice_leader,SaltFluxTag,MPI_COMM_WORLD,mpistatus,mpierr)
843 ENDIF
844 _END_MASTER( myThid )
845 CALL SCATTER_2D( xfer_array, local, myThid )
846 #ifdef CPL_DEBUG
847 DO bj=1,nSy
848 DO bi=1,nSx
849 DO j=1,sNy
850 DO i=1,sNx
851 ScatArray(i,j,bi,bj) = local(i,j,bi,bj)
852 ENDDO
853 ENDDO
854 ENDDO
855 ENDDO
856 CALL PLOT_FIELD_XYRL( ScatArray, 'salt flux', myIter, myThid )
857 #endif
858
859 #endif /* ALLOW_CPL_MPMICE */
860
861 RETURN
862 END
  ViewVC Help
Powered by ViewVC 1.1.22