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/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/LBC – NEMO

source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/OCE/LBC/mpp_loc_generic.h90 @ 13159

Last change on this file since 13159 was 13159, checked in by gsamson, 4 years ago

merge trunk@r13136 into ASINTER-06 branch; pass all SETTE tests; results identical to trunk@r13136; ticket #2419

File size: 4.0 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      !
35      INTEGER  ::   ierror, ii, idim
36      INTEGER  ::   index0
37      REAL(wp) ::   zmin     ! local minimum
38      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
39      REAL(wp), DIMENSION(2,1) ::   zain, zaout
40      !!-----------------------------------------------------------------------
41      !
42      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
43      !
44      idim = SIZE(kindex)
45      !
46      IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN
47         ! special case for land processors
48         zmin = ERRVAL(zmin)
49         index0 = 0
50      ELSE
51         ALLOCATE ( ilocs(idim) )
52         !
53         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp )
54         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
55         !
56         kindex(1) = mig( ilocs(1) )
57#if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */
58         kindex(2) = mjg( ilocs(2) )
59#endif
60#if defined DIM_3d                      /* avoid warning when kindex has 2 elements */
61         kindex(3) = ilocs(3)
62#endif
63         !
64         DEALLOCATE (ilocs)
65         !
66         index0 = kindex(1)-1   ! 1d index starting at 0
67#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
68         index0 = index0 + jpiglo * (kindex(2)-1)
69#endif
70#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
71         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
72#endif
73      END IF
74      zain(1,:) = zmin
75      zain(2,:) = REAL(index0, wp)
76      !
77      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
78#if defined key_mpp_mpi
79      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)
80#else
81      zaout(:,:) = zain(:,:)
82#endif
83      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
84      !
85      pmin      = zaout(1,1)
86      index0    = NINT( zaout(2,1) )
87#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
88      kindex(3) = index0 / (jpiglo*jpjglo)
89      index0    = index0 - kindex(3) * (jpiglo*jpjglo)
90#endif
91#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
92      kindex(2) = index0 / jpiglo
93      index0 = index0 - kindex(2) * jpiglo
94#endif
95      kindex(1) = index0
96      kindex(:) = kindex(:) + 1   ! start indices at 1
97
98   END SUBROUTINE ROUTINE_LOC
99
100#undef ARRAY_TYPE
101#undef MAX_TYPE
102#undef ARRAY_IN
103#undef MASK_IN
104#undef K_SIZE
105#undef MPI_OPERATION
106#undef LOC_OPERATION
107#undef INDEX_TYPE
108#undef ERRVAL
Note: See TracBrowser for help on using the repository browser.