Changeset 11831 for NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/BDY/bdydyn3d.F90
- Timestamp:
- 2019-10-29T18:14:49+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/BDY/bdydyn3d.F90
r10529 r11831 42 42 INTEGER, INTENT(in) :: kt ! Main time step counter 43 43 ! 44 INTEGER :: ib_bdy ! loop index 45 !!---------------------------------------------------------------------- 46 ! 47 DO ib_bdy=1, nb_bdy 44 INTEGER :: ib_bdy, ir ! BDY set index, rim index 45 LOGICAL :: llrim0 ! indicate if rim 0 is treated 46 LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3 ! indicate how communications are to be carried out 47 48 !!---------------------------------------------------------------------- 49 llsend2(:) = .false. ; llrecv2(:) = .false. 50 llsend3(:) = .false. ; llrecv3(:) = .false. 51 DO ir = 1, 0, -1 ! treat rim 1 before rim 0 52 IF( ir == 0 ) THEN ; llrim0 = .TRUE. 53 ELSE ; llrim0 = .FALSE. 54 END IF 55 DO ib_bdy=1, nb_bdy 56 ! 57 SELECT CASE( cn_dyn3d(ib_bdy) ) 58 CASE('none') ; CYCLE 59 CASE('frs' ) ! treat the whole boundary at once 60 IF( ir == 0) CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 61 CASE('specified') ! treat the whole rim at once 62 IF( ir == 0) CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 63 CASE('zero') ! treat the whole rim at once 64 IF( ir == 0) CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 65 CASE('orlanski' ) ; CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. ) 66 CASE('orlanski_npo'); CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true. ) 67 CASE('zerograd') ; CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 ) 68 CASE('neumann') ; CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy, llrim0 ) 69 CASE DEFAULT ; CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 70 END SELECT 71 END DO 48 72 ! 49 SELECT CASE( cn_dyn3d(ib_bdy) ) 50 CASE('none') ; CYCLE 51 CASE('frs' ) ; CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 52 CASE('specified') ; CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 53 CASE('zero') ; CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 54 CASE('orlanski' ) ; CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 55 CASE('orlanski_npo'); CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 56 CASE('zerograd') ; CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 57 CASE('neumann') ; CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy ) 58 CASE DEFAULT ; CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 59 END SELECT 60 END DO 73 IF( nn_hls > 1 .AND. ir == 1 ) CYCLE ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 74 IF( nn_hls == 1 ) THEN 75 llsend2(:) = .false. ; llrecv2(:) = .false. 76 llsend3(:) = .false. ; llrecv3(:) = .false. 77 END IF 78 DO ib_bdy=1, nb_bdy 79 SELECT CASE( cn_dyn3d(ib_bdy) ) 80 CASE('orlanski', 'orlanski_npo') 81 llsend2(:) = llsend2(:) .OR. lsend_bdy(ib_bdy,2,:,ir) ! possibly every direction, U points 82 llrecv2(:) = llrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:,ir) ! possibly every direction, U points 83 llsend3(:) = llsend3(:) .OR. lsend_bdy(ib_bdy,3,:,ir) ! possibly every direction, V points 84 llrecv3(:) = llrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:,ir) ! possibly every direction, V points 85 CASE('zerograd') 86 llsend2(3:4) = llsend2(3:4) .OR. lsend_bdyint(ib_bdy,2,3:4,ir) ! north/south, U points 87 llrecv2(3:4) = llrecv2(3:4) .OR. lrecv_bdyint(ib_bdy,2,3:4,ir) ! north/south, U points 88 llsend3(1:2) = llsend3(1:2) .OR. lsend_bdyint(ib_bdy,3,1:2,ir) ! west/east, V points 89 llrecv3(1:2) = llrecv3(1:2) .OR. lrecv_bdyint(ib_bdy,3,1:2,ir) ! west/east, V points 90 CASE('neumann') 91 llsend2(:) = llsend2(:) .OR. lsend_bdyint(ib_bdy,2,:,ir) ! possibly every direction, U points 92 llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(ib_bdy,2,:,ir) ! possibly every direction, U points 93 llsend3(:) = llsend3(:) .OR. lsend_bdyint(ib_bdy,3,:,ir) ! possibly every direction, V points 94 llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(ib_bdy,3,:,ir) ! possibly every direction, V points 95 END SELECT 96 END DO 97 ! 98 IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN ! if need to send/recv in at least one direction 99 CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 100 END IF 101 IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN ! if need to send/recv in at least one direction 102 CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 103 END IF 104 END DO ! ir 61 105 ! 62 106 END SUBROUTINE bdy_dyn3d … … 78 122 INTEGER :: jb, jk ! dummy loop indices 79 123 INTEGER :: ii, ij, igrd ! local integers 80 REAL(wp) :: zwgt ! boundary weight81 124 !!---------------------------------------------------------------------- 82 125 ! … … 98 141 END DO 99 142 END DO 100 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated101 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )102 !103 IF( kt == nit000 ) CLOSE( unit = 102 )104 143 ! 105 144 END SUBROUTINE bdy_dyn3d_spe 106 145 107 146 108 SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy)147 SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt, ib_bdy, llrim0 ) 109 148 !!---------------------------------------------------------------------- 110 149 !! *** SUBROUTINE bdy_dyn3d_zgrad *** … … 114 153 !!---------------------------------------------------------------------- 115 154 INTEGER :: kt 116 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 117 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 118 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 155 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 156 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 157 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 158 LOGICAL, INTENT(in) :: llrim0 ! indicate if rim 0 is treated 119 159 !! 120 160 INTEGER :: jb, jk ! dummy loop indices 121 161 INTEGER :: ii, ij, igrd ! local integers 122 REAL(wp) :: zwgt ! boundary weight123 INTEGER :: fu, fv162 INTEGER :: flagu, flagv ! short cuts 163 INTEGER :: ibeg, iend ! length of rim to be treated (rim 0 or rim 1 or both) 124 164 !!---------------------------------------------------------------------- 125 165 ! 126 166 igrd = 2 ! Copying tangential velocity into bdy points 127 DO jb = 1, idx%nblenrim(igrd) 128 DO jk = 1, jpkm1 129 ii = idx%nbi(jb,igrd) 130 ij = idx%nbj(jb,igrd) 131 fu = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 132 ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 133 &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 134 END DO 167 IF( llrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) 168 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) 169 ENDIF 170 DO jb = ibeg, iend 171 ii = idx%nbi(jb,igrd) 172 ij = idx%nbj(jb,igrd) 173 flagu = NINT(idx%flagu(jb,igrd)) 174 flagv = NINT(idx%flagv(jb,igrd)) 175 ! 176 IF( flagu == 0 ) THEN ! north/south bdy 177 IF( ij+flagv > jpj .OR. ij+flagv < 1 ) CYCLE 178 ! 179 DO jk = 1, jpkm1 180 ua(ii,ij,jk) = ua(ii,ij+flagv,jk) * umask(ii,ij+flagv,jk) 181 END DO 182 ! 183 END IF 135 184 END DO 136 185 ! 137 186 igrd = 3 ! Copying tangential velocity into bdy points 138 DO jb = 1, idx%nblenrim(igrd) 139 DO jk = 1, jpkm1 140 ii = idx%nbi(jb,igrd) 141 ij = idx%nbj(jb,igrd) 142 fv = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 143 va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 144 &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 145 END DO 146 END DO 147 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 148 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 149 ! 150 IF( kt == nit000 ) CLOSE( unit = 102 ) 187 IF( llrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) 188 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) 189 ENDIF 190 DO jb = ibeg, iend 191 ii = idx%nbi(jb,igrd) 192 ij = idx%nbj(jb,igrd) 193 flagu = NINT(idx%flagu(jb,igrd)) 194 flagv = NINT(idx%flagv(jb,igrd)) 195 ! 196 IF( flagv == 0 ) THEN ! west/east bdy 197 IF( ii+flagu > jpi .OR. ii+flagu < 1 ) CYCLE 198 ! 199 DO jk = 1, jpkm1 200 va(ii,ij,jk) = va(ii+flagu,ij,jk) * vmask(ii+flagu,ij,jk) 201 END DO 202 ! 203 END IF 204 END DO 151 205 ! 152 206 END SUBROUTINE bdy_dyn3d_zgrad … … 167 221 INTEGER :: ib, ik ! dummy loop indices 168 222 INTEGER :: ii, ij, igrd ! local integers 169 REAL(wp) :: zwgt ! boundary weight170 223 !!---------------------------------------------------------------------- 171 224 ! … … 178 231 END DO 179 232 END DO 180 233 ! 181 234 igrd = 3 ! Everything is at T-points here 182 235 DO ib = 1, idx%nblenrim(igrd) … … 187 240 END DO 188 241 END DO 189 !190 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1.,ib_bdy ) ! Boundary points should be updated191 !192 IF( kt == nit000 ) CLOSE( unit = 102 )193 242 ! 194 243 END SUBROUTINE bdy_dyn3d_zro … … 234 283 va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk) 235 284 END DO 236 END DO 237 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 238 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 239 ! 240 IF( kt == nit000 ) CLOSE( unit = 102 ) 285 END DO 241 286 ! 242 287 END SUBROUTINE bdy_dyn3d_frs 243 288 244 289 245 SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll _npo )290 SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, llrim0, ll_npo ) 246 291 !!---------------------------------------------------------------------- 247 292 !! *** SUBROUTINE bdy_dyn3d_orlanski *** … … 255 300 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 256 301 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 257 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 258 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 302 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 303 LOGICAL, INTENT(in) :: llrim0 ! indicate if rim 0 is treated 304 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 259 305 260 306 INTEGER :: jb, igrd ! dummy loop indices … … 265 311 igrd = 2 ! Orlanski bc on u-velocity; 266 312 ! 267 CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo )313 CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo, llrim0 ) 268 314 269 315 igrd = 3 ! Orlanski bc on v-velocity 270 316 ! 271 CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 272 ! 273 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 274 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 317 CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo, llrim0 ) 275 318 ! 276 319 END SUBROUTINE bdy_dyn3d_orlanski … … 320 363 END DO 321 364 ! 322 CALL lbc_lnk_multi( 'bdydyn3d', ua, 'U', -1., va, 'V', -1. ) ! Boundary points should be updated323 !324 365 IF( ln_timing ) CALL timing_stop('bdy_dyn3d_dmp') 325 366 ! … … 327 368 328 369 329 SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy )370 SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy, llrim0 ) 330 371 !!---------------------------------------------------------------------- 331 372 !! *** SUBROUTINE bdy_dyn3d_nmn *** … … 336 377 !! 337 378 !!---------------------------------------------------------------------- 338 TYPE(OBC_INDEX), INTENT(in) :: idx! OBC indices339 INTEGER, INTENT(in) :: ib_bdy! BDY set index340 341 INTEGER :: jb, igrd ! dummy loop indices379 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 380 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 381 LOGICAL, INTENT(in) :: llrim0 ! indicate if rim 0 is treated 382 INTEGER :: igrd ! dummy indice 342 383 !!---------------------------------------------------------------------- 343 384 ! … … 346 387 igrd = 2 ! Neumann bc on u-velocity; 347 388 ! 348 CALL bdy_nmn( idx, igrd, ua )389 CALL bdy_nmn( idx, igrd, ua, llrim0 ) ! ua is masked 349 390 350 391 igrd = 3 ! Neumann bc on v-velocity 351 392 ! 352 CALL bdy_nmn( idx, igrd, va ) 353 ! 354 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 355 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 393 CALL bdy_nmn( idx, igrd, va, llrim0 ) ! va is masked 356 394 ! 357 395 END SUBROUTINE bdy_dyn3d_nmn
Note: See TracChangeset
for help on using the changeset viewer.