Changeset 13458 for NEMO/trunk/src/OCE/LBC/mpp_loc_generic.h90

Timestamp:

2020-09-11T11:22:24+02:00 (4 years ago)

Author:

smasson

Message:

trunk: mpp_min(max)loc testing only inner domain, see #2521

File:

• NEMO/trunk/src/OCE/LBC/mpp_loc_generic.h90 (modified) (6 diffs)

NEMO/trunk/src/OCE/LBC/mpp_loc_generic.h90

@@ -2 +2 @@
 #   if defined SINGLE_PRECISION
 #      define ARRAY_TYPE(i,j,k)    REAL(sp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
-#      define MASK_TYPE(i,j,k)     REAL(sp)        , INTENT(in   ) ::   MASK_IN(i,j,k)
+#if defined key_mpp_mpi
+#      define MPI_TYPE MPI_2REAL
+#endif
 #      define PRECISION sp
 #   else
 #      define ARRAY_TYPE(i,j,k)    REAL(dp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
-#      define MASK_TYPE(i,j,k)     REAL(dp)        , INTENT(in   ) ::   MASK_IN(i,j,k)
+#if defined key_mpp_mpi
+#      define MPI_TYPE MPI_2DOUBLE_PRECISION
+#endif
 #      define PRECISION dp
 #   endif
@@ -12 +16 @@
 #   if defined DIM_2d
 #      define ARRAY_IN(i,j,k)   ptab(i,j)
-#      define MASK_IN(i,j,k)    pmask(i,j)
+#      define MASK_IN(i,j,k)    ldmsk(i,j)
 #      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2)
 #      define K_SIZE(ptab)      1
@@ -18 +22 @@
 #   if defined DIM_3d
 #      define ARRAY_IN(i,j,k)   ptab(i,j,k)
-#      define MASK_IN(i,j,k)    pmask(i,j,k)
+#      define MASK_IN(i,j,k)    ldmsk(i,j,k)
 #      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3)
 #      define K_SIZE(ptab)      SIZE(ptab,3)
 #   endif
 #   if defined OPERATION_MAXLOC
-#      define MPI_OPERATION mpi_maxloc
+#      define MPI_OPERATION MPI_MAXLOC
 #      define LOC_OPERATION MAXLOC
 #      define ERRVAL -HUGE
 #   endif
 #   if defined OPERATION_MINLOC
-#      define MPI_OPERATION mpi_minloc
+#      define MPI_OPERATION MPI_MINLOC
 #      define LOC_OPERATION MINLOC
 #      define ERRVAL HUGE
 #   endif
 
-   SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex )
+   SUBROUTINE ROUTINE_LOC( cdname, ptab, ldmsk, pmin, kindex, ldhalo )
       !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in    ) ::   cdname  ! name of the calling subroutine
       ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied
-      MASK_TYPE(:,:,:)                             ! local mask
-      REAL(PRECISION)        , INTENT(  out) ::   pmin    ! Global minimum of ptab
+      LOGICAL          , INTENT(in   ) ::   MASK_IN(:,:,:)                     ! local mask
+      REAL(PRECISION)  , INTENT(  out) ::   pmin    ! Global minimum of ptab
       INDEX_TYPE(:)                                ! index of minimum in global frame
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldhalo  ! If .false. (default) excludes halos in kindex 
       !
       INTEGER  ::   ierror, ii, idim
       INTEGER  ::   index0
+      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
       REAL(PRECISION) ::   zmin     ! local minimum
-      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
-      REAL(dp), DIMENSION(2,1) ::   zain, zaout
+      REAL(PRECISION), DIMENSION(2,1) ::   zain, zaout
+      LOGICAL  ::   llhalo
       !!-----------------------------------------------------------------------
       !
       IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
       !
+      IF( PRESENT(ldhalo) ) THEN   ;   llhalo = ldhalo
+      ELSE                         ;   llhalo = .FALSE.
+      ENDIF
+      !
       idim = SIZE(kindex)
       !
-      IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN
-         ! special case for land processors
-         zmin = ERRVAL(zmin)
-         index0 = 0
-      ELSE
+      IF ( ANY( MASK_IN(:,:,:) ) ) THEN   ! there is at least 1 valid point...
+         !
          ALLOCATE ( ilocs(idim) )
          !
-         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp )
+         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) )
          zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
          !
@@ -79 +86 @@
          index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
 #endif
+      ELSE
+         ! special case for land processors
+         zmin = ERRVAL(zmin)
+         index0 = 0
       END IF
+      !
       zain(1,:) = zmin
-      zain(2,:) = REAL(index0, wp)
+      zain(2,:) = REAL(index0, PRECISION)
       !
+#if defined key_mpp_mpi
       IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
-#if defined key_mpp_mpi
-      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)
+      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_TYPE, MPI_OPERATION ,MPI_COMM_OCE, ierror)
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
 #else
       zaout(:,:) = zain(:,:)
 #endif
-      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
       !
       pmin      = zaout(1,1)
@@ -104 +116 @@
       kindex(:) = kindex(:) + 1   ! start indices at 1
 
+      IF( .NOT. llhalo ) THEN
+         kindex(1)  = kindex(1) - nn_hls
+#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
+         kindex(2)  = kindex(2) - nn_hls
+#endif
+      ENDIF
+      
    END SUBROUTINE ROUTINE_LOC
 
@@ -109 +128 @@
 #undef PRECISION
 #undef ARRAY_TYPE
-#undef MASK_TYPE
 #undef ARRAY_IN
 #undef MASK_IN
 #undef K_SIZE
+#if defined key_mpp_mpi
+#   undef MPI_TYPE
+#endif
 #undef MPI_OPERATION
 #undef LOC_OPERATION