- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r6807 r6808 29 29 PUBLIC bdy_dyn3d_dmp ! routine called by step 30 30 31 !! * Substitutions32 # include "domzgr_substitute.h90"33 31 !!---------------------------------------------------------------------- 34 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 45 43 !! 46 44 !!---------------------------------------------------------------------- 47 INTEGER, INTENT( in ) :: kt! Main time step counter48 ! !49 INTEGER :: ib_bdy! loop index50 !! 51 45 INTEGER, INTENT(in) :: kt ! Main time step counter 46 ! 47 INTEGER :: ib_bdy ! loop index 48 !!---------------------------------------------------------------------- 49 ! 52 50 DO ib_bdy=1, nb_bdy 53 51 ! 54 52 SELECT CASE( cn_dyn3d(ib_bdy) ) 55 CASE('none') 56 CYCLE 57 CASE('frs') 58 CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 59 CASE('specified') 60 CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 61 CASE('zerograd') 62 CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 63 CASE('zero') 64 CALL bdy_dyn3d_zro( 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 ) 67 CASE('orlanski') 68 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 69 CASE('orlanski_npo') 70 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 71 CASE DEFAULT 72 CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 53 CASE('none') ; CYCLE 54 CASE('frs' ) ; CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 55 CASE('specified') ; CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 56 CASE('zero') ; CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 57 CASE('orlanski' ) ; CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 58 CASE('orlanski_npo'); CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 59 CASE('zerograd') ; CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 60 CASE('neumann') ; CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy ) 61 CASE DEFAULT ; CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 73 62 END SELECT 74 END DO75 63 END DO 64 ! 76 65 END SUBROUTINE bdy_dyn3d 66 77 67 78 68 SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy ) … … 82 72 !! ** Purpose : - Apply a specified value for baroclinic velocities 83 73 !! at open boundaries. 74 !! 75 !!---------------------------------------------------------------------- 76 INTEGER , INTENT(in) :: kt ! time step index 77 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 78 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 79 INTEGER , INTENT(in) :: ib_bdy ! BDY set index 80 ! 81 INTEGER :: jb, jk ! dummy loop indices 82 INTEGER :: ii, ij, igrd ! local integers 83 REAL(wp) :: zwgt ! boundary weight 84 !!---------------------------------------------------------------------- 85 ! 86 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_spe') 87 ! 88 igrd = 2 ! Relaxation of zonal velocity 89 DO jb = 1, idx%nblenrim(igrd) 90 DO jk = 1, jpkm1 91 ii = idx%nbi(jb,igrd) 92 ij = idx%nbj(jb,igrd) 93 ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk) 94 END DO 95 END DO 96 ! 97 igrd = 3 ! Relaxation of meridional velocity 98 DO jb = 1, idx%nblenrim(igrd) 99 DO jk = 1, jpkm1 100 ii = idx%nbi(jb,igrd) 101 ij = idx%nbj(jb,igrd) 102 va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 103 END DO 104 END DO 105 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 106 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 107 ! 108 IF( kt == nit000 ) CLOSE( unit = 102 ) 109 ! 110 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe') 111 ! 112 END SUBROUTINE bdy_dyn3d_spe 113 114 SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 115 !!---------------------------------------------------------------------- 116 !! *** SUBROUTINE bdy_dyn3d_zgrad *** 117 !! 118 !! ** Purpose : - Enforce a zero gradient of normal velocity 84 119 !! 85 120 !!---------------------------------------------------------------------- … … 92 127 INTEGER :: ii, ij, igrd ! local integers 93 128 REAL(wp) :: zwgt ! boundary weight 94 !!----------------------------------------------------------------------95 !96 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_spe')97 !98 igrd = 2 ! Relaxation of zonal velocity99 DO jb = 1, idx%nblenrim(igrd)100 DO jk = 1, jpkm1101 ii = idx%nbi(jb,igrd)102 ij = idx%nbj(jb,igrd)103 ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)104 END DO105 END DO106 !107 igrd = 3 ! Relaxation of meridional velocity108 DO jb = 1, idx%nblenrim(igrd)109 DO jk = 1, jpkm1110 ii = idx%nbi(jb,igrd)111 ij = idx%nbj(jb,igrd)112 va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk)113 END DO114 END DO115 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated116 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )117 !118 IF( kt .eq. nit000 ) CLOSE( unit = 102 )119 120 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe')121 122 END SUBROUTINE bdy_dyn3d_spe123 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 velocity129 !!130 !!----------------------------------------------------------------------131 INTEGER :: kt132 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices133 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data134 INTEGER, INTENT(in) :: ib_bdy ! BDY set index135 !!136 INTEGER :: jb, jk ! dummy loop indices137 INTEGER :: ii, ij, igrd ! local integers138 REAL(wp) :: zwgt ! boundary weight139 129 INTEGER :: fu, fv 140 130 !!---------------------------------------------------------------------- … … 179 169 !! 180 170 !!---------------------------------------------------------------------- 181 INTEGER :: kt182 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices183 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data171 INTEGER , INTENT(in) :: kt ! time step index 172 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 173 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 184 174 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 185 ! !175 ! 186 176 INTEGER :: ib, ik ! dummy loop indices 187 INTEGER :: ii, ij, igrd , zcoef! local integers177 INTEGER :: ii, ij, igrd ! local integers 188 178 REAL(wp) :: zwgt ! boundary weight 189 179 !!---------------------------------------------------------------------- … … 211 201 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 212 202 ! 213 IF( kt .eq. nit000 )CLOSE( unit = 102 )214 215 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro')216 203 IF( kt == nit000 ) CLOSE( unit = 102 ) 204 ! 205 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro') 206 ! 217 207 END SUBROUTINE bdy_dyn3d_zro 208 218 209 219 210 SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy ) … … 228 219 !! topography. Tellus, 365-382. 229 220 !!---------------------------------------------------------------------- 230 INTEGER :: kt231 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices232 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data221 INTEGER , INTENT(in) :: kt ! time step index 222 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 223 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 233 224 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 234 ! !225 ! 235 226 INTEGER :: jb, jk ! dummy loop indices 236 227 INTEGER :: ii, ij, igrd ! local integers … … 262 253 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 263 254 ! 264 IF( kt .eq. nit000 )CLOSE( unit = 102 )265 266 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs')267 255 IF( kt == nit000 ) CLOSE( unit = 102 ) 256 ! 257 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs') 258 ! 268 259 END SUBROUTINE bdy_dyn3d_frs 260 269 261 270 262 SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) … … 313 305 !! 314 306 !!---------------------------------------------------------------------- 315 INTEGER :: kt316 ! !307 INTEGER, INTENT(in) :: kt ! time step index 308 ! 317 309 INTEGER :: jb, jk ! dummy loop indices 318 INTEGER :: ii, ij, igrd ! local integers 319 REAL(wp) :: zwgt ! boundary weight 320 INTEGER :: ib_bdy ! loop index 321 !!---------------------------------------------------------------------- 322 ! 323 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 324 ! 325 !------------------------------------------------------- 326 310 INTEGER :: ib_bdy ! loop index 311 INTEGER :: ii, ij, igrd ! local integers 312 REAL(wp) :: zwgt ! boundary weight 313 !!---------------------------------------------------------------------- 314 ! 315 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 316 ! 327 317 DO ib_bdy=1, nb_bdy 328 318 IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN … … 349 339 END DO 350 340 ENDIF 351 END DO341 END DO 352 342 ! 353 343 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 354 344 ! 355 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp')356 345 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp') 346 ! 357 347 END SUBROUTINE bdy_dyn3d_dmp 358 348 … … 399 389 WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt 400 390 END SUBROUTINE bdy_dyn3d 401 402 391 SUBROUTINE bdy_dyn3d_dmp( kt ) ! Empty routine 403 392 WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt 404 393 END SUBROUTINE bdy_dyn3d_dmp 405 406 394 #endif 407 395
Note: See TracChangeset
for help on using the changeset viewer.
