New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
mpp_loc_generic.h90 in NEMO/trunk/src/OCE/LBC – NEMO

source: NEMO/trunk/src/OCE/LBC/mpp_loc_generic.h90 @ 14229

Last change on this file since 14229 was 14229, checked in by smasson, 3 years ago

trunk: replace key_mpp_mpi by the opposite key key_mpi_off

File size: 4.9 KB
Line 
1                          !==  IN: ptab is an array  ==!
2#   if defined SINGLE_PRECISION
3#      define ARRAY_TYPE(i,j,k)    REAL(sp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
4#if ! defined key_mpi_off
5#      define MPI_TYPE MPI_2REAL
6#endif
7#      define PRECISION sp
8#   else
9#      define ARRAY_TYPE(i,j,k)    REAL(dp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
10#if ! defined key_mpi_off
11#      define MPI_TYPE MPI_2DOUBLE_PRECISION
12#endif
13#      define PRECISION dp
14#   endif
15
16#   if defined DIM_2d
17#      define ARRAY_IN(i,j,k)   ptab(i,j)
18#      define MASK_IN(i,j,k)    ldmsk(i,j)
19#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2)
20#      define K_SIZE(ptab)      1
21#   endif
22#   if defined DIM_3d
23#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
24#      define MASK_IN(i,j,k)    ldmsk(i,j,k)
25#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3)
26#      define K_SIZE(ptab)      SIZE(ptab,3)
27#   endif
28#   if defined OPERATION_MAXLOC
29#      define MPI_OPERATION MPI_MAXLOC
30#      define LOC_OPERATION MAXLOC
31#      define ERRVAL -HUGE
32#   endif
33#   if defined OPERATION_MINLOC
34#      define MPI_OPERATION MPI_MINLOC
35#      define LOC_OPERATION MINLOC
36#      define ERRVAL HUGE
37#   endif
38
39   SUBROUTINE ROUTINE_LOC( cdname, ptab, ldmsk, pmin, kindex, ldhalo )
40      !!----------------------------------------------------------------------
41      CHARACTER(len=*), INTENT(in    ) ::   cdname  ! name of the calling subroutine
42      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied
43      LOGICAL          , INTENT(in   ) ::   MASK_IN(:,:,:)                     ! local mask
44      REAL(PRECISION)  , INTENT(  out) ::   pmin    ! Global minimum of ptab
45      INDEX_TYPE(:)                                ! index of minimum in global frame
46      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldhalo  ! If .false. (default) excludes halos in kindex
47      !
48      INTEGER  ::   ierror, ii, idim
49      INTEGER  ::   index0
50      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
51      REAL(PRECISION) ::   zmin     ! local minimum
52      REAL(PRECISION), DIMENSION(2,1) ::   zain, zaout
53      LOGICAL  ::   llhalo
54      !!-----------------------------------------------------------------------
55      !
56      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
57      !
58      IF( PRESENT(ldhalo) ) THEN   ;   llhalo = ldhalo
59      ELSE                         ;   llhalo = .FALSE.
60      ENDIF
61      !
62      idim = SIZE(kindex)
63      !
64      IF ( ANY( MASK_IN(:,:,:) ) ) THEN   ! there is at least 1 valid point...
65         !
66         ALLOCATE ( ilocs(idim) )
67         !
68         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) )
69         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
70         !
71         kindex(1) = mig( ilocs(1) )
72#if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */
73         kindex(2) = mjg( ilocs(2) )
74#endif
75#if defined DIM_3d                      /* avoid warning when kindex has 2 elements */
76         kindex(3) = ilocs(3)
77#endif
78         !
79         DEALLOCATE (ilocs)
80         !
81         index0 = kindex(1)-1   ! 1d index starting at 0
82#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
83         index0 = index0 + jpiglo * (kindex(2)-1)
84#endif
85#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
86         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
87#endif
88      ELSE
89         ! special case for land processors
90         zmin = ERRVAL(zmin)
91         index0 = 0
92      END IF
93      !
94      zain(1,:) = zmin
95      zain(2,:) = REAL(index0, PRECISION)
96      !
97#if ! defined key_mpi_off
98      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
99      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_TYPE, MPI_OPERATION ,MPI_COMM_OCE, ierror)
100      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
101#else
102      zaout(:,:) = zain(:,:)
103#endif
104      !
105      pmin      = zaout(1,1)
106      index0    = NINT( zaout(2,1) )
107#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
108      kindex(3) = index0 / (jpiglo*jpjglo)
109      index0    = index0 - kindex(3) * (jpiglo*jpjglo)
110#endif
111#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
112      kindex(2) = index0 / jpiglo
113      index0 = index0 - kindex(2) * jpiglo
114#endif
115      kindex(1) = index0
116      kindex(:) = kindex(:) + 1   ! start indices at 1
117
118      IF( .NOT. llhalo ) THEN
119         kindex(1)  = kindex(1) - nn_hls
120#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
121         kindex(2)  = kindex(2) - nn_hls
122#endif
123      ENDIF
124     
125   END SUBROUTINE ROUTINE_LOC
126
127
128#undef PRECISION
129#undef ARRAY_TYPE
130#undef ARRAY_IN
131#undef MASK_IN
132#undef K_SIZE
133#if ! defined key_mpi_off
134#   undef MPI_TYPE
135#endif
136#undef MPI_OPERATION
137#undef LOC_OPERATION
138#undef INDEX_TYPE
139#undef ERRVAL
Note: See TracBrowser for help on using the repository browser.