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 @ 14219

Last change on this file since 14219 was 14219, checked in by mcastril, 4 years ago

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