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