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/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/lib_fortran_generic.h90 @ 14286

Last change on this file since 14286 was 14286, checked in by mcastril, 3 years ago

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