Changeset 4437

Timestamp:

2014-02-04T13:14:54+01:00 (10 years ago)

Author:

trackstand2

Message:

Trim columns in exchs_generic and init mbkmax in mpp_init3

Location:

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC

Files:

• exchmod.F90 (modified) (10 diffs)
• partition_mod.F90 (modified) (4 diffs)

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/exchmod.F90

@@ -8 +8 @@
 #endif
   USE profile
-!  USE timing, ONLY: timing_start, timing_stop
+  USE timing, ONLY: timing_start, timing_stop
   ! Make some key parameters from mapcomm_mod available to all who 
   ! USE this module
@@ -3486 +3486 @@
                            isrcsend, jsrcsend, idesrecv, jdesrecv,     &
                            isrcsendp,jsrcsendp,idesrecvp,jdesrecvp,    &
-                           nxrecv,source, iesub, jesub,         &
+                           nxrecv,source, iesub, jesub,                &
                            MaxCommDir, MaxComm, idessend, jdessend,    &
                            nxsendp, nysendp, nzsendp,                  &
@@ -3495 +3495 @@
     USE lib_mpp,     ONLY: mpi_comm_opa
 #endif
-    USE dom_oce,     ONLY: narea
+    USE dom_oce,     ONLY: narea, mbkmax
     USE in_out_manager, ONLY: numout
     IMPLICIT none
@@ -3543 +3543 @@
 
     !CALL prof_region_begin(ARPEXCHS_GENERIC, "Exchs_indiv", iprofStat)
-    !CALL timing_start('exchs_generic')
+    CALL timing_start('exchs_generic')
 
     ierr = 0
@@ -3764 +3764 @@
                 DO j=jstart, jend, 1
                    DO i=istart, iend, 1
-                      DO k=1,nzsendp(ipatch,isend,1),1
+                      DO k=1,mbkmax(i,j),1
+                      !DO k=1, nzsendp(ipatch,isend,1),1
 #else
                 DO k=1,nzsendp(ipatch,isend,1),1
@@ -3801 +3802 @@
                  DO j=jstart, jend, 1
                     DO i=istart, iend, 1
-                       DO k=1,nzsendp(ipatch,isend,1),1
+                       DO k=1,mbkmax(i,j),1 ! nzsendp(ipatch,isend,1),1
 #else
                  DO k=1,nzsendp(ipatch,isend,1),1
@@ -3918 +3919 @@
                 DO j=jstart, jend, 1
                    DO i=istart, iend, 1
-                      DO k=1,nzrecvp(ipatch,irecv,1),1
+                      DO k=1,mbkmax(i,j),1 ! nzrecvp(ipatch,irecv,1),1
+                      !DO k=1, nzrecvp(ipatch,irecv,1),1
 #else
                 DO k=1,nzrecvp(ipatch,irecv,1),1
@@ -3929 +3931 @@
 #if defined key_z_first
                       ! ARPDBG - wipe anything below the ocean bottom
-                      DO k=nzrecvp(ipatch,irecv,1)+1,jpk,1
-                         b3(i,j,k) = 0.0_wp
-                      END DO
+                      !b3(i,j,nzrecvp(ipatch,irecv,1)+1:jpk) = 0.0_wp
+                      b3(i,j,mbkmax(i,j)+1:jpk) = 0.0_wp
 #endif
                    END DO
@@ -3963 +3964 @@
                 DO j=jstart, jend, 1
                    DO i=istart, iend, 1
-                      DO k=1,nzrecvp(ipatch,irecv,1),1
+                      DO k=1,mbkmax(i,j),1 ! nzrecvp(ipatch,irecv,1),1
 #else
                 DO k=1,nzrecvp(ipatch,irecv,1),1
@@ -4082 +4083 @@
     IF( ALLOCATED(recvIBuff) )DEALLOCATE(recvIBuff)
 
-    ! CALL timing_stop('exchs_generic')
+    CALL timing_stop('exchs_generic')
     !CALL prof_region_end(ARPEXCHS_GENERIC, iprofStat)
 

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/partition_mod.F90

@@ -14 +14 @@
                       nperio,      &  ! Local periodicity 
                       nwidthmax,   &  ! Width of widest northern domain
-                      narea           ! ID of local area (= rank + 1)
+                      narea,       &  ! ID of local area (= rank + 1)
+                      mbkmax          ! Deepest level above ocean floor
 #if defined key_mpp_mpi
    USE lib_mpp,        ONLY: mppsize, mppsync, mpi_comm_opa,                &
@@ -115 +116 @@
       INTEGER :: iproc, jproc                  ! Loop index
       INTEGER :: ierr                          ! Error flag
-      INTEGER :: i,j !,npoints ! ARPDBG for debugging only
+      INTEGER :: ji, jj
       CHARACTER(LEN=4) :: intStr
 
@@ -181 +182 @@
             WRITE (997,FMT='("0 1 0 setrgbcolor")')
             WRITE (997,FMT='("newpath")')
-            DO j = 1,jpjglo,1
-               DO i = 1,jpiglo,1
-                  IF(imask(i,j) /= 1)THEN
-                     WRITE (997,FMT='(I3," u ",I3," u 1 u 0 360 arc closepath")') i, j
+            DO jj = 1,jpjglo,1
+               DO ji = 1,jpiglo,1
+                  IF(imask(ji,jj) /= 1)THEN
+                     WRITE (997,FMT='(I3," u ",I3," u 1 u 0 360 arc closepath")') ji, jj
                      ! Use 'fill' instead of 'stroke' to get filled circles
                      WRITE (997,FMT='("fill")')
@@ -298 +299 @@
       ! read
       CALL write_partition()
+
+      ! Initialise mbkmax because it's needed in any halo swap calls but we didn't have
+      ! jpi and jpj until the partitioning was done.
+      DO jj=1,jpj,1
+         DO ji=1,jpi,1
+            mbkmax(ji,jj) = ibotlevel(MIN(jpiglo,ji+nimpp-1), &
+                                      MIN(jpjglo,jj+njmpp-1))
+         END DO
+      END DO
 
       ! ARPDBG - test comms setup