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

Last change on this file since 10716 was 10716, checked in by mathiot, 22 months ago

missing #undef ERRVAL in r10665 (ticket #2228)

File size: 4.1 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#      define ERRVAL -HUGE
20#   endif
21#   if defined OPERATION_MINLOC
22#      define MPI_OPERATION mpi_minloc
23#      define LOC_OPERATION MINLOC
24#      define ERRVAL HUGE
25#   endif
26
27   SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex )
28      !!----------------------------------------------------------------------
29      CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine
30      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied
31      MASK_TYPE(:,:,:)                             ! local mask
32      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab
33      INDEX_TYPE(:)                                ! index of minimum in global frame
34# if defined key_mpp_mpi
35      !
36      INTEGER  ::   ierror, ii, idim
37      INTEGER  ::   index0
38      REAL(wp) ::   zmin     ! local minimum
39      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
40      REAL(wp), DIMENSION(2,1) ::   zain, zaout
41      !!-----------------------------------------------------------------------
42      !
43      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
44      !
45      idim = SIZE(kindex)
46      !
47      IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN
48         ! special case for land processors
49         zmin = ERRVAL(zmin)
50         index0 = 0
51      ELSE
52         ALLOCATE ( ilocs(idim) )
53         !
54         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp )
55         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
56         !
57         kindex(1) = mig( ilocs(1) )
58#  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */
59         kindex(2) = mjg( ilocs(2) )
60#  endif
61#  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */
62         kindex(3) = ilocs(3)
63#  endif
64         !
65         DEALLOCATE (ilocs)
66         !
67         index0 = kindex(1)-1   ! 1d index starting at 0
68#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
69         index0 = index0 + jpiglo * (kindex(2)-1)
70#  endif
71#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
72         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
73#  endif
74      END IF
75      zain(1,:) = zmin
76      zain(2,:) = REAL(index0, wp)
77      !
78      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
79      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)
80      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
81      !
82      pmin      = zaout(1,1)
83      index0    = NINT( zaout(2,1) )
84#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
85      kindex(3) = index0 / (jpiglo*jpjglo)
86      index0    = index0 - kindex(3) * (jpiglo*jpjglo)
87#  endif
88#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
89      kindex(2) = index0 / jpiglo
90      index0 = index0 - kindex(2) * jpiglo
91#  endif
92      kindex(1) = index0
93      kindex(:) = kindex(:) + 1   ! start indices at 1
94#else
95      kindex = 0 ; pmin = 0.
96      WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?'
97#endif
98
99   END SUBROUTINE ROUTINE_LOC
100
101#undef ARRAY_TYPE
102#undef MAX_TYPE
103#undef ARRAY_IN
104#undef MASK_IN
105#undef K_SIZE
106#undef MPI_OPERATION
107#undef LOC_OPERATION
108#undef INDEX_TYPE
109#undef ERRVAL
Note: See TracBrowser for help on using the repository browser.