Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
#if defined GLOBSUM_CODE
! ! FUNCTION FUNCTION_GLOBSUM !
# if defined DIM_1d
# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i)
# define ARRAY2_IN(i,j,k) ptab2(i)
# define J_SIZE(ptab) 1
# define K_SIZE(ptab) 1
# define MASK_ARRAY(i,j) 1.
# endif
# if defined DIM_2d
# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j)
# define ARRAY2_IN(i,j,k) ptab2(i,j)
# define J_SIZE(ptab) SIZE(ptab,2)
# define K_SIZE(ptab) 1
# endif
# if defined DIM_3d
# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j,k)
# define ARRAY2_IN(i,j,k) ptab2(i,j,k)
# define J_SIZE(ptab) SIZE(ptab,2)
# define K_SIZE(ptab) SIZE(ptab,3)
# define MASK_ARRAY(i,j) tmask_i(i,j)
# endif
FUNCTION FUNCTION_GLOBSUM( cdname, ptab )
!!----------------------------------------------------------------------
CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine
ARRAY_TYPE(:,:,:) ! array on which operation is applied
REAL(wp) :: FUNCTION_GLOBSUM
!
!!-----------------------------------------------------------------------
!
REAL(wp) :: FUNCTION_GLOB_OP ! global sum
!!
COMPLEX(dp):: ctmp
REAL(wp) :: ztmp
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ipi,ipj, ipk ! dimensions
INTEGER :: iis, iie, ijs, ije ! loop start and end
!!-----------------------------------------------------------------------
!
ipi = SIZE(ptab,1) ! 1st dimension
ipj = J_SIZE(ptab) ! 2nd dimension
ipk = K_SIZE(ptab) ! 3rd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! do 2D loop only over the inner domain (-> avoid to use undefined values)
iis = Nis0 ; iie = Nie0
ijs = Njs0 ; ije = Nje0
ELSE
iis = 1 ; iie = jpi
ijs = 1 ; ije = jpj
ENDIF
!
ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
DO jk = 1, ipk
DO jj = ijs, ije
DO ji = iis, iie
ztmp = ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
END DO
END DO
END DO
CALL mpp_sum( cdname, ctmp ) ! sum over the global domain
FUNCTION_GLOBSUM = REAL(ctmp,wp)
END FUNCTION FUNCTION_GLOBSUM
#undef ARRAY_TYPE
#undef ARRAY2_TYPE
#undef ARRAY_IN
#undef ARRAY2_IN
#undef J_SIZE
#undef K_SIZE
#undef MASK_ARRAY
!
# endif
#if defined GLOBMINMAX_CODE
! ! FUNCTION FUNCTION_GLOBMINMAX !
# if defined DIM_2d
# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j)
# define ARRAY2_IN(i,j,k) ptab2(i,j)
# define K_SIZE(ptab) 1
# endif
# if defined DIM_3d
# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j,k)
# define ARRAY2_IN(i,j,k) ptab2(i,j,k)
# define K_SIZE(ptab) SIZE(ptab,3)
# endif
# if defined OPERATION_GLOBMIN
# define SCALAR_OPERATION min
# define ARRAY_OPERATION minval
# define MPP_OPERATION mpp_min
# endif
# if defined OPERATION_GLOBMAX
# define SCALAR_OPERATION max
# define ARRAY_OPERATION maxval
# define MPP_OPERATION mpp_max
# endif
FUNCTION FUNCTION_GLOBMINMAX( cdname, ptab )
!!----------------------------------------------------------------------
CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine
ARRAY_TYPE(:,:,:) ! array on which operation is applied
REAL(wp) :: FUNCTION_GLOBMINMAX
!
!!-----------------------------------------------------------------------
!
REAL(wp) :: FUNCTION_GLOB_OP ! global sum
!!
COMPLEX(dp):: ctmp
REAL(wp) :: ztmp
INTEGER :: jk ! dummy loop indices
INTEGER :: ipk ! dimensions
!!-----------------------------------------------------------------------
!
ipk = K_SIZE(ptab) ! 3rd dimension
!
ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1)*tmask_i(:,:) )
DO jk = 2, ipk
ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
ENDDO
CALL MPP_OPERATION( cdname, ztmp)
FUNCTION_GLOBMINMAX = ztmp
END FUNCTION FUNCTION_GLOBMINMAX
#undef ARRAY_TYPE
#undef ARRAY2_TYPE
#undef ARRAY_IN
#undef ARRAY2_IN
#undef K_SIZE
#undef SCALAR_OPERATION
#undef ARRAY_OPERATION
#undef MPP_OPERATION
# endif