Changeset 15014 for NEMO/trunk/src/OCE
- Timestamp:
- 2021-06-17T19:02:04+02:00 (3 years ago)
- Location:
- NEMO/trunk/src/OCE
- Files:
-
- 8 edited
-
BDY/bdyini.F90 (modified) (5 diffs)
-
DOM/domain.F90 (modified) (1 diff)
-
DOM/dommsk.F90 (modified) (2 diffs)
-
DOM/domqco.F90 (modified) (2 diffs)
-
DOM/domvvl.F90 (modified) (1 diff)
-
DOM/domzgr.F90 (modified) (2 diffs)
-
LDF/ldfc1d_c2d.F90 (modified) (2 diffs)
-
LDF/ldfdyn.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/BDY/bdyini.F90
r14433 r15014 44 44 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn ! 45 45 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs ! 46 47 !! * Substitutions 48 # include "do_loop_substitute.h90" 46 49 !!---------------------------------------------------------------------- 47 50 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 140 143 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 141 144 !!---------------------------------------------------------------------- 145 INTEGER :: ji, jj ! dummy loop indices 142 146 INTEGER :: ib_bdy, ii, ij, igrd, ib, ir, iseg ! dummy loop indices 143 147 INTEGER :: icount, icountr, icountr0, ibr_max ! local integers … … 630 634 ! For the flagu/flagv calculation below we require a version of fmask without 631 635 ! the land boundary condition (shlat) included: 632 DO ij = 1, jpjm1 633 DO ii = 1, jpim1 634 zfmask(ii,ij) = ztmask(ii,ij ) * ztmask(ii+1,ij ) & 635 & * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 636 END DO 637 END DO 636 DO_2D( 0, 0, 0, 0 ) 637 zfmask(ji,jj) = ztmask(ji,jj ) * ztmask(ji+1,jj ) & 638 & * ztmask(ji,jj+1) * ztmask(ji+1,jj+1) 639 END_2D 638 640 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 639 641 … … 646 648 647 649 ! Derive mask on U and V grid from mask on T grid 648 DO ij = 1, jpjm1 649 DO ii = 1, jpim1 650 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1,ij ) 651 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 652 END DO 653 END DO 650 DO_2D( 0, 0, 0, 0 ) 651 bdyumask(ji,jj) = bdytmask(ji,jj) * bdytmask(ji+1,jj ) 652 bdyvmask(ji,jj) = bdytmask(ji,jj) * bdytmask(ji ,jj+1) 653 END_2D 654 654 CALL lbc_lnk( 'bdyini', bdyumask, 'U', 1.0_wp , bdyvmask, 'V', 1.0_wp ) ! Lateral boundary cond. 655 655 … … 687 687 688 688 ! Recompute zfmask 689 DO ij = 1, jpjm1 690 DO ii = 1, jpim1 691 zfmask(ii,ij) = ztmask(ii,ij ) * ztmask(ii+1,ij ) & 692 & * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 693 END DO 694 END DO 689 DO_2D( 0, 0, 0, 0 ) 690 zfmask(ji,jj) = ztmask(ji,jj ) * ztmask(ji+1,jj ) & 691 & * ztmask(ji,jj+1) * ztmask(ji+1,jj+1) 692 END_2D 695 693 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 696 694 -
NEMO/trunk/src/OCE/DOM/domain.F90
r14834 r15014 148 148 END DO 149 149 ! 150 DO jk = 1, jpkm1151 hf_0( 1:jpim1,:) = hf_0(1:jpim1,:) + e3f_0(1:jpim1,:,jk)*vmask(1:jpim1,:,jk)*vmask(2:jpi,:,jk)152 END DO150 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 151 hf_0(ji,jj) = hf_0(ji,jj) + e3f_0(ji,jj,jk)*vmask(ji,jj,jk)*vmask(ji+1,jj,jk) 152 END_3D 153 153 CALL lbc_lnk('domain', hf_0, 'F', 1._wp) 154 154 ! -
NEMO/trunk/src/OCE/DOM/dommsk.F90
r14433 r15014 182 182 ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 183 183 IF( lk_SWE ) THEN ! Shallow Water Eq. case : redefine ssfmask 184 DO_2D( 0, 0, 0,0)184 DO_2D( 0, 0, 0, 0 ) 185 185 ssfmask(ji,jj) = MAX( ssmask(ji,jj+1), ssmask(ji+1,jj+1), & 186 186 & ssmask(ji,jj ), ssmask(ji+1,jj ) ) … … 202 202 ! Lateral boundary conditions on velocity (modify fmask) 203 203 ! --------------------------------------- 204 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition204 IF( rn_shlat /= 0._wp ) THEN ! Not free-slip lateral boundary condition 205 205 ! 206 DO jk = 1, jpk 207 DO_2D( 0, 0, 0, 0 ) 208 IF( fmask(ji,jj,jk) == 0._wp ) THEN 209 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 210 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 211 ENDIF 212 END_2D 213 DO jj = 2, jpjm1 214 IF( fmask(1,jj,jk) == 0._wp ) THEN 215 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 216 ENDIF 217 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 218 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 219 ENDIF 220 END DO 221 DO ji = 2, jpim1 222 IF( fmask(ji,1,jk) == 0._wp ) THEN 223 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 224 ENDIF 225 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 226 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 227 ENDIF 228 END DO 229 END DO 230 ! 206 DO_3D( 0, 0, 0, 0, 1, jpk ) 207 IF( fmask(ji,jj,jk) == 0._wp ) THEN 208 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 209 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 210 ENDIF 211 END_3D 231 212 CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 232 213 ! -
NEMO/trunk/src/OCE/DOM/domqco.F90
r14834 r15014 184 184 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 185 185 186 DO_2D_OVR( nn_hls , nn_hls-1, nn_hls, nn_hls-1 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line186 DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 187 187 ! round brackets added to fix the order of floating point operations 188 188 ! needed to ensure halo 1 - halo 2 compatibility … … 197 197 !!st ELSE !- Flux Form (simple averaging) 198 198 #else 199 DO_2D_OVR( nn_hls , nn_hls-1, nn_hls, nn_hls-1 )199 DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 200 200 ! round brackets added to fix the order of floating point operations 201 201 ! needed to ensure halo 1 - halo 2 compatibility 202 202 pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj ) + pssh(ji+1,jj ) ) & 203 & + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)&203 & + ( pssh(ji,jj+1) + pssh(ji+1,jj+1) & 204 204 & ) & ! bracket for halo 1 - halo 2 compatibility 205 205 & ) * r1_hf_0(ji,jj) -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r14834 r15014 713 713 ! 714 714 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 715 DO_3D( 1, 0, 1, 0, 1, jpk )715 DO_3D( 0, 0, 0, 0, 1, jpk ) 716 716 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 717 717 & * r1_e1e2f(ji,jj) & -
NEMO/trunk/src/OCE/DOM/domzgr.F90
r14433 r15014 340 340 ! ! N.B. top k-index of W-level = mikt 341 341 ! ! bottom k-index of W-level = mbkt+1 342 DO_2D( 1, 0, 1, 0 )342 DO_2D( 0, 0, 0, 0 ) 343 343 miku(ji,jj) = MAX( mikt(ji+1,jj ) , mikt(ji,jj) ) 344 344 mikv(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj) ) … … 349 349 END_2D 350 350 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 351 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 352 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 353 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 354 ! 355 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 356 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 351 DO_2D( 0, 0, 0, 0 ) 352 zk(ji,jj) = REAL( miku(ji,jj), wp ) 353 END_2D 354 CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) 355 miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 356 357 DO_2D( 0, 0, 0, 0 ) 358 zk(ji,jj) = REAL( mikv(ji,jj), wp ) 359 END_2D 360 CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) 361 mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 362 363 DO_2D( 0, 0, 0, 0 ) 364 zk(ji,jj) = REAL( mikf(ji,jj), wp ) 365 END_2D 366 CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) 367 mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 368 ! 369 DO_2D( 0, 0, 0, 0 ) 370 zk(ji,jj) = REAL( mbku(ji,jj), wp ) 371 END_2D 372 CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) 373 mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 374 375 DO_2D( 0, 0, 0, 0 ) 376 zk(ji,jj) = REAL( mbkv(ji,jj), wp ) 377 END_2D 378 CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) 379 mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 357 380 ! 358 381 END SUBROUTINE zgr_top_bot -
NEMO/trunk/src/OCE/LDF/ldfc1d_c2d.F90
r14834 r15014 80 80 pah1(:,:,jk) = pahs1(:,:) * ( zratio + zc * ( 1._wp + TANH( - ( gdept_0(:,:,jk) - zh ) * zw) ) ) 81 81 END DO 82 DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 ) ! pah2 at F-point (zdep2 is an approximation in zps-coord.)82 DO_3DS( 0, 0, 0, 0, jpkm1, 1, -1 ) ! pah2 at F-point (zdep2 is an approximation in zps-coord.) 83 83 zdep2 = ( gdept_0(ji,jj+1,jk) + gdept_0(ji+1,jj+1,jk) & 84 84 & + gdept_0(ji,jj ,jk) + gdept_0(ji+1,jj ,jk) ) * r1_4 … … 88 88 ! 89 89 CASE( 'TRA' ) ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.) 90 DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 )90 DO_3DS( 0, 0, 0, 0, jpkm1, 1, -1 ) 91 91 zdep1 = ( gdept_0(ji,jj,jk) + gdept_0(ji+1,jj,jk) ) * 0.5_wp 92 92 zdep2 = ( gdept_0(ji,jj,jk) + gdept_0(ji,jj+1,jk) ) * 0.5_wp -
NEMO/trunk/src/OCE/LDF/ldfdyn.F90
r14433 r15014 385 385 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 386 386 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) 387 zu2pv2_ij_p1 = uu(ji ,jj+1,jk,Kbb) * uu(ji ,jj+1,jk,Kbb) + vv(ji+1,jj ,jk,Kbb) * vv(ji+1,jj ,jk,Kbb) 387 388 zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 388 389 ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk) ! 288= 12*12 * 2 389 END_2D390 DO_2D( 1, 0, 1, 0 )391 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb)392 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb)393 390 zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 394 391 ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk) ! 288= 12*12 * 2 … … 400 397 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 401 398 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) 399 zu2pv2_ij_p1 = uu(ji ,jj+1,jk,Kbb) * uu(ji ,jj+1,jk,Kbb) + vv(ji+1,jj ,jk,Kbb) * vv(ji+1,jj ,jk,Kbb) 402 400 zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 403 401 ahmt(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax ) * zemax * tmask(ji,jj,jk) 404 END_2D405 DO_2D( 1, 0, 1, 0 )406 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb)407 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb)408 402 zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 409 403 ahmf(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax ) * zemax * fmask(ji,jj,jk) … … 487 481 DO_2D( 0, 0, 0, 0 ) 488 482 ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) ) 489 END_2D490 DO_2D( 1, 0, 1, 0 )491 483 ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) ) 492 484 END_2D
Note: See TracChangeset
for help on using the changeset viewer.
