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