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.
lib_fortran_generic.h90 in NEMO/trunk/src/OCE – NEMO

source: NEMO/trunk/src/OCE/lib_fortran_generic.h90

Last change on this file was 15145, checked in by smasson, 3 years ago

trunk: pass all sette tests in debug with nn_hls = 2
File size: 5.1 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(dp)::   ctmp
43      REAL(wp)   ::   ztmp
44      INTEGER    ::   ji, jj, jk           ! dummy loop indices
45      INTEGER    ::   ipi,ipj, ipk         ! dimensions
46      INTEGER    ::   iis, iie, ijs, ije   ! loop start and end
47      !!-----------------------------------------------------------------------
48      !
49      ipi = SIZE(ptab,1)   ! 1st dimension
50      ipj = J_SIZE(ptab)   ! 2nd dimension
51      ipk = K_SIZE(ptab)   ! 3rd dimension
52      !
53      IF( ipi == jpi .AND. ipj == jpj ) THEN   ! do 2D loop only over the inner domain (-> avoid to use undefined values)
54         iis = Nis0   ;   iie = Nie0
55         ijs = Njs0   ;   ije = Nje0
56      ELSE
57         iis = 1   ;   iie = jpi
58         ijs = 1   ;   ije = jpj
59      ENDIF
60      !
61      ctmp = CMPLX( 0.e0, 0.e0, dp )   ! warning ctmp is cumulated
62      DO jk = 1, ipk
63        DO jj = ijs, ije
64          DO ji = iis, iie
65             ztmp =  ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
66             CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
67          END DO
68        END DO
69      END DO
70      CALL mpp_sum( cdname, ctmp )   ! sum over the global domain
71      FUNCTION_GLOBSUM = REAL(ctmp,wp)
72
73   END FUNCTION FUNCTION_GLOBSUM
74
75#undef ARRAY_TYPE
76#undef ARRAY2_TYPE
77#undef ARRAY_IN
78#undef ARRAY2_IN
79#undef J_SIZE
80#undef K_SIZE
81#undef MASK_ARRAY
82!
83# endif
84#if defined GLOBMINMAX_CODE
85!                          ! FUNCTION FUNCTION_GLOBMINMAX !
86#   if defined DIM_2d
87#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
88#      define ARRAY_IN(i,j,k)   ptab(i,j)
89#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
90#      define K_SIZE(ptab)      1
91#   endif
92#   if defined DIM_3d
93#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
94#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
95#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
96#      define K_SIZE(ptab)      SIZE(ptab,3)
97#   endif
98#   if defined OPERATION_GLOBMIN
99#      define SCALAR_OPERATION min
100#      define ARRAY_OPERATION minval
101#      define MPP_OPERATION mpp_min
102#   endif
103#   if defined OPERATION_GLOBMAX
104#      define SCALAR_OPERATION max
105#      define ARRAY_OPERATION maxval
106#      define MPP_OPERATION mpp_max
107#   endif
108
109   FUNCTION FUNCTION_GLOBMINMAX( cdname, ptab )
110      !!----------------------------------------------------------------------
111      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
112      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
113      REAL(wp)   ::  FUNCTION_GLOBMINMAX
114      !
115      !!-----------------------------------------------------------------------
116      !
117      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
118      !!
119      COMPLEX(dp)::   ctmp
120      REAL(wp)   ::   ztmp
121      INTEGER    ::   jk       ! dummy loop indices
122      INTEGER    ::   ipk      ! dimensions
123      !!-----------------------------------------------------------------------
124      !
125      ipk = K_SIZE(ptab)   ! 3rd dimension
126      !
127      ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1)*tmask_i(:,:) )
128      DO jk = 2, ipk
129         ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
130      ENDDO
131
132      CALL MPP_OPERATION( cdname, ztmp)
133
134      FUNCTION_GLOBMINMAX = ztmp
135
136
137   END FUNCTION FUNCTION_GLOBMINMAX
138
139#undef ARRAY_TYPE
140#undef ARRAY2_TYPE
141#undef ARRAY_IN
142#undef ARRAY2_IN
143#undef K_SIZE
144#undef SCALAR_OPERATION
145#undef ARRAY_OPERATION
146#undef MPP_OPERATION
147# endif
Note: See TracBrowser for help on using the repository browser.