source: NEMO/branches/2019/dev_r11879_ENHANCE-05_SimonM-Harmonic_Analysis/src/OCE/lib_fortran_generic.h90 @ 12097

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

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

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      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
53   
54      DO jk = 1, ipk
55        DO jj = 1, ipj
56          DO ji = 1, ipi
57             ztmp =  ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
58             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
59          END DO
60        END DO
61      END DO
62      CALL mpp_sum( cdname, ctmp )   ! sum over the global domain
63      FUNCTION_GLOBSUM = REAL(ctmp,wp)
64
65   END FUNCTION FUNCTION_GLOBSUM
66
67#undef ARRAY_TYPE
68#undef ARRAY2_TYPE
69#undef ARRAY_IN
70#undef ARRAY2_IN
71#undef J_SIZE
72#undef K_SIZE
73#undef MASK_ARRAY
74!
75# endif
76#if defined GLOBMINMAX_CODE
77!                          ! FUNCTION FUNCTION_GLOBMINMAX !
78#   if defined DIM_2d
79#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
80#      define ARRAY_IN(i,j,k)   ptab(i,j)
81#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
82#      define K_SIZE(ptab)      1
83#   endif
84#   if defined DIM_3d
85#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
86#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
87#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
88#      define K_SIZE(ptab)      SIZE(ptab,3)
89#   endif
90#   if defined OPERATION_GLOBMIN
91#      define SCALAR_OPERATION min
92#      define ARRAY_OPERATION minval
93#      define MPP_OPERATION mpp_min
94#   endif
95#   if defined OPERATION_GLOBMAX
96#      define SCALAR_OPERATION max
97#      define ARRAY_OPERATION maxval
98#      define MPP_OPERATION mpp_max
99#   endif
100
101   FUNCTION FUNCTION_GLOBMINMAX( cdname, ptab )
102      !!----------------------------------------------------------------------
103      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
104      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
105      REAL(wp)   ::  FUNCTION_GLOBMINMAX
106      !
107      !!-----------------------------------------------------------------------
108      !
109      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
110      !!
111      COMPLEX(wp)::   ctmp
112      REAL(wp)   ::   ztmp
113      INTEGER    ::   jk       ! dummy loop indices
114      INTEGER    ::   ipk      ! dimensions
115      !!-----------------------------------------------------------------------
116      !
117      ipk = K_SIZE(ptab)   ! 3rd dimension
118      !
119      ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1)*tmask_i(:,:) )
120      DO jk = 2, ipk
121         ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
122      ENDDO
123
124      CALL MPP_OPERATION( cdname, ztmp)
125
126      FUNCTION_GLOBMINMAX = ztmp
127
128
129   END FUNCTION FUNCTION_GLOBMINMAX
130
131#undef ARRAY_TYPE
132#undef ARRAY2_TYPE
133#undef ARRAY_IN
134#undef ARRAY2_IN
135#undef K_SIZE
136#undef SCALAR_OPERATION
137#undef ARRAY_OPERATION
138#undef MPP_OPERATION
139# endif
Note: See TracBrowser for help on using the repository browser.