/[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.14 by dimitri, Thu Mar 15 20:02:56 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 60  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)
       character*(10) itername  
   
       COMMON /FFIELDS_tmp/ fu_tmp, fv_tmp, Qnet_tmp, Qsw_tmp, EmPmR_tmp  
       _RS  fu_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  fv_tmp       (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RS  Qnet_tmp     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _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)  
61    
62  # ifdef CPL_DEBUG  # ifdef CPL_DEBUG
63          character*(10) itername
64        write(itername,'(i10.10)') myIter        write(itername,'(i10.10)') myIter
65  # endif /* CPL_DEBUG */  # endif /* CPL_DEBUG */
66    
# Line 204  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 863  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 877  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 905  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 933  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 962  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 990  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.14  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22