source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/lib_fortran_generic.h90 @ 10314

Last change on this file since 10314 was 10314, checked in by smasson, 23 months ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2: add generic glob_min/max/sum and locmin/max, complete timing and report (including bdy and icb), see #2133

File size: 4.7 KB
Line 
1#if defined GLOBSUM_CODE
2!                          ! FUNCTION FUNCTION_GLOBSUM !
3#   if defined DIM_1d
4#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
5#      define ARRAY_IN(i,j,k)   ptab(i)
6#      define ARRAY2_IN(i,j,k)  ptab2(i)
7#      define J_SIZE(ptab)      1
8#      define K_SIZE(ptab)      1
9#      define MASK_ARRAY(i,j)   1.
10#   endif
11#   if defined DIM_2d
12#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
13#      define ARRAY_IN(i,j,k)   ptab(i,j)
14#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
15#      define J_SIZE(ptab)      SIZE(ptab,2)
16#      define K_SIZE(ptab)      1
17#   endif
18#   if defined DIM_3d
19#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
20#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
21#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
22#      define J_SIZE(ptab)      SIZE(ptab,2)
23#      define K_SIZE(ptab)      SIZE(ptab,3)
24#   endif
25#   if defined OPERATION_GLOBSUM
26#      define MASK_ARRAY(i,j)   tmask_i(i,j)
27#   endif
28#   if defined OPERATION_FULL_GLOBSUM
29#      define MASK_ARRAY(i,j)   tmask_h(i,j)
30#   endif
31
32   FUNCTION FUNCTION_GLOBSUM( cdname, ptab )
33      !!----------------------------------------------------------------------
34      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
35      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
36      REAL(wp)   ::  FUNCTION_GLOBSUM
37      !
38      !!-----------------------------------------------------------------------
39      !
40      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
41      !!
42      COMPLEX(wp)::   ctmp
43      REAL(wp)   ::   ztmp
44      INTEGER    ::   ji, jj, jk   ! dummy loop indices
45      INTEGER    ::   ipi, ipj, ipk    ! dimensions
46      !!-----------------------------------------------------------------------
47      !
48      ipi = SIZE(ptab,1)   ! 1st dimension
49      ipj = J_SIZE(ptab)   ! 2nd dimension
50      ipk = K_SIZE(ptab)   ! 3rd dimension
51      !
52      ztmp = 0.e0
53      ctmp = CMPLX( 0.e0, 0.e0, wp )
54   
55      DO jk = 1, ipk
56        DO jj = 1, ipj
57          DO ji = 1, ipi
58             ztmp =  ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
59             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
60          END DO
61        END DO
62      END DO
63      IF( lk_mpp )   CALL mpp_sum( cdname, ctmp )   ! sum over the global domain
64      FUNCTION_GLOBSUM = REAL(ctmp,wp)
65
66   END FUNCTION FUNCTION_GLOBSUM
67
68#undef ARRAY_TYPE
69#undef ARRAY2_TYPE
70#undef ARRAY_IN
71#undef ARRAY2_IN
72#undef J_SIZE
73#undef K_SIZE
74#undef MASK_ARRAY
75!
76# endif
77#if defined GLOBMINMAX_CODE
78!                          ! FUNCTION FUNCTION_GLOBMINMAX !
79#   if defined DIM_2d
80#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
81#      define ARRAY_IN(i,j,k)   ptab(i,j)
82#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
83#      define K_SIZE(ptab)      1
84#   endif
85#   if defined DIM_3d
86#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
87#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
88#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
89#      define K_SIZE(ptab)      SIZE(ptab,3)
90#   endif
91#   if defined OPERATION_GLOBMIN
92#      define SCALAR_OPERATION min
93#      define ARRAY_OPERATION minval
94#      define MPP_OPERATION mpp_min
95#   endif
96#   if defined OPERATION_GLOBMAX
97#      define SCALAR_OPERATION max
98#      define ARRAY_OPERATION maxval
99#      define MPP_OPERATION mpp_max
100#   endif
101
102   FUNCTION FUNCTION_GLOBMINMAX( cdname, ptab )
103      !!----------------------------------------------------------------------
104      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
105      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
106      REAL(wp)   ::  FUNCTION_GLOBMINMAX
107      !
108      !!-----------------------------------------------------------------------
109      !
110      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
111      !!
112      COMPLEX(wp)::   ctmp
113      REAL(wp)   ::   ztmp
114      INTEGER    ::   jk       ! dummy loop indices
115      INTEGER    ::   ipk      ! dimensions
116      !!-----------------------------------------------------------------------
117      !
118      ipk = K_SIZE(ptab)   ! 3rd dimension
119      !
120      ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1)*tmask_i(:,:) )
121      DO jk = 2, ipk
122         ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
123      ENDDO
124
125      IF( lk_mpp ) CALL MPP_OPERATION( cdname, ztmp)
126
127      FUNCTION_GLOBMINMAX = ztmp
128
129
130   END FUNCTION FUNCTION_GLOBMINMAX
131
132#undef ARRAY_TYPE
133#undef ARRAY2_TYPE
134#undef ARRAY_IN
135#undef ARRAY2_IN
136#undef K_SIZE
137#undef SCALAR_OPERATION
138#undef ARRAY_OPERATION
139#undef MPP_OPERATION
140# endif
Note: See TracBrowser for help on using the repository browser.