1 | MODULE lib_fortran_crs |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE lib_fortran *** |
---|
4 | !! Fortran utilities: includes some low levels fortran functionality |
---|
5 | !!====================================================================== |
---|
6 | !! History : 3.2 ! 2010-05 (M. Dunphy, R. Benshila) Original code |
---|
7 | !! 3.4 ! 2013-06 (C. Rousset) add glob_min, glob_max |
---|
8 | !! + 3d dim. of input is fexible (jpk, jpl...) |
---|
9 | !!---------------------------------------------------------------------- |
---|
10 | |
---|
11 | !!---------------------------------------------------------------------- |
---|
12 | !! glob_sum : generic interface for global masked summation over |
---|
13 | !! the interior domain for 1 or 2 2D or 3D arrays |
---|
14 | !! it works only for T points |
---|
15 | !! SIGN : generic interface for SIGN to overwrite f95 behaviour |
---|
16 | !! of intrinsinc sign function |
---|
17 | !!---------------------------------------------------------------------- |
---|
18 | USE par_oce ! Ocean parameter |
---|
19 | USE lib_mpp ! distributed memory computing |
---|
20 | USE crs |
---|
21 | |
---|
22 | IMPLICIT NONE |
---|
23 | PRIVATE |
---|
24 | |
---|
25 | PUBLIC glob_sum_crs ! used in many places |
---|
26 | |
---|
27 | INTERFACE glob_sum_crs |
---|
28 | MODULE PROCEDURE glob_sum_2d, glob_sum_3d |
---|
29 | END INTERFACE |
---|
30 | |
---|
31 | !!---------------------------------------------------------------------- |
---|
32 | !! NEMO/OPA 3.3 , NEMO Consortium (2010) |
---|
33 | !! $Id: lib_fortran.F90 4161 2013-11-07 10:01:27Z cetlod $ |
---|
34 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
35 | !!---------------------------------------------------------------------- |
---|
36 | CONTAINS |
---|
37 | |
---|
38 | #if ! defined key_mpp_rep |
---|
39 | ! --- SUM --- |
---|
40 | |
---|
41 | FUNCTION glob_sum_2d( ptab ) |
---|
42 | !!----------------------------------------------------------------------- |
---|
43 | !! *** FUNCTION glob_sum_2D *** |
---|
44 | !! |
---|
45 | !! ** Purpose : perform a masked sum on the inner global domain of a 2D array |
---|
46 | !!----------------------------------------------------------------------- |
---|
47 | REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array |
---|
48 | REAL(wp) :: glob_sum_2d ! global masked sum |
---|
49 | !!----------------------------------------------------------------------- |
---|
50 | ! |
---|
51 | glob_sum_2d = SUM( ptab(:,:)*tmask_i_crs(:,:) ) |
---|
52 | IF( lk_mpp ) CALL mpp_sum( glob_sum_2d ) |
---|
53 | ! |
---|
54 | END FUNCTION glob_sum_2d |
---|
55 | |
---|
56 | |
---|
57 | FUNCTION glob_sum_3d( ptab ) |
---|
58 | !!----------------------------------------------------------------------- |
---|
59 | !! *** FUNCTION glob_sum_3D *** |
---|
60 | !! |
---|
61 | !! ** Purpose : perform a masked sum on the inner global domain of a 3D array |
---|
62 | !!----------------------------------------------------------------------- |
---|
63 | REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array |
---|
64 | REAL(wp) :: glob_sum_3d ! global masked sum |
---|
65 | !! |
---|
66 | INTEGER :: jk |
---|
67 | INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab |
---|
68 | !!----------------------------------------------------------------------- |
---|
69 | ! |
---|
70 | ijpk = SIZE(ptab,3) |
---|
71 | ! |
---|
72 | glob_sum_3d = 0.e0 |
---|
73 | DO jk = 1, ijpk |
---|
74 | glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i_crs(:,:) ) |
---|
75 | END DO |
---|
76 | IF( lk_mpp ) CALL mpp_sum( glob_sum_3d ) |
---|
77 | ! |
---|
78 | END FUNCTION glob_sum_3d |
---|
79 | |
---|
80 | #endif |
---|
81 | |
---|
82 | !!====================================================================== |
---|
83 | END MODULE lib_fortran_crs |
---|