Changeset 11067 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90
- Timestamp:
- 2019-05-29T11:34:32+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90
r11049 r11067 43 43 ! 44 44 INTEGER :: ib_bdy ! loop index 45 !!---------------------------------------------------------------------- 46 ! 45 LOGICAL, DIMENSION(4) :: lsend2, lrecv2, lsend3, lrecv3 ! indicate how communications are to be carried out 46 47 !!---------------------------------------------------------------------- 47 48 DO ib_bdy=1, nb_bdy 48 49 ! … … 60 61 END DO 61 62 ! 63 lsend2(:) = .false. 64 lrecv2(:) = .false. 65 lsend3(:) = .false. 66 lrecv3(:) = .false. 67 DO ib_bdy=1, nb_bdy 68 SELECT CASE( cn_dyn3d(ib_bdy) ) 69 CASE('orlanski') 70 lsend2(:) = lsend2(:) .OR. lsend_bdy(ib_bdy,2,:) ! to every bdy neighbour, U points 71 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:) ! from every bdy neighbour, U points 72 lsend3(:) = lsend3(:) .OR. lsend_bdy(ib_bdy,3,:) ! to every bdy neighbour, V points 73 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:) ! from every bdy neighbour, V points 74 CASE('orlanski_npo') 75 lsend2(:) = lsend2(:) .OR. lsend_bdy(ib_bdy,2,:) ! to every bdy neighbour, U points 76 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:) ! from every bdy neighbour, U points 77 lsend3(:) = lsend3(:) .OR. lsend_bdy(ib_bdy,3,:) ! to every bdy neighbour, V points 78 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:) ! from every bdy neighbour, V points 79 CASE('zerograd') 80 lsend2(:) = lsend2(:) .OR. lsend_bdy(ib_bdy,2,:) ! to every bdy neighbour, U points 81 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:) ! from every bdy neighbour, U points 82 lsend3(:) = lsend3(:) .OR. lsend_bdy(ib_bdy,3,:) ! to every bdy neighbour, V points 83 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:) ! from every bdy neighbour, V points 84 CASE('neumann') 85 lsend2(:) = lsend2(:) .OR. lsend_bdy(ib_bdy,2,:) ! to every bdy neighbour, U points 86 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:) ! from every bdy neighbour, U points 87 lsend3(:) = lsend3(:) .OR. lsend_bdy(ib_bdy,3,:) ! to every bdy neighbour, V points 88 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:) ! from every bdy neighbour, V points 89 END SELECT 90 END DO 91 ! 92 IF( ANY(lsend2) .OR. ANY(lrecv2) ) THEN ! if need to send/recv in at least one direction 93 CALL lbc_bdy_lnk( 'bdydyn2d', lsend2, lrecv2, ua, 'U', -1. ) 94 END IF 95 IF( ANY(lsend3) .OR. ANY(lrecv3) ) THEN ! if need to send/recv in at least one direction 96 CALL lbc_bdy_lnk( 'bdydyn2d', lsend3, lrecv3, va, 'V', -1. ) 97 END IF 98 ! 62 99 END SUBROUTINE bdy_dyn3d 63 100 … … 78 115 INTEGER :: jb, jk ! dummy loop indices 79 116 INTEGER :: ii, ij, igrd ! local integers 80 REAL(wp) :: zwgt ! boundary weight81 117 !!---------------------------------------------------------------------- 82 118 ! … … 98 134 END DO 99 135 END DO 100 !101 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated102 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )103 136 ! 104 137 END SUBROUTINE bdy_dyn3d_spe … … 156 189 END DO 157 190 ! 158 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated159 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )160 !161 191 END SUBROUTINE bdy_dyn3d_zgrad 162 192 … … 176 206 INTEGER :: ib, ik ! dummy loop indices 177 207 INTEGER :: ii, ij, igrd ! local integers 178 REAL(wp) :: zwgt ! boundary weight179 208 !!---------------------------------------------------------------------- 180 209 ! … … 187 216 END DO 188 217 END DO 189 218 ! 190 219 igrd = 3 ! Everything is at T-points here 191 220 DO ib = 1, idx%nblenrim(igrd) … … 196 225 END DO 197 226 END DO 198 !199 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1.,ib_bdy ) ! Boundary points should be updated200 227 ! 201 228 END SUBROUTINE bdy_dyn3d_zro … … 241 268 va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk) 242 269 END DO 243 END DO 244 ! 245 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 246 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 270 END DO 247 271 ! 248 272 END SUBROUTINE bdy_dyn3d_frs … … 276 300 ! 277 301 CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 278 !279 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated280 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )281 302 ! 282 303 END SUBROUTINE bdy_dyn3d_orlanski … … 326 347 END DO 327 348 ! 328 CALL lbc_lnk_multi( 'bdydyn3d', ua, 'U', -1., va, 'V', -1. ) ! Boundary points should be updated329 !330 349 IF( ln_timing ) CALL timing_stop('bdy_dyn3d_dmp') 331 350 ! … … 346 365 347 366 INTEGER :: jb, igrd ! dummy loop indices 367 LOGICAL, DIMENSION(4) :: lsend2, lrecv2, lsend3, lrecv3 ! indicate how communications are to be carried out 348 368 !!---------------------------------------------------------------------- 349 369 ! … … 358 378 CALL bdy_nmn( idx, igrd, va ) ! va is masked 359 379 ! 360 CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy ) ! Boundary points should be updated361 CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )362 !363 380 END SUBROUTINE bdy_dyn3d_nmn 364 381
Note: See TracChangeset
for help on using the changeset viewer.