- Timestamp:
- 2018-12-18T12:21:21+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/lib_fortran.F90
r10397 r10408 21 21 USE in_out_manager ! I/O manager 22 22 USE lib_mpp ! distributed memory computing 23 USE lbclnk ! ocean lateral boundary conditions 23 24 24 25 IMPLICIT NONE … … 28 29 PUBLIC glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos) 29 30 PUBLIC local_sum ! used in trcrad, local operation before glob_sum_delay 31 PUBLIC sum3x3 ! used in trcrad, do a sum over 3x3 boxes 30 32 PUBLIC DDPDD ! also used in closea module 31 33 PUBLIC glob_min, glob_max … … 42 44 INTERFACE local_sum 43 45 MODULE PROCEDURE local_sum_2d, local_sum_3d 46 END INTERFACE 47 INTERFACE sum3x3 48 MODULE PROCEDURE sum3x3_2d, sum3x3_3d 44 49 END INTERFACE 45 50 INTERFACE glob_min … … 194 199 END FUNCTION local_sum_3d 195 200 201 ! ! FUNCTION sum3x3 ! 202 203 SUBROUTINE sum3x3_2d( p2d ) 204 !!----------------------------------------------------------------------- 205 !! *** routine sum3x3_2d *** 206 !! 207 !! ** Purpose : sum over 3x3 boxes 208 !!---------------------------------------------------------------------- 209 REAL(wp), DIMENSION (:,:), INTENT(inout) :: p2d 210 ! 211 INTEGER :: ji, ji2, jj, jj2 ! dummy loop indices 212 !!---------------------------------------------------------------------- 213 ! 214 IF( SIZE(p2d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the first dimension is not equal to jpi' ) 215 IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 216 ! 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 220 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box 221 jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box 222 IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain 223 p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2)) 224 ENDIF 225 ENDIF 226 END DO 227 END DO 228 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 229 IF( nbondi /= -1 ) THEN 230 IF( MOD(mig( 1), 3) == 1 ) p2d( 1,:) = p2d( 2,:) 231 IF( MOD(mig( 1), 3) == 2 ) p2d( 2,:) = p2d( 1,:) 232 ENDIF 233 IF( nbondi /= 1 ) THEN 234 IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:) 235 IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:) 236 ENDIF 237 IF( nbondj /= -1 ) THEN 238 IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2) 239 IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1) 240 ENDIF 241 IF( nbondj /= 1 ) THEN 242 IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1) 243 IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj) 244 ENDIF 245 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 246 247 END SUBROUTINE sum3x3_2d 248 249 SUBROUTINE sum3x3_3d( p3d ) 250 !!----------------------------------------------------------------------- 251 !! *** routine sum3x3_3d *** 252 !! 253 !! ** Purpose : sum over 3x3 boxes 254 !!---------------------------------------------------------------------- 255 REAL(wp), DIMENSION (:,:,:), INTENT(inout) :: p3d 256 ! 257 INTEGER :: ji, ji2, jj, jj2, jn ! dummy loop indices 258 INTEGER :: ipn ! Third dimension size 259 !!---------------------------------------------------------------------- 260 ! 261 IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 262 IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 263 ipn = SIZE(p3d,3) 264 ! 265 DO jn = 1, ipn 266 DO jj = 1, jpj 267 DO ji = 1, jpi 268 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 269 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box 270 jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box 271 IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain 272 p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn)) 273 ENDIF 274 ENDIF 275 END DO 276 END DO 277 END DO 278 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. ) 279 IF( nbondi /= -1 ) THEN 280 IF( MOD(mig( 1), 3) == 1 ) p3d( 1,:,:) = p3d( 2,:,:) 281 IF( MOD(mig( 1), 3) == 2 ) p3d( 2,:,:) = p3d( 1,:,:) 282 ENDIF 283 IF( nbondi /= 1 ) THEN 284 IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:) 285 IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:) 286 ENDIF 287 IF( nbondj /= -1 ) THEN 288 IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:) 289 IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:) 290 ENDIF 291 IF( nbondj /= 1 ) THEN 292 IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:) 293 IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:) 294 ENDIF 295 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. ) 296 297 END SUBROUTINE sum3x3_3d 298 196 299 197 300 SUBROUTINE DDPDD( ydda, yddb )
Note: See TracChangeset
for help on using the changeset viewer.