Changeset 13324
- Timestamp:
- 2020-07-17T21:47:48+02:00 (4 years ago)
- Location:
- NEMO/trunk/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/lib_fortran.F90
r13295 r13324 217 217 IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 218 218 ! 219 DO_2D( 1, 1, 1, 1 ) 220 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 219 ! work over the whole domain (guarantees all internal cells are set when nn_hls=2) 220 ! 221 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 222 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corner of a 3x3 box 221 223 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box 222 224 jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box … … 227 229 END_2D 228 230 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 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.0_wp ) 231 ! no need for 2nd exchange when nn_hls = 2 232 IF( nn_hls /= 2 ) THEN 233 IF( nbondi /= -1 ) THEN 234 IF( MOD(mig( 1), 3) == 1 ) p2d( 1,:) = p2d( 2,:) 235 IF( MOD(mig( 1), 3) == 2 ) p2d( 2,:) = p2d( 1,:) 236 ENDIF 237 IF( nbondi /= 1 ) THEN 238 IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:) 239 IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:) 240 ENDIF 241 IF( nbondj /= -1 ) THEN 242 IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2) 243 IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1) 244 ENDIF 245 IF( nbondj /= 1 ) THEN 246 IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1) 247 IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj) 248 ENDIF 249 CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 250 ENDIF 246 251 247 252 END SUBROUTINE sum3x3_2d … … 264 269 ! 265 270 DO jn = 1, ipn 266 DO_2D( 1, 1, 1, 1 ) 267 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 271 ! 272 ! work over the whole domain (guarantees all internal cells are set when nn_hls=2) 273 ! 274 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 275 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corner of a 3x3 box 268 276 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box 269 277 jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box … … 275 283 END DO 276 284 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 277 IF( nbondi /= -1 ) THEN 278 IF( MOD(mig( 1), 3) == 1 ) p3d( 1,:,:) = p3d( 2,:,:) 279 IF( MOD(mig( 1), 3) == 2 ) p3d( 2,:,:) = p3d( 1,:,:) 280 ENDIF 281 IF( nbondi /= 1 ) THEN 282 IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:) 283 IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:) 284 ENDIF 285 IF( nbondj /= -1 ) THEN 286 IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:) 287 IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:) 288 ENDIF 289 IF( nbondj /= 1 ) THEN 290 IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:) 291 IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:) 292 ENDIF 293 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 285 ! no need for 2nd exchange when nn_hls = 2 286 IF( nn_hls /= 2 ) THEN 287 IF( nbondi /= -1 ) THEN 288 IF( MOD(mig( 1), 3) == 1 ) p3d( 1,:,:) = p3d( 2,:,:) 289 IF( MOD(mig( 1), 3) == 2 ) p3d( 2,:,:) = p3d( 1,:,:) 290 ENDIF 291 IF( nbondi /= 1 ) THEN 292 IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:) 293 IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:) 294 ENDIF 295 IF( nbondj /= -1 ) THEN 296 IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:) 297 IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:) 298 ENDIF 299 IF( nbondj /= 1 ) THEN 300 IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:) 301 IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:) 302 ENDIF 303 CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 304 ENDIF 294 305 295 306 END SUBROUTINE sum3x3_3d -
NEMO/trunk/src/TOP/TRP/trcrad.F90
r13295 r13324 168 168 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,itime) ! save input tr(:,:,:,:,Kbb) for trend computation 169 169 ! 170 DO_3D( 1, 1, 1, 1, 1, jpkm1 )170 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 171 171 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 172 172 !
Note: See TracChangeset
for help on using the changeset viewer.