 Timestamp:
 20190603T12:23:43+02:00 (21 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/lib_fortran.F90
r10843 r11069 89 89 END FUNCTION glob_sum_1d 90 90 91 FUNCTION glob_sum_c1d(ptab, kdim) 92 INTEGER, INTENT(IN) :: kdim 93 COMPLEX(KIND = wp), INTENT(IN), DIMENSION(kdim) :: ptab 94 REAL(KIND = wp) :: glob_sum_c1d 95 COMPLEX(KIND = wp) :: ctmp 96 INTEGER :: ji 97 98 ctmp = CMPLX(0.E0, 0.E0, wp) 99 100 DO ji = 1, kdim 101 CALL DDPDD(ptab(ji), ctmp) 102 END DO 103 104 IF (lk_mpp) CALL mpp_sum(ctmp) 105 106 glob_sum_c1d = REAL(ctmp, wp) 107 END FUNCTION glob_sum_c1d 108 91 109 FUNCTION glob_sum_2d( ptab ) 92 110 !! … … 101 119 REAL(wp) :: ztmp 102 120 INTEGER :: ji, jj ! dummy loop indices 103 !! 104 ! 105 ztmp = 0.e0 106 ctmp = CMPLX( 0.e0, 0.e0, wp ) 121 COMPLEX(KIND = wp) :: hsum(jpj) 122 !! 123 ! 107 124 DO jj = 1, jpj 125 ctmp = CMPLX( 0.e0, 0.e0, wp ) 108 126 DO ji =1, jpi 109 ztmp = ptab(ji,jj) * tmask_i(ji,jj)110 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )127 ztmp = ptab(ji,jj) * tmask_i(ji,jj) 128 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 111 129 END DO 112 END DO113 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain114 glob_sum_2d = REAL(ctmp,wp)130 hsum(jj) = ctmp 131 END DO 132 glob_sum_2d = glob_sum_c1d(hsum, jpj) 115 133 ! 116 134 END FUNCTION glob_sum_2d … … 130 148 INTEGER :: ji, jj, jk ! dummy loop indices 131 149 INTEGER :: ijpk ! local variables: size of ptab 150 COMPLEX(KIND = wp), allocatable :: hsum(:) 132 151 !! 133 152 ! 134 153 ijpk = SIZE(ptab,3) 135 ! 136 ztmp = 0.e0 137 ctmp = CMPLX( 0.e0, 0.e0, wp ) 154 ALLOCATE(hsum(ijpk)) 155 ! 138 156 DO jk = 1, ijpk 157 ctmp = CMPLX( 0.e0, 0.e0, wp ) 139 158 DO jj = 1, jpj 140 159 DO ji =1, jpi … … 143 162 END DO 144 163 END DO 145 END DO 146 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 147 glob_sum_3d = REAL(ctmp,wp) 164 hsum(jk) = ctmp 165 END DO 166 glob_sum_3d = glob_sum_c1d(hsum, ijpk) 167 DEALLOCATE(hsum) 148 168 ! 149 169 END FUNCTION glob_sum_3d … … 162 182 REAL(wp) :: ztmp 163 183 INTEGER :: ji, jj ! dummy loop indices 164 !! 165 ! 166 ztmp = 0.e0 167 ctmp = CMPLX( 0.e0, 0.e0, wp ) 184 COMPLEX(KIND = wp) :: hsum(jpj) 185 !! 186 ! 168 187 DO jj = 1, jpj 188 ctmp = CMPLX( 0.e0, 0.e0, wp ) 169 189 DO ji =1, jpi 170 ztmp = ptab1(ji,jj) * tmask_i(ji,jj)171 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )172 ztmp = ptab2(ji,jj) * tmask_i(ji,jj)173 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )190 ztmp = ptab1(ji,jj) * tmask_i(ji,jj) 191 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 192 ztmp = ptab2(ji,jj) * tmask_i(ji,jj) 193 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 174 194 END DO 175 END DO176 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain177 glob_sum_2d_a = REAL(ctmp,wp)195 hsum(jj) = ctmp 196 END DO 197 glob_sum_2d_a = glob_sum_c1d(hsum, jpj) 178 198 ! 179 199 END FUNCTION glob_sum_2d_a … … 193 213 INTEGER :: ji, jj, jk ! dummy loop indices 194 214 INTEGER :: ijpk ! local variables: size of ptab 215 COMPLEX(KIND = wp), allocatable :: hsum(:) 195 216 !! 196 217 ! 197 218 ijpk = SIZE(ptab1,3) 198 ! 199 ztmp = 0.e0 200 ctmp = CMPLX( 0.e0, 0.e0, wp ) 219 ALLOCATE(hsum(ijpk)) 220 ! 201 221 DO jk = 1, ijpk 222 ctmp = CMPLX( 0.e0, 0.e0, wp ) 202 223 DO jj = 1, jpj 203 224 DO ji = 1, jpi … … 208 229 END DO 209 230 END DO 210 END DO 211 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 212 glob_sum_3d_a = REAL(ctmp,wp) 231 hsum(jk) = ctmp 232 END DO 233 glob_sum_3d_a = glob_sum_c1d(hsum, ijpk) 234 DEALLOCATE(hsum) 213 235 ! 214 236 END FUNCTION glob_sum_3d_a … … 226 248 REAL(wp) :: ztmp 227 249 INTEGER :: ji, jj ! dummy loop indices 228 !! 229 ! 230 ztmp = 0.e0 231 ctmp = CMPLX( 0.e0, 0.e0, wp ) 250 COMPLEX(KIND = wp) :: hsum(jpj) 251 !! 252 ! 232 253 DO jj = 1, jpj 254 ctmp = CMPLX( 0.e0, 0.e0, wp ) 233 255 DO ji =1, jpi 234 ztmp = ptab(ji,jj) * tmask_h(ji,jj)235 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )256 ztmp = ptab(ji,jj) * tmask_h(ji,jj) 257 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 236 258 END DO 237 END DO238 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain239 glob_sum_full_2d = REAL(ctmp,wp)259 hsum(jj) = ctmp 260 END DO 261 glob_sum_full_2d = glob_sum_c1d(hsum, jpj) 240 262 ! 241 263 END FUNCTION glob_sum_full_2d … … 254 276 INTEGER :: ji, jj, jk ! dummy loop indices 255 277 INTEGER :: ijpk ! local variables: size of ptab 278 COMPLEX(KIND = wp), allocatable :: hsum(:) 256 279 !! 257 280 ! 258 281 ijpk = SIZE(ptab,3) 259 ! 260 ztmp = 0.e0 261 ctmp = CMPLX( 0.e0, 0.e0, wp ) 282 ALLOCATE(hsum(ijpk)) 283 ! 262 284 DO jk = 1, ijpk 285 ctmp = CMPLX( 0.e0, 0.e0, wp ) 263 286 DO jj = 1, jpj 264 287 DO ji =1, jpi … … 267 290 END DO 268 291 END DO 269 END DO 270 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 271 glob_sum_full_3d = REAL(ctmp,wp) 292 hsum(jk) = ctmp 293 END DO 294 glob_sum_full_3d = glob_sum_c1d(hsum, ijpk) 295 DEALLOCATE(hsum) 272 296 ! 273 297 END FUNCTION glob_sum_full_3d
Note: See TracChangeset
for help on using the changeset viewer.