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

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

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

revision 1.2 by dimitri, Mon Jun 22 19:40:11 2009 UTC revision 1.11 by dimitri, Thu Feb 9 20:49:24 2012 UTC
# Line 23  C     == Global variables == Line 23  C     == Global variables ==
23  #include "PARAMS.h"  #include "PARAMS.h"
24  #include "DYNVARS.h"  #include "DYNVARS.h"
25  #include "GRID.h"  #include "GRID.h"
26    #include "FFIELDS.h"
27  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
28  # include "EXF_OPTIONS.h"  # include "EXF_OPTIONS.h"
29  # include "EXF_FIELDS.h"  # include "EXF_FIELDS.h"
# Line 57  CEOP Line 58  CEOP
58        Real*8  xfer_bc_tracer(2*(Nx+Ny)-4)        Real*8  xfer_bc_tracer(2*(Nx+Ny)-4)
59        Real*8  xfer_bc_veloc(2*(Nx+Ny)-6)        Real*8  xfer_bc_veloc(2*(Nx+Ny)-6)
60        _RL     local(1:sNx,1:sNy,nSx,nSy)        _RL     local(1:sNx,1:sNy,nSx,nSy)
61    
62          COMMON /FFIELDS_tmp/ fu_tmp, fv_tmp, Qnet_tmp, Qsw_tmp, EmPmR_tmp
63          _RS  fu_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
64          _RS  fv_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
65          _RS  Qnet_tmp     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
66          _RS  Qsw_tmp      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
67          _RS  EmPmR_tmp    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
68    
69  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
70       _RL ScatArray(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL ScatArray(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
71        DO bj=1,nSy        DO bj=1,nSy
72         DO bi=1,nSx         DO bi=1,nSx
73          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
# Line 105  C     Send ice area Line 113  C     Send ice area
113          DO bi=1,nSx          DO bi=1,nSx
114           DO j=1,sNy           DO j=1,sNy
115            DO i=1,sNx            DO i=1,sNx
116             local(i,j,bi,bj) = AREA(i,j,1,bi,bj)             local(i,j,bi,bj) = AREA(i,j,bi,bj)
117            ENDDO            ENDDO
118           ENDDO           ENDDO
119          ENDDO          ENDDO
# Line 127  C     Send ice thickness Line 135  C     Send ice thickness
135          DO bi=1,nSx          DO bi=1,nSx
136           DO j=1,sNy           DO j=1,sNy
137            DO i=1,sNx            DO i=1,sNx
138             local(i,j,bi,bj) = HEFF(i,j,1,bi,bj)             local(i,j,bi,bj) = HEFF(i,j,bi,bj)
139            ENDDO            ENDDO
140           ENDDO           ENDDO
141          ENDDO          ENDDO
# Line 208  C     Send boundary ice area Line 216  C     Send boundary ice area
216         DO bi=1,nSx         DO bi=1,nSx
217          DO j=1,sNy          DO j=1,sNy
218           DO i=1,sNx           DO i=1,sNx
219            local(i,j,bi,bj) = AREA(i,j,1,bi,bj)            local(i,j,bi,bj) = AREA(i,j,bi,bj)
220           ENDDO           ENDDO
221          ENDDO          ENDDO
222         ENDDO         ENDDO
# Line 223  C     Send boundary ice area Line 231  C     Send boundary ice area
231         idx = idx + 1         idx = idx + 1
232         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
233        ENDDO        ENDDO
234        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
235         idx = idx + 1         idx = idx + 1
236         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
237        ENDDO        ENDDO
238        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
239         idx = idx + 1         idx = idx + 1
240         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
241        ENDDO        ENDDO
# Line 246  C     Send boundary ice thickness Line 254  C     Send boundary ice thickness
254         DO bi=1,nSx         DO bi=1,nSx
255          DO j=1,sNy          DO j=1,sNy
256           DO i=1,sNx           DO i=1,sNx
257            local(i,j,bi,bj) = HEFF(i,j,1,bi,bj)            local(i,j,bi,bj) = HEFF(i,j,bi,bj)
258           ENDDO           ENDDO
259          ENDDO          ENDDO
260         ENDDO         ENDDO
# Line 261  C     Send boundary ice thickness Line 269  C     Send boundary ice thickness
269         idx = idx + 1         idx = idx + 1
270         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
271        ENDDO        ENDDO
272        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
273         idx = idx + 1         idx = idx + 1
274         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
275        ENDDO        ENDDO
276        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
277         idx = idx + 1         idx = idx + 1
278         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
279        ENDDO        ENDDO
# Line 297  C     Send boundary ice salinity Line 305  C     Send boundary ice salinity
305         idx = idx + 1         idx = idx + 1
306         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
307        ENDDO        ENDDO
308        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
309         idx = idx + 1         idx = idx + 1
310         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
311        ENDDO        ENDDO
312        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
313         idx = idx + 1         idx = idx + 1
314         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
315        ENDDO        ENDDO
# Line 333  C     Send boundary snow thickness Line 341  C     Send boundary snow thickness
341         idx = idx + 1         idx = idx + 1
342         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
343        ENDDO        ENDDO
344        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
345         idx = idx + 1         idx = idx + 1
346         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
347        ENDDO        ENDDO
348        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
349         idx = idx + 1         idx = idx + 1
350         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
351        ENDDO        ENDDO
# Line 354  C     Send boundary u ice Line 362  C     Send boundary u ice
362         DO bi=1,nSx         DO bi=1,nSx
363          DO j=1,sNy          DO j=1,sNy
364           DO i=1,sNx           DO i=1,sNx
365            local(i,j,bi,bj) = UICE(i,j,1,bi,bj)            local(i,j,bi,bj) = UICE(i,j,bi,bj)
366           ENDDO           ENDDO
367          ENDDO          ENDDO
368         ENDDO         ENDDO
# Line 369  C     Send boundary u ice Line 377  C     Send boundary u ice
377         idx = idx + 1         idx = idx + 1
378         xfer_bc_veloc(idx) = xfer_array(Nx,j)         xfer_bc_veloc(idx) = xfer_array(Nx,j)
379        ENDDO        ENDDO
380        DO i = (Nx-1), -1, 2        DO i = (Nx-1), 2, -1
381         idx = idx + 1         idx = idx + 1
382         xfer_bc_veloc(idx) = xfer_array(i,Ny)         xfer_bc_veloc(idx) = xfer_array(i,Ny)
383        ENDDO        ENDDO
384        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
385         idx = idx + 1         idx = idx + 1
386         xfer_bc_veloc(idx) = xfer_array(2,j)         xfer_bc_veloc(idx) = xfer_array(2,j)
387        ENDDO        ENDDO
# Line 390  C     Send boundary v ice Line 398  C     Send boundary v ice
398         DO bi=1,nSx         DO bi=1,nSx
399          DO j=1,sNy          DO j=1,sNy
400           DO i=1,sNx           DO i=1,sNx
401            local(i,j,bi,bj) = VICE(i,j,1,bi,bj)            local(i,j,bi,bj) = VICE(i,j,bi,bj)
402           ENDDO           ENDDO
403          ENDDO          ENDDO
404         ENDDO         ENDDO
# Line 405  C     Send boundary v ice Line 413  C     Send boundary v ice
413         idx = idx + 1         idx = idx + 1
414         xfer_bc_veloc(idx) = xfer_array(Nx,j)         xfer_bc_veloc(idx) = xfer_array(Nx,j)
415        ENDDO        ENDDO
416        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
417         idx = idx + 1         idx = idx + 1
418         xfer_bc_veloc(idx) = xfer_array(i,Ny)         xfer_bc_veloc(idx) = xfer_array(i,Ny)
419        ENDDO        ENDDO
420        DO j = (Ny-1), -1, 3        DO j = (Ny-1), 3, -1
421         idx = idx + 1         idx = idx + 1
422         xfer_bc_veloc(idx) = xfer_array(1,j)         xfer_bc_veloc(idx) = xfer_array(1,j)
423        ENDDO        ENDDO
# Line 583  C     Send ocean surface temperature Line 591  C     Send ocean surface temperature
591        ENDIF        ENDIF
592        _END_MASTER( myThid )        _END_MASTER( myThid )
593    
594    C     Send ocean surface salinity
595          DO bj=1,nSy
596           DO bi=1,nSx
597            DO j=1,sNy
598             DO i=1,sNx
599              local(i,j,bi,bj) = salt(i,j,1,bi,bj)
600             ENDDO
601            ENDDO
602           ENDDO
603          ENDDO
604          CALL GATHER_2D( xfer_array, local, myThid )
605          _BEGIN_MASTER( myThid )
606          IF ( myworldid .EQ. local_ocean_leader ) THEN
607           buffsize = Nx*Ny
608           CALL MPI_SEND(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
609         &    local_ice_leader,SssTag,MPI_COMM_WORLD,mpierr)
610          ENDIF
611          _END_MASTER( myThid )
612    
613  C     Send surface u current  C     Send surface u current
614        DO bj=1,nSy        DO bj=1,nSy
615         DO bi=1,nSx         DO bi=1,nSx
# Line 645  C     Receive ice area Line 672  C     Receive ice area
672        ENDIF        ENDIF
673        _END_MASTER( myThid )        _END_MASTER( myThid )
674        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
675          DO bj=1,nSy
676           DO bi=1,nSx
677            DO j=1,sNy
678             DO i=1,sNx
679              AREA(i,j,bi,bj) = local(i,j,bi,bj)
680             ENDDO
681            ENDDO
682           ENDDO
683          ENDDO
684        
685  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
686        DO bj=1,nSy        DO bj=1,nSy
687         DO bi=1,nSx         DO bi=1,nSx
# Line 667  C     Receive ice thickness Line 704  C     Receive ice thickness
704        ENDIF        ENDIF
705        _END_MASTER( myThid )        _END_MASTER( myThid )
706        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
707          DO bj=1,nSy
708           DO bi=1,nSx
709            DO j=1,sNy
710             DO i=1,sNx
711              HEFF(i,j,bi,bj) = local(i,j,bi,bj)
712             ENDDO
713            ENDDO
714           ENDDO
715          ENDDO
716  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
717        DO bj=1,nSy        DO bj=1,nSy
718         DO bi=1,nSx         DO bi=1,nSx
# Line 689  C     Receive ice salinity Line 735  C     Receive ice salinity
735        ENDIF        ENDIF
736        _END_MASTER( myThid )        _END_MASTER( myThid )
737        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
738          DO bj=1,nSy
739           DO bi=1,nSx
740            DO j=1,sNy
741             DO i=1,sNx
742              HSALT(i,j,bi,bj) = local(i,j,bi,bj)
743             ENDDO
744            ENDDO
745           ENDDO
746          ENDDO
747  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
748        DO bj=1,nSy        DO bj=1,nSy
749         DO bi=1,nSx         DO bi=1,nSx
# Line 711  C     Receive snow thickness Line 766  C     Receive snow thickness
766        ENDIF        ENDIF
767        _END_MASTER( myThid )        _END_MASTER( myThid )
768        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
769          DO bj=1,nSy
770           DO bi=1,nSx
771            DO j=1,sNy
772             DO i=1,sNx
773              HSNOW(i,j,bi,bj) = local(i,j,bi,bj)
774             ENDDO
775            ENDDO
776           ENDDO
777          ENDDO
778  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
779        DO bj=1,nSy        DO bj=1,nSy
780         DO bi=1,nSx         DO bi=1,nSx
# Line 733  C     Receive u surface stress Line 797  C     Receive u surface stress
797        ENDIF        ENDIF
798        _END_MASTER( myThid )        _END_MASTER( myThid )
799        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
800          DO bj=1,nSy
801           DO bi=1,nSx
802            DO j=1,sNy
803             DO i=1,sNx
804              fu(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +
805         &                (1.-AREA(i,j,bi,bj)) * fu_tmp(i,j,bi,bj)
806             ENDDO
807            ENDDO
808           ENDDO
809          ENDDO
810  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
811        DO bj=1,nSy        DO bj=1,nSy
812         DO bi=1,nSx         DO bi=1,nSx
# Line 755  C     Receive v surface stress Line 829  C     Receive v surface stress
829        ENDIF        ENDIF
830        _END_MASTER( myThid )        _END_MASTER( myThid )
831        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
832          DO bj=1,nSy
833           DO bi=1,nSx
834            DO j=1,sNy
835             DO i=1,sNx
836              fv(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +
837         &                (1.-AREA(i,j,bi,bj)) * fv_tmp(i,j,bi,bj)
838             ENDDO
839            ENDDO
840           ENDDO
841          ENDDO
842  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
843        DO bj=1,nSy        DO bj=1,nSy
844         DO bi=1,nSx         DO bi=1,nSx
# Line 777  C     Receive residual shortwave Line 861  C     Receive residual shortwave
861        ENDIF        ENDIF
862        _END_MASTER( myThid )        _END_MASTER( myThid )
863        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
864   #ifdef CPL_DEBUG        DO bj=1,nSy
865       DO bj=1,nSy         DO bi=1,nSx
866            DO j=1,sNy
867             DO i=1,sNx
868              Qsw(i,j,bi,bj) = -AREA(i,j,bi,bj) * local(i,j,bi,bj) +
869         &                  (1.-AREA(i,j,bi,bj)) * Qsw_tmp(i,j,bi,bj)
870             ENDDO
871            ENDDO
872           ENDDO
873          ENDDO
874    #ifdef CPL_DEBUG
875          DO bj=1,nSy
876         DO bi=1,nSx         DO bi=1,nSx
877          DO j=1,sNy          DO j=1,sNy
878           DO i=1,sNx           DO i=1,sNx
# Line 799  C     Receive heat flux Line 893  C     Receive heat flux
893        ENDIF        ENDIF
894        _END_MASTER( myThid )        _END_MASTER( myThid )
895        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
896          DO bj=1,nSy
897           DO bi=1,nSx
898            DO j=1,sNy
899             DO i=1,sNx
900              Qnet(i,j,bi,bj) = Qsw(i,j,bi,bj) -
901         &                   AREA(i,j,bi,bj) * local(i,j,bi,bj) +
902         &               (1.-AREA(i,j,bi,bj)) * Qnet_tmp(i,j,bi,bj)
903             ENDDO
904            ENDDO
905           ENDDO
906          ENDDO
907  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
908        DO bj=1,nSy        DO bj=1,nSy
909         DO bi=1,nSx         DO bi=1,nSx
# Line 821  C     Receive freshwater flux Line 926  C     Receive freshwater flux
926        ENDIF        ENDIF
927        _END_MASTER( myThid )        _END_MASTER( myThid )
928        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
929          DO bj=1,nSy
930           DO bi=1,nSx
931            DO j=1,sNy
932             DO i=1,sNx
933              EmPmR(i,j,bi,bj) = - AREA(i,j,bi,bj)  * local    (i,j,bi,bj) +
934         &                  ( 1. - AREA(i,j,bi,bj)) * EmPmR_tmp(i,j,bi,bj)
935             ENDDO
936            ENDDO
937           ENDDO
938          ENDDO
939  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
940        DO bj=1,nSy        DO bj=1,nSy
941         DO bi=1,nSx         DO bi=1,nSx
# Line 843  C     Receive salt flux Line 958  C     Receive salt flux
958        ENDIF        ENDIF
959        _END_MASTER( myThid )        _END_MASTER( myThid )
960        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
961          DO bj=1,nSy
962           DO bi=1,nSx
963            DO j=1,sNy
964             DO i=1,sNx
965              saltFlux(i,j,bi,bj) = - AREA(i,j,bi,bj) * local(i,j,bi,bj)
966             ENDDO
967            ENDDO
968           ENDDO
969          ENDDO
970  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
971        DO bj=1,nSy        DO bj=1,nSy
972         DO bi=1,nSx         DO bi=1,nSx
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22