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

Last change on this file since 10425 was 10425, checked in by smasson, 2 years ago

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

File size: 3.8 KB
Line 
1                          !==  IN: ptab is an array  ==!
2#      define ARRAY_TYPE(i,j,k)    REAL(wp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
3#      define MASK_TYPE(i,j,k)     REAL(wp)        , INTENT(in   ) ::   MASK_IN(i,j,k)
4#   if defined DIM_2d
5#      define ARRAY_IN(i,j,k)   ptab(i,j)
6#      define MASK_IN(i,j,k)    pmask(i,j)
7#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2)
8#      define K_SIZE(ptab)      1
9#   endif
10#   if defined DIM_3d
11#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
12#      define MASK_IN(i,j,k)    pmask(i,j,k)
13#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3)
14#      define K_SIZE(ptab)      SIZE(ptab,3)
15#   endif
16#   if defined OPERATION_MAXLOC
17#      define MPI_OPERATION mpi_maxloc
18#      define LOC_OPERATION MAXLOC
19#   endif
20#   if defined OPERATION_MINLOC
21#      define MPI_OPERATION mpi_minloc
22#      define LOC_OPERATION MINLOC
23#   endif
24
25   SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex )
26      !!----------------------------------------------------------------------
27      CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine
28      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied
29      MASK_TYPE(:,:,:)                             ! local mask
30      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab
31      INDEX_TYPE(:)                                ! index of minimum in global frame
32# if defined key_mpp_mpi
33      !
34      INTEGER  ::   ierror, ii, idim
35      INTEGER  ::   index0
36      REAL(wp) ::   zmin     ! local minimum
37      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
38      REAL(wp), DIMENSION(2,1) ::   zain, zaout
39      !!-----------------------------------------------------------------------
40      !
41      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
42      !
43      idim = SIZE(kindex)
44      ALLOCATE ( ilocs(idim) )
45      !
46      ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp )
47      zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
48      !
49      kindex(1) = ilocs(1) + nimpp - 1
50#  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */
51      kindex(2) = ilocs(2) + njmpp - 1
52#  endif
53#  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */
54      kindex(3) = ilocs(3)
55#  endif
56      !
57      DEALLOCATE (ilocs)
58      !
59      index0 = kindex(1)-1   ! 1d index starting at 0
60#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
61      index0 = index0 + jpiglo * (kindex(2)-1)
62#  endif
63#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
64      index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
65#  endif
66      zain(1,:) = zmin
67      zain(2,:) = REAL(index0, wp)
68      !
69      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
70      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)
71      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
72      !
73      pmin      = zaout(1,1)
74      index0    = NINT( zaout(2,1) )
75#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
76      kindex(3) = index0 / (jpiglo*jpjglo)
77      index0    = index0 - kindex(3) * (jpiglo*jpjglo)
78#  endif
79#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
80      kindex(2) = index0 / jpiglo
81      index0 = index0 - kindex(2) * jpiglo
82#  endif
83      kindex(1) = index0
84      kindex(:) = kindex(:) + 1   ! start indices at 1
85#else
86      kindex = 0 ; pmin = 0.
87      WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?'
88#endif
89
90   END SUBROUTINE ROUTINE_LOC
91
92#undef ARRAY_TYPE
93#undef MAX_TYPE
94#undef ARRAY_IN
95#undef MASK_IN
96#undef K_SIZE
97#undef MPI_OPERATION
98#undef LOC_OPERATION
99#undef INDEX_TYPE
Note: See TracBrowser for help on using the repository browser.