- Timestamp:
- 2016-10-25T15:46:01+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r6928 r7087 61 61 CASE('zero') 62 62 CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 63 CASE('zerograd') 64 CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 65 CASE('neumann') 66 CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy ) 63 67 CASE('orlanski') 64 68 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) … … 117 121 118 122 END SUBROUTINE bdy_dyn3d_spe 123 124 SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 125 !!---------------------------------------------------------------------- 126 !! *** SUBROUTINE bdy_dyn3d_zgrad *** 127 !! 128 !! ** Purpose : - Enforce a zero gradient of normal velocity 129 !! 130 !!---------------------------------------------------------------------- 131 INTEGER :: kt 132 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 133 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 134 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 135 !! 136 INTEGER :: jb, jk ! dummy loop indices 137 INTEGER :: ii, ij, igrd ! local integers 138 REAL(wp) :: zwgt ! boundary weight 139 INTEGER :: fu, fv 140 !!---------------------------------------------------------------------- 141 ! 142 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zgrad') 143 ! 144 igrd = 2 ! Copying tangential velocity into bdy points 145 DO jb = 1, idx%nblenrim(igrd) 146 DO jk = 1, jpkm1 147 ii = idx%nbi(jb,igrd) 148 ij = idx%nbj(jb,igrd) 149 fu = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 150 ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 151 &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 152 END DO 153 END DO 154 ! 155 igrd = 3 ! Copying tangential velocity into bdy points 156 DO jb = 1, idx%nblenrim(igrd) 157 DO jk = 1, jpkm1 158 ii = idx%nbi(jb,igrd) 159 ij = idx%nbj(jb,igrd) 160 fv = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 161 va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 162 &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 163 END DO 164 END DO 165 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 166 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 167 ! 168 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 169 170 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zgrad') 171 172 END SUBROUTINE bdy_dyn3d_zgrad 119 173 120 174 SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) … … 303 357 END SUBROUTINE bdy_dyn3d_dmp 304 358 359 SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 360 !!---------------------------------------------------------------------- 361 !! *** SUBROUTINE bdy_dyn3d_nmn *** 362 !! 363 !! - Apply Neumann condition to baroclinic velocities. 364 !! - Wrapper routine for bdy_nmn 365 !! 366 !! 367 !!---------------------------------------------------------------------- 368 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 369 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 370 371 INTEGER :: jb, igrd ! dummy loop indices 372 !!---------------------------------------------------------------------- 373 374 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_nmn') 375 ! 376 !! Note that at this stage the ub and ua arrays contain the baroclinic velocities. 377 ! 378 igrd = 2 ! Neumann bc on u-velocity; 379 ! 380 CALL bdy_nmn( idx, igrd, ua ) 381 382 igrd = 3 ! Neumann bc on v-velocity 383 ! 384 CALL bdy_nmn( idx, igrd, va ) 385 ! 386 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 387 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 388 ! 389 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_nmn') 390 ! 391 END SUBROUTINE bdy_dyn3d_nmn 392 393 305 394 #else 306 395 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.