/[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.13 by dimitri, Wed Mar 14 05:32:10 2012 UTC revision 1.17 by dimitri, Thu Mar 22 02:16:33 2012 UTC
# Line 23  C     == Global variables == Line 23  C     == Global variables ==
23  #include "DYNVARS.h"  #include "DYNVARS.h"
24  #include "GRID.h"  #include "GRID.h"
25  #include "FFIELDS.h"  #include "FFIELDS.h"
26    #include "SEAICE_OPTIONS.h"
27    #include "SEAICE_SIZE.h"
28    #include "SEAICE.h"
29  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
30  # include "EXF_OPTIONS.h"  # include "EXF_OPTIONS.h"
31  # include "EXF_FIELDS.h"  # include "EXF_FIELDS.h"
32  #endif  #endif
 #ifdef ALLOW_SEAICE  
 # include "SEAICE_OPTIONS.h"  
 # include "SEAICE_SIZE.h"  
 # include "SEAICE.h"  
 #endif  
33    
34        LOGICAL  DIFFERENT_MULTIPLE        LOGICAL  DIFFERENT_MULTIPLE
35        EXTERNAL DIFFERENT_MULTIPLE        EXTERNAL DIFFERENT_MULTIPLE
# Line 61  CEOP Line 59  CEOP
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  # ifdef CPL_DEBUG
63        _RS  fu_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        character*(10) itername
64        _RS  fv_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        write(itername,'(i10.10)') myIter
65        _RS  Qnet_tmp     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  # endif /* CPL_DEBUG */
       _RS  Qsw_tmp      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  EmPmR_tmp    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
66    
67        IF( myTime .EQ. startTime ) THEN        IF( myTime .EQ. startTime ) THEN
68    
# Line 199  C     Send snow thickness Line 195  C     Send snow thickness
195    
196        ENDIF ! ( myTime .EQ. startTime )        ENDIF ! ( myTime .EQ. startTime )
197    
198    C--   Apply ice open boundary conditions
199    #ifdef ALLOW_OBCS
200          IF ( useOBCS ) THEN
201           CALL OBCS_APPLY_SEAICE( myThid )
202           CALL OBCS_APPLY_UVICE( uice, vice, myThid )
203          ENDIF
204    #endif /* ALLOW_OBCS */
205    
206  C     Send ocean model time  C     Send ocean model time
207        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
208        xfer_scalar = myTime        xfer_scalar = myTime
# Line 242  C     Send boundary ice area Line 246  C     Send boundary ice area
246         idx = idx + 1         idx = idx + 1
247         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
248        ENDDO        ENDDO
249          buffsize = 2*(Nx+Ny)-4
250  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
251        CALL PLOT_FIELD_XYRL( AREA, 'AREA obcs', myIter, myThid )        CALL PLOT_FIELD_XYRL( AREA, 'AREA obcs', myIter, myThid )
252          CALL WRITE_GLVEC_RS ( 'AREAobcs.', itername,
253         &     xfer_bc_tracer, buffsize, myIter, myThid )
254  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
255  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
256        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
257        IF ( myworldid .EQ. local_ocean_leader ) THEN        IF ( myworldid .EQ. local_ocean_leader ) THEN
        buffsize = 2*(Nx+Ny)-4  
258  cdb    print*,'MITgcm is about to send AreaBcTag',buffsize  cdb    print*,'MITgcm is about to send AreaBcTag',buffsize
259         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
260       &    local_ice_leader,AreaBcTag,MPI_COMM_WORLD,mpierr)       &    local_ice_leader,AreaBcTag,MPI_COMM_WORLD,mpierr)
# Line 285  C     Send boundary ice thickness Line 291  C     Send boundary ice thickness
291         idx = idx + 1         idx = idx + 1
292         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
293        ENDDO        ENDDO
294          buffsize = 2*(Nx+Ny)-4
295  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
296        CALL PLOT_FIELD_XYRL( HEFF, 'HEFF obcs', myIter, myThid )        CALL PLOT_FIELD_XYRL( HEFF, 'HEFF obcs', myIter, myThid )
297          CALL WRITE_GLVEC_RS ( 'HEFFobcs.', itername,
298         &     xfer_bc_tracer, buffsize, myIter, myThid )
299  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
300  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
301        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
302        IF ( myworldid .EQ. local_ocean_leader ) THEN        IF ( myworldid .EQ. local_ocean_leader ) THEN
        buffsize = 2*(Nx+Ny)-4  
303         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
304       &    local_ice_leader,HeffBcTag,MPI_COMM_WORLD,mpierr)       &    local_ice_leader,HeffBcTag,MPI_COMM_WORLD,mpierr)
305        ENDIF        ENDIF
# Line 326  C     Send boundary ice salinity Line 334  C     Send boundary ice salinity
334         idx = idx + 1         idx = idx + 1
335         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
336        ENDDO        ENDDO
337          buffsize = 2*(Nx+Ny)-4
338  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
339        CALL PLOT_FIELD_XYRL( HSALT, 'HSALT obcs', myIter, myThid )        CALL PLOT_FIELD_XYRL( HSALT, 'HSALT obcs', myIter, myThid )
340          CALL WRITE_GLVEC_RS ( 'HSALTobcs.', itername,
341         &     xfer_bc_tracer, buffsize, myIter, myThid )
342  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
343  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
344        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
345        IF ( myworldid .EQ. local_ocean_leader ) THEN        IF ( myworldid .EQ. local_ocean_leader ) THEN
        buffsize = 2*(Nx+Ny)-4  
346         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
347       &    local_ice_leader,HsaltBcTag,MPI_COMM_WORLD,mpierr)       &    local_ice_leader,HsaltBcTag,MPI_COMM_WORLD,mpierr)
348        ENDIF        ENDIF
# Line 367  C     Send boundary snow thickness Line 377  C     Send boundary snow thickness
377         idx = idx + 1         idx = idx + 1
378         xfer_bc_tracer(idx) = xfer_array(1,j)         xfer_bc_tracer(idx) = xfer_array(1,j)
379        ENDDO        ENDDO
380          buffsize = 2*(Nx+Ny)-4
381  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
382        CALL PLOT_FIELD_XYRL( HSNOW, 'HSNOW obcs', myIter, myThid )        CALL PLOT_FIELD_XYRL( HSNOW, 'HSNOW obcs', myIter, myThid )
383          CALL WRITE_GLVEC_RS ( 'HSNOWobcs.', itername,
384         &     xfer_bc_tracer, buffsize, myIter, myThid )
385  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
386  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
387        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
388        IF ( myworldid .EQ. local_ocean_leader ) THEN        IF ( myworldid .EQ. local_ocean_leader ) THEN
        buffsize = 2*(Nx+Ny)-4  
389         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,         CALL MPI_SEND(xfer_bc_tracer,buffsize,MPI_DOUBLE_PRECISION,
390       &    local_ice_leader,HsnowBcTag,MPI_COMM_WORLD,mpierr)       &    local_ice_leader,HsnowBcTag,MPI_COMM_WORLD,mpierr)
391        ENDIF        ENDIF
# Line 408  C     Send boundary u ice Line 420  C     Send boundary u ice
420         idx = idx + 1         idx = idx + 1
421         xfer_bc_veloc(idx) = xfer_array(2,j)         xfer_bc_veloc(idx) = xfer_array(2,j)
422        ENDDO        ENDDO
423          buffsize = 2*(Nx+Ny)-6
424  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
425        CALL PLOT_FIELD_XYRL( UICE, 'UICE obcs', myIter, myThid )        CALL PLOT_FIELD_XYRL( UICE, 'UICE obcs', myIter, myThid )
426          CALL WRITE_GLVEC_RS ( 'UICEobcs.', itername,
427         &     xfer_bc_veloc, buffsize, myIter, myThid )
428  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
429  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
430        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
431        IF ( myworldid .EQ. local_ocean_leader ) THEN        IF ( myworldid .EQ. local_ocean_leader ) THEN
        buffsize = 2*(Nx+Ny)-6  
432         CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,         CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,
433       &    local_ice_leader,UiceBcTag,MPI_COMM_WORLD,mpierr)       &    local_ice_leader,UiceBcTag,MPI_COMM_WORLD,mpierr)
434        ENDIF        ENDIF
# Line 449  C     Send boundary v ice Line 463  C     Send boundary v ice
463         idx = idx + 1         idx = idx + 1
464         xfer_bc_veloc(idx) = xfer_array(1,j)         xfer_bc_veloc(idx) = xfer_array(1,j)
465        ENDDO        ENDDO
466          buffsize = 2*(Nx+Ny)-6
467  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
468        CALL PLOT_FIELD_XYRL( VICE, 'VICE obcs', myIter, myThid )        CALL PLOT_FIELD_XYRL( VICE, 'VICE obcs', myIter, myThid )
469          CALL WRITE_GLVEC_RS ( 'VICEobcs.', itername,
470         &     xfer_bc_veloc, buffsize, myIter, myThid )
471  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
472  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
473        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
474        IF ( myworldid .EQ. local_ocean_leader ) THEN        IF ( myworldid .EQ. local_ocean_leader ) THEN
        buffsize = 2*(Nx+Ny)-6  
475         CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,         CALL MPI_SEND(xfer_bc_veloc,buffsize,MPI_DOUBLE_PRECISION,
476       &    local_ice_leader,ViceBcTag,MPI_COMM_WORLD,mpierr)       &    local_ice_leader,ViceBcTag,MPI_COMM_WORLD,mpierr)
477        ENDIF        ENDIF
# Line 846  C     Receive snow thickness Line 862  C     Receive snow thickness
862        CALL PLOT_FIELD_XYRL( HSNOW, 'snow thickness', myIter, myThid )        CALL PLOT_FIELD_XYRL( HSNOW, 'snow thickness', myIter, myThid )
863  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
864    
865    C     Receive u ice velocity
866    # ifdef CPL_COUPLED
867          _BEGIN_MASTER( myThid )
868          IF ( myworldid .EQ. local_ocean_leader ) THEN
869           buffsize = Nx*Ny
870           CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
871         &    local_ice_leader,UiceTag,MPI_COMM_WORLD,mpistatus,mpierr)
872          ENDIF
873          _END_MASTER( myThid )
874          CALL SCATTER_2D( xfer_array, local, myThid )
875          DO bj=1,nSy
876           DO bi=1,nSx
877            DO j=1,sNy
878             DO i=1,sNx
879              UICE(i,j,bi,bj) = local(i,j,bi,bj)
880             ENDDO
881            ENDDO
882           ENDDO
883          ENDDO
884    #  ifdef CPL_DEBUG
885          CALL PLOT_FIELD_XYRL( local, 'uice', myIter, myThid )
886    #  endif /* CPL_DEBUG */
887    # endif /* CPL_COUPLED */
888    # ifdef CPL_DEBUG
889          CALL PLOT_FIELD_XYRL( UICE, 'uice', myIter, myThid )
890    # endif /* CPL_DEBUG */
891    
892    C     Receive v ice velocity
893    # ifdef CPL_COUPLED
894          _BEGIN_MASTER( myThid )
895          IF ( myworldid .EQ. local_ocean_leader ) THEN
896           buffsize = Nx*Ny
897           CALL MPI_RECV(xfer_array,buffsize,MPI_DOUBLE_PRECISION,
898         &    local_ice_leader,ViceTag,MPI_COMM_WORLD,mpistatus,mpierr)
899          ENDIF
900          _END_MASTER( myThid )
901          CALL SCATTER_2D( xfer_array, local, myThid )
902          DO bj=1,nSy
903           DO bi=1,nSx
904            DO j=1,sNy
905             DO i=1,sNx
906              VICE(i,j,bi,bj) = local(i,j,bi,bj)
907             ENDDO
908            ENDDO
909           ENDDO
910          ENDDO
911    #  ifdef CPL_DEBUG
912          CALL PLOT_FIELD_XYRL( local, 'vice', myIter, myThid )
913    #  endif /* CPL_DEBUG */
914    # endif /* CPL_COUPLED */
915    # ifdef CPL_DEBUG
916          CALL PLOT_FIELD_XYRL( VICE, 'vice', myIter, myThid )
917    # endif /* CPL_DEBUG */
918    
919  C     Receive u surface stress  C     Receive u surface stress
920  # ifdef CPL_COUPLED  # ifdef CPL_COUPLED
921        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
# Line 860  C     Receive u surface stress Line 930  C     Receive u surface stress
930         DO bi=1,nSx         DO bi=1,nSx
931          DO j=1,sNy          DO j=1,sNy
932           DO i=1,sNx           DO i=1,sNx
933            fu(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +            fu(i,j,bi,bj) = AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
934       &                (1.-AREA(i,j,bi,bj)) * fu_tmp(i,j,bi,bj)       &                (1.-AREA(i,j,bi,bj)) * fu   (i,j,bi,bj)
935           ENDDO           ENDDO
936          ENDDO          ENDDO
937         ENDDO         ENDDO
# Line 888  C     Receive v surface stress Line 958  C     Receive v surface stress
958         DO bi=1,nSx         DO bi=1,nSx
959          DO j=1,sNy          DO j=1,sNy
960           DO i=1,sNx           DO i=1,sNx
961            fv(i,j,bi,bj) = AREA(i,j,bi,bj) * local(i,j,bi,bj) +            fv(i,j,bi,bj) = AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
962       &                (1.-AREA(i,j,bi,bj)) * fv_tmp(i,j,bi,bj)       &                (1.-AREA(i,j,bi,bj)) * fv   (i,j,bi,bj)
963           ENDDO           ENDDO
964          ENDDO          ENDDO
965         ENDDO         ENDDO
# Line 916  C     Receive residual shortwave Line 986  C     Receive residual shortwave
986         DO bi=1,nSx         DO bi=1,nSx
987          DO j=1,sNy          DO j=1,sNy
988           DO i=1,sNx           DO i=1,sNx
989            Qsw(i,j,bi,bj) = -AREA(i,j,bi,bj) * local(i,j,bi,bj) +            Qsw(i,j,bi,bj) = -AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
990       &                  (1.-AREA(i,j,bi,bj)) * Qsw_tmp(i,j,bi,bj)       &                  (1.-AREA(i,j,bi,bj)) *   Qsw(i,j,bi,bj)
991           ENDDO           ENDDO
992          ENDDO          ENDDO
993         ENDDO         ENDDO
# Line 945  C     Receive heat flux Line 1015  C     Receive heat flux
1015          DO j=1,sNy          DO j=1,sNy
1016           DO i=1,sNx           DO i=1,sNx
1017            Qnet(i,j,bi,bj) = Qsw(i,j,bi,bj) -            Qnet(i,j,bi,bj) = Qsw(i,j,bi,bj) -
1018       &                   AREA(i,j,bi,bj) * local(i,j,bi,bj) +       &                   AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
1019       &               (1.-AREA(i,j,bi,bj)) * Qnet_tmp(i,j,bi,bj)       &               (1.-AREA(i,j,bi,bj)) *  Qnet(i,j,bi,bj)
1020           ENDDO           ENDDO
1021          ENDDO          ENDDO
1022         ENDDO         ENDDO
# Line 973  C     Receive freshwater flux Line 1043  C     Receive freshwater flux
1043         DO bi=1,nSx         DO bi=1,nSx
1044          DO j=1,sNy          DO j=1,sNy
1045           DO i=1,sNx           DO i=1,sNx
1046            EmPmR(i,j,bi,bj) = - AREA(i,j,bi,bj)  * local    (i,j,bi,bj) +            EmPmR(i,j,bi,bj) = - AREA(i,j,bi,bj)  * local(i,j,bi,bj) +
1047       &                  ( 1. - AREA(i,j,bi,bj)) * EmPmR_tmp(i,j,bi,bj)       &                  ( 1. - AREA(i,j,bi,bj)) * EmPmR(i,j,bi,bj)
1048           ENDDO           ENDDO
1049          ENDDO          ENDDO
1050         ENDDO         ENDDO
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22