/[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.8 by dimitri, Fri Feb 3 18:12:59 2012 UTC
# Line 57  CEOP Line 57  CEOP
57        Real*8  xfer_bc_tracer(2*(Nx+Ny)-4)        Real*8  xfer_bc_tracer(2*(Nx+Ny)-4)
58        Real*8  xfer_bc_veloc(2*(Nx+Ny)-6)        Real*8  xfer_bc_veloc(2*(Nx+Ny)-6)
59        _RL     local(1:sNx,1:sNy,nSx,nSy)        _RL     local(1:sNx,1:sNy,nSx,nSy)
60    
61          COMMON /FFIELDS_tmp/ fu_tmp, fv_tmp, Qnet_tmp, Qsw_tmp, EmPmR_tmp
62          _RS  fu_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
63          _RS  fv_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
64          _RS  Qnet_tmp     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
65          _RS  Qsw_tmp      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
66          _RS  EmPmR_tmp    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
67    
68  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
69       _RL ScatArray(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL ScatArray(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
70        DO bj=1,nSy        DO bj=1,nSy
71         DO bi=1,nSx         DO bi=1,nSx
72          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
# Line 105  C     Send ice area Line 112  C     Send ice area
112          DO bi=1,nSx          DO bi=1,nSx
113           DO j=1,sNy           DO j=1,sNy
114            DO i=1,sNx            DO i=1,sNx
115             local(i,j,bi,bj) = AREA(i,j,1,bi,bj)             local(i,j,bi,bj) = AREA(i,j,bi,bj)
116            ENDDO            ENDDO
117           ENDDO           ENDDO
118          ENDDO          ENDDO
# Line 127  C     Send ice thickness Line 134  C     Send ice thickness
134          DO bi=1,nSx          DO bi=1,nSx
135           DO j=1,sNy           DO j=1,sNy
136            DO i=1,sNx            DO i=1,sNx
137             local(i,j,bi,bj) = HEFF(i,j,1,bi,bj)             local(i,j,bi,bj) = HEFF(i,j,bi,bj)
138            ENDDO            ENDDO
139           ENDDO           ENDDO
140          ENDDO          ENDDO
# Line 208  C     Send boundary ice area Line 215  C     Send boundary ice area
215         DO bi=1,nSx         DO bi=1,nSx
216          DO j=1,sNy          DO j=1,sNy
217           DO i=1,sNx           DO i=1,sNx
218            local(i,j,bi,bj) = AREA(i,j,1,bi,bj)            local(i,j,bi,bj) = AREA(i,j,bi,bj)
219           ENDDO           ENDDO
220          ENDDO          ENDDO
221         ENDDO         ENDDO
# Line 223  C     Send boundary ice area Line 230  C     Send boundary ice area
230         idx = idx + 1         idx = idx + 1
231         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
232        ENDDO        ENDDO
233        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
234         idx = idx + 1         idx = idx + 1
235         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
236        ENDDO        ENDDO
237        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
238         idx = idx + 1         idx = idx + 1
239         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
240        ENDDO        ENDDO
# Line 246  C     Send boundary ice thickness Line 253  C     Send boundary ice thickness
253         DO bi=1,nSx         DO bi=1,nSx
254          DO j=1,sNy          DO j=1,sNy
255           DO i=1,sNx           DO i=1,sNx
256            local(i,j,bi,bj) = HEFF(i,j,1,bi,bj)            local(i,j,bi,bj) = HEFF(i,j,bi,bj)
257           ENDDO           ENDDO
258          ENDDO          ENDDO
259         ENDDO         ENDDO
# Line 261  C     Send boundary ice thickness Line 268  C     Send boundary ice thickness
268         idx = idx + 1         idx = idx + 1
269         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
270        ENDDO        ENDDO
271        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
272         idx = idx + 1         idx = idx + 1
273         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
274        ENDDO        ENDDO
275        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
276         idx = idx + 1         idx = idx + 1
277         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
278        ENDDO        ENDDO
# Line 297  C     Send boundary ice salinity Line 304  C     Send boundary ice salinity
304         idx = idx + 1         idx = idx + 1
305         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
306        ENDDO        ENDDO
307        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
308         idx = idx + 1         idx = idx + 1
309         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
310        ENDDO        ENDDO
311        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
312         idx = idx + 1         idx = idx + 1
313         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
314        ENDDO        ENDDO
# Line 333  C     Send boundary snow thickness Line 340  C     Send boundary snow thickness
340         idx = idx + 1         idx = idx + 1
341         xfer_bc_tracer(idx) = xfer_array(Nx,j)         xfer_bc_tracer(idx) = xfer_array(Nx,j)
342        ENDDO        ENDDO
343        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
344         idx = idx + 1         idx = idx + 1
345         xfer_bc_tracer(idx) = xfer_array(i,Ny)         xfer_bc_tracer(idx) = xfer_array(i,Ny)
346        ENDDO        ENDDO
347        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
348         idx = idx + 1         idx = idx + 1
349         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
350        ENDDO        ENDDO
# Line 354  C     Send boundary u ice Line 361  C     Send boundary u ice
361         DO bi=1,nSx         DO bi=1,nSx
362          DO j=1,sNy          DO j=1,sNy
363           DO i=1,sNx           DO i=1,sNx
364            local(i,j,bi,bj) = UICE(i,j,1,bi,bj)            local(i,j,bi,bj) = UICE(i,j,bi,bj)
365           ENDDO           ENDDO
366          ENDDO          ENDDO
367         ENDDO         ENDDO
# Line 369  C     Send boundary u ice Line 376  C     Send boundary u ice
376         idx = idx + 1         idx = idx + 1
377         xfer_bc_veloc(idx) = xfer_array(Nx,j)         xfer_bc_veloc(idx) = xfer_array(Nx,j)
378        ENDDO        ENDDO
379        DO i = (Nx-1), -1, 2        DO i = (Nx-1), 2, -1
380         idx = idx + 1         idx = idx + 1
381         xfer_bc_veloc(idx) = xfer_array(i,Ny)         xfer_bc_veloc(idx) = xfer_array(i,Ny)
382        ENDDO        ENDDO
383        DO j = (Ny-1), -1, 2        DO j = (Ny-1), 2, -1
384         idx = idx + 1         idx = idx + 1
385         xfer_bc_veloc(idx) = xfer_array(2,j)         xfer_bc_veloc(idx) = xfer_array(2,j)
386        ENDDO        ENDDO
# Line 390  C     Send boundary v ice Line 397  C     Send boundary v ice
397         DO bi=1,nSx         DO bi=1,nSx
398          DO j=1,sNy          DO j=1,sNy
399           DO i=1,sNx           DO i=1,sNx
400            local(i,j,bi,bj) = VICE(i,j,1,bi,bj)            local(i,j,bi,bj) = VICE(i,j,bi,bj)
401           ENDDO           ENDDO
402          ENDDO          ENDDO
403         ENDDO         ENDDO
# Line 405  C     Send boundary v ice Line 412  C     Send boundary v ice
412         idx = idx + 1         idx = idx + 1
413         xfer_bc_veloc(idx) = xfer_array(Nx,j)         xfer_bc_veloc(idx) = xfer_array(Nx,j)
414        ENDDO        ENDDO
415        DO i = (Nx-1), -1, 1        DO i = (Nx-1), 1, -1
416         idx = idx + 1         idx = idx + 1
417         xfer_bc_veloc(idx) = xfer_array(i,Ny)         xfer_bc_veloc(idx) = xfer_array(i,Ny)
418        ENDDO        ENDDO
419        DO j = (Ny-1), -1, 3        DO j = (Ny-1), 3, -1
420         idx = idx + 1         idx = idx + 1
421         xfer_bc_veloc(idx) = xfer_array(1,j)         xfer_bc_veloc(idx) = xfer_array(1,j)
422        ENDDO        ENDDO
# Line 583  C     Send ocean surface temperature Line 590  C     Send ocean surface temperature
590        ENDIF        ENDIF
591        _END_MASTER( myThid )        _END_MASTER( myThid )
592    
593    C     Send ocean surface salinity
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) = salt(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,SssTag,MPI_COMM_WORLD,mpierr)
609          ENDIF
610          _END_MASTER( myThid )
611    
612  C     Send surface u current  C     Send surface u current
613        DO bj=1,nSy        DO bj=1,nSy
614         DO bi=1,nSx         DO bi=1,nSx
# Line 645  C     Receive ice area Line 671  C     Receive ice area
671        ENDIF        ENDIF
672        _END_MASTER( myThid )        _END_MASTER( myThid )
673        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
674          DO bj=1,nSy
675           DO bi=1,nSx
676            DO j=1,sNy
677             DO i=1,sNx
678              AREA(i,j,bi,bj) = local(i,j,bi,bj)
679             ENDDO
680            ENDDO
681           ENDDO
682          ENDDO
683        
684  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
685        DO bj=1,nSy        DO bj=1,nSy
686         DO bi=1,nSx         DO bi=1,nSx
# Line 667  C     Receive ice thickness Line 703  C     Receive ice thickness
703        ENDIF        ENDIF
704        _END_MASTER( myThid )        _END_MASTER( myThid )
705        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
706          DO bj=1,nSy
707           DO bi=1,nSx
708            DO j=1,sNy
709             DO i=1,sNx
710              HEFF(i,j,bi,bj) = local(i,j,bi,bj)
711             ENDDO
712            ENDDO
713           ENDDO
714          ENDDO
715  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
716        DO bj=1,nSy        DO bj=1,nSy
717         DO bi=1,nSx         DO bi=1,nSx
# Line 689  C     Receive ice salinity Line 734  C     Receive ice salinity
734        ENDIF        ENDIF
735        _END_MASTER( myThid )        _END_MASTER( myThid )
736        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
737          DO bj=1,nSy
738           DO bi=1,nSx
739            DO j=1,sNy
740             DO i=1,sNx
741              HSALT(i,j,bi,bj) = local(i,j,bi,bj)
742             ENDDO
743            ENDDO
744           ENDDO
745          ENDDO
746  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
747        DO bj=1,nSy        DO bj=1,nSy
748         DO bi=1,nSx         DO bi=1,nSx
# Line 711  C     Receive snow thickness Line 765  C     Receive snow thickness
765        ENDIF        ENDIF
766        _END_MASTER( myThid )        _END_MASTER( myThid )
767        CALL SCATTER_2D( xfer_array, local, myThid )        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              HSNOW(i,j,bi,bj) = local(i,j,bi,bj)
773             ENDDO
774            ENDDO
775           ENDDO
776          ENDDO
777  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
778        DO bj=1,nSy        DO bj=1,nSy
779         DO bi=1,nSx         DO bi=1,nSx
# Line 733  C     Receive u surface stress Line 796  C     Receive u surface stress
796        ENDIF        ENDIF
797        _END_MASTER( myThid )        _END_MASTER( myThid )
798        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
799          DO bj=1,nSy
800           DO bi=1,nSx
801            DO j=1,sNy
802             DO i=1,sNx
803              fu(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +
804         &                (1.-AREA(i,j,bi,bj)) * fu_tmp(i,j,bi,bj)
805             ENDDO
806            ENDDO
807           ENDDO
808          ENDDO
809  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
810        DO bj=1,nSy        DO bj=1,nSy
811         DO bi=1,nSx         DO bi=1,nSx
# Line 755  C     Receive v surface stress Line 828  C     Receive v surface stress
828        ENDIF        ENDIF
829        _END_MASTER( myThid )        _END_MASTER( myThid )
830        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
831          DO bj=1,nSy
832           DO bi=1,nSx
833            DO j=1,sNy
834             DO i=1,sNx
835              fv(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +
836         &                (1.-AREA(i,j,bi,bj)) * fv_tmp(i,j,bi,bj)
837             ENDDO
838            ENDDO
839           ENDDO
840          ENDDO
841  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
842        DO bj=1,nSy        DO bj=1,nSy
843         DO bi=1,nSx         DO bi=1,nSx
# Line 777  C     Receive residual shortwave Line 860  C     Receive residual shortwave
860        ENDIF        ENDIF
861        _END_MASTER( myThid )        _END_MASTER( myThid )
862        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
863   #ifdef CPL_DEBUG        DO bj=1,nSy
864       DO bj=1,nSy         DO bi=1,nSx
865            DO j=1,sNy
866             DO i=1,sNx
867              Qsw(i,j,bi,bj) = -AREA(i,j,bi,bj) * local(i,j,bi,bj) +
868         &                  (1.-AREA(i,j,bi,bj)) * Qsw_tmp(i,j,bi,bj)
869             ENDDO
870            ENDDO
871           ENDDO
872          ENDDO
873    #ifdef CPL_DEBUG
874          DO bj=1,nSy
875         DO bi=1,nSx         DO bi=1,nSx
876          DO j=1,sNy          DO j=1,sNy
877           DO i=1,sNx           DO i=1,sNx
# Line 799  C     Receive heat flux Line 892  C     Receive heat flux
892        ENDIF        ENDIF
893        _END_MASTER( myThid )        _END_MASTER( myThid )
894        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
895          DO bj=1,nSy
896           DO bi=1,nSx
897            DO j=1,sNy
898             DO i=1,sNx
899              fv(i,j,bi,bj) = Qsw(i,j,bi,bj) -
900         &                   AREA(i,j,bi,bj) * local(i,j,bi,bj) +
901         &               (1.-AREA(i,j,bi,bj)) * Qnet_tmp(i,j,bi,bj)
902             ENDDO
903            ENDDO
904           ENDDO
905          ENDDO
906  #ifdef CPL_DEBUG  #ifdef CPL_DEBUG
907        DO bj=1,nSy        DO bj=1,nSy
908         DO bi=1,nSx         DO bi=1,nSx
# Line 821  C     Receive freshwater flux Line 925  C     Receive freshwater flux
925        ENDIF        ENDIF
926        _END_MASTER( myThid )        _END_MASTER( myThid )
927        CALL SCATTER_2D( xfer_array, local, myThid )        CALL SCATTER_2D( xfer_array, local, myThid )
928          DO bj=1,nSy
929           DO bi=1,nSx
930            DO j=1,sNy
931             DO i=1,sNx
932              EmPmR(i,j,bi,bj) = - rhoConstFresh *
933         &                    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.8
  ViewVC Help
Powered by ViewVC 1.1.22