- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r4161 r6225 24 24 PRIVATE 25 25 26 PUBLIC glob_sum ! used in many places 27 PUBLIC DDPDD ! also used in closea module 26 PUBLIC glob_sum ! used in many places (masked with tmask_i) 27 PUBLIC glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos) 28 PUBLIC DDPDD ! also used in closea module 28 29 PUBLIC glob_min, glob_max 29 30 #if defined key_nosignedzero … … 34 35 MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, & 35 36 & glob_sum_2d_a, glob_sum_3d_a 37 END INTERFACE 38 INTERFACE glob_sum_full 39 MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d 36 40 END INTERFACE 37 41 INTERFACE glob_min … … 156 160 ! 157 161 END FUNCTION glob_sum_3d_a 162 163 FUNCTION glob_sum_full_2d( ptab ) 164 !!---------------------------------------------------------------------- 165 !! *** FUNCTION glob_sum_full_2d *** 166 !! 167 !! ** Purpose : perform a sum in calling DDPDD routine (nomask) 168 !!---------------------------------------------------------------------- 169 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 170 REAL(wp) :: glob_sum_full_2d ! global sum 171 !! 172 !!----------------------------------------------------------------------- 173 ! 174 glob_sum_full_2d = SUM( ptab(:,:) * tmask_h(:,:) ) 175 IF( lk_mpp ) CALL mpp_sum( glob_sum_full_2d ) 176 ! 177 END FUNCTION glob_sum_full_2d 178 179 FUNCTION glob_sum_full_3d( ptab ) 180 !!---------------------------------------------------------------------- 181 !! *** FUNCTION glob_sum_full_3d *** 182 !! 183 !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine (nomask) 184 !!---------------------------------------------------------------------- 185 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 186 REAL(wp) :: glob_sum_full_3d ! global sum 187 !! 188 INTEGER :: ji, jj, jk ! dummy loop indices 189 INTEGER :: ijpk ! local variables: size of ptab 190 !!----------------------------------------------------------------------- 191 ! 192 ijpk = SIZE(ptab,3) 193 ! 194 glob_sum_full_3d = 0.e0 195 DO jk = 1, ijpk 196 glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) * tmask_h(:,:) ) 197 END DO 198 IF( lk_mpp ) CALL mpp_sum( glob_sum_full_3d ) 199 ! 200 END FUNCTION glob_sum_full_3d 201 158 202 159 203 #else … … 314 358 END FUNCTION glob_sum_3d_a 315 359 360 FUNCTION glob_sum_full_2d( ptab ) 361 !!---------------------------------------------------------------------- 362 !! *** FUNCTION glob_sum_full_2d *** 363 !! 364 !! ** Purpose : perform a sum in calling DDPDD routine 365 !!---------------------------------------------------------------------- 366 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 367 REAL(wp) :: glob_sum_full_2d ! global sum (nomask) 368 !! 369 COMPLEX(wp):: ctmp 370 REAL(wp) :: ztmp 371 INTEGER :: ji, jj ! dummy loop indices 372 !!----------------------------------------------------------------------- 373 ! 374 ztmp = 0.e0 375 ctmp = CMPLX( 0.e0, 0.e0, wp ) 376 DO jj = 1, jpj 377 DO ji =1, jpi 378 ztmp = ptab(ji,jj) * tmask_h(ji,jj) 379 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 380 END DO 381 END DO 382 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 383 glob_sum_full_2d = REAL(ctmp,wp) 384 ! 385 END FUNCTION glob_sum_full_2d 386 387 FUNCTION glob_sum_full_3d( ptab ) 388 !!---------------------------------------------------------------------- 389 !! *** FUNCTION glob_sum_full_3d *** 390 !! 391 !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 392 !!---------------------------------------------------------------------- 393 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 394 REAL(wp) :: glob_sum_full_3d ! global sum (nomask) 395 !! 396 COMPLEX(wp):: ctmp 397 REAL(wp) :: ztmp 398 INTEGER :: ji, jj, jk ! dummy loop indices 399 INTEGER :: ijpk ! local variables: size of ptab 400 !!----------------------------------------------------------------------- 401 ! 402 ijpk = SIZE(ptab,3) 403 ! 404 ztmp = 0.e0 405 ctmp = CMPLX( 0.e0, 0.e0, wp ) 406 DO jk = 1, ijpk 407 DO jj = 1, jpj 408 DO ji =1, jpi 409 ztmp = ptab(ji,jj,jk) * tmask_h(ji,jj) 410 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 411 END DO 412 END DO 413 END DO 414 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 415 glob_sum_full_3d = REAL(ctmp,wp) 416 ! 417 END FUNCTION glob_sum_full_3d 418 419 420 316 421 #endif 317 422
Note: See TracChangeset
for help on using the changeset viewer.