Changeset 11067
- Timestamp:
- 2019-05-29T11:34:32+02:00 (6 years ago)
- Location:
- NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdy_oce.F90
r11024 r11067 139 139 TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET :: dta_bdy !: bdy external data (local process) 140 140 !$AGRIF_END_DO_NOT_TREAT 141 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: lsend_bdy !: mark needed communication for given boundary, grid and direction 142 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: lrecv_bdy !: mark needed communication for given boundary, grid and direction 141 143 !!---------------------------------------------------------------------- 142 144 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90
r11049 r11067 50 50 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pssh 51 51 !! 52 INTEGER :: ib_bdy ! Loop counter 53 52 INTEGER :: ib_bdy ! Loop counter 53 LOGICAL, DIMENSION(4) :: lsend2, lrecv2, lsend3, lrecv3 ! indicate how communications are to be carried out 54 54 55 DO ib_bdy=1, nb_bdy 55 56 56 SELECT CASE( cn_dyn2d(ib_bdy) ) 57 57 CASE('none') … … 71 71 END SELECT 72 72 ENDDO 73 73 ! 74 lsend2(:) = .false. 75 lrecv2(:) = .false. 76 lsend3(:) = .false. 77 lrecv3(:) = .false. 78 DO ib_bdy=1, nb_bdy 79 SELECT CASE( cn_dyn2d(ib_bdy) ) 80 CASE('flather') 81 lsend2(:) = lsend2(:) .OR. lsend_bdy(ib_bdy,2,:) ! to every bdy neighbour, U points 82 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:) ! from every bdy neighbour, U points 83 lsend3(:) = lsend3(:) .OR. lsend_bdy(ib_bdy,3,:) ! to every bdy neighbour, V points 84 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:) ! from every bdy neighbour, V points 85 CASE('orlanski') 86 lsend2(:) = lsend2(:) .OR. lsend_bdy(ib_bdy,2,:) ! to every bdy neighbour, U points 87 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:) ! from every bdy neighbour, U points 88 lsend3(:) = lsend3(:) .OR. lsend_bdy(ib_bdy,3,:) ! to every bdy neighbour, V points 89 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:) ! from every bdy neighbour, V points 90 CASE('orlanski_npo') 91 lsend2(:) = lsend2(:) .OR. lsend_bdy(ib_bdy,2,:) ! to every bdy neighbour, U points 92 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:) ! from every bdy neighbour, U points 93 lsend3(:) = lsend3(:) .OR. lsend_bdy(ib_bdy,3,:) ! to every bdy neighbour, V points 94 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:) ! from every bdy neighbour, V points 95 END SELECT 96 END DO 97 IF( ANY(lsend2) .OR. ANY(lrecv2) ) THEN ! if need to send/recv in at least one direction 98 CALL lbc_bdy_lnk( 'bdydyn2d', lsend2, lrecv2, pua2d, 'U', -1. ) 99 END IF 100 IF( ANY(lsend3) .OR. ANY(lrecv3) ) THEN ! if need to send/recv in at least one direction 101 CALL lbc_bdy_lnk( 'bdydyn2d', lsend3, lrecv3, pva2d, 'V', -1. ) 102 END IF 103 ! 74 104 END SUBROUTINE bdy_dyn2d 75 105 … … 110 140 pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 111 141 END DO 112 CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy )113 CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy) ! Boundary points should be updated114 142 ! 115 143 END SUBROUTINE bdy_dyn2d_frs … … 170 198 END DO 171 199 172 CALL lbc_bdy_lnk( 'bdydyn2d', spgu(:,:), 'T', 1., ib_bdy )173 200 ! 174 201 igrd = 2 ! Flather bc on u-velocity; … … 210 237 pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 211 238 END DO 212 CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated213 CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy ) !214 239 ! 215 240 END SUBROUTINE bdy_dyn2d_fla … … 246 271 CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo ) 247 272 ! 248 CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated249 CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy ) !250 !251 273 END SUBROUTINE bdy_dyn2d_orlanski 252 274 … … 262 284 !! 263 285 INTEGER :: ib_bdy ! bdy index 264 !!---------------------------------------------------------------------- 286 LOGICAL, DIMENSION(4) :: lsend1, lrecv1 ! indicate how communications are to be carried out 287 !!---------------------------------------------------------------------- 288 lsend1(:) = .false. 289 lrecv1(:) = .false. 265 290 DO ib_bdy = 1, nb_bdy 266 291 CALL bdy_nmn( idx_bdy(ib_bdy), 1, zssh ) ! zssh is masked 267 CALL lbc_bdy_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1., ib_bdy ) 268 END DO 292 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 293 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 294 END DO 295 IF( ANY(lsend1) .OR. ANY(lrecv1) ) THEN ! if need to send/recv in at least one direction 296 CALL lbc_bdy_lnk( 'bdydyn2d', lsend1, lrecv1, zssh(:,:,1), 'T', 1. ) 297 END IF 269 298 ! 270 299 END SUBROUTINE bdy_ssh -
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 -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyice.F90
r11049 r11067 55 55 INTEGER, INTENT(in) :: kt ! Main time step counter 56 56 ! 57 INTEGER :: jbdy ! BDY set index 57 INTEGER :: jbdy ! BDY set index 58 LOGICAL, DIMENSION(4) :: lsend1, lrecv1 ! indicate how communications are to be carried out 58 59 !!---------------------------------------------------------------------- 59 60 ! controls … … 73 74 ! 74 75 END DO 76 ! 77 ! Update bdy points 78 lsend1(:) = .false. 79 lrecv1(:) = .false. 80 DO jbdy = 1, nb_bdy 81 IF( cn_ice(jbdy) == 'frs' ) THEN 82 lsend1(:) = lsend1(:) .OR. lsend_bdy(jbdy,1,:) ! to every neighbour, T points 83 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(jbdy,1,:) ! from every neighbour, T points 84 END IF 85 END DO 86 IF( ANY(lsend1) .OR. ANY(lrecv1) ) THEN ! if need to send/recv in at least one direction 87 ! exchange 3d arrays 88 CALL lbc_bdy_lnk_multi( 'bdyice', lsend1, lrecv1, a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1. & 89 & , oa_i, 'T', 1., a_ip, 'T', 1., v_ip, 'T', 1. & 90 & , s_i , 'T', 1., t_su, 'T', 1., v_i , 'T', 1. & 91 & , v_s , 'T', 1., sv_i, 'T', 1. ) 92 ! exchange 4d arrays 93 CALL lbc_bdy_lnk_multi( 'bdyice', lsend1, lrecv1, t_s , 'T', 1., e_s , 'T', 1. ) ! third dimension = 1 94 CALL lbc_bdy_lnk_multi( 'bdyice', lsend1, lrecv1, t_i , 'T', 1., e_i , 'T', 1. ) ! third dimension = 2 95 END IF 75 96 ! 76 97 CALL ice_cor( kt , 0 ) ! -- In case categories are out of bounds, do a remapping … … 139 160 ENDDO 140 161 ENDDO 141 CALL lbc_bdy_lnk( 'bdyice', a_i(:,:,:), 'T', 1., jbdy )142 CALL lbc_bdy_lnk( 'bdyice', h_i(:,:,:), 'T', 1., jbdy )143 CALL lbc_bdy_lnk( 'bdyice', h_s(:,:,:), 'T', 1., jbdy )144 162 145 163 DO jl = 1, jpl … … 260 278 ! 261 279 END DO ! jl 262 263 CALL lbc_bdy_lnk( 'bdyice', a_i (:,:,:) , 'T', 1., jbdy )264 CALL lbc_bdy_lnk( 'bdyice', h_i (:,:,:) , 'T', 1., jbdy )265 CALL lbc_bdy_lnk( 'bdyice', h_s (:,:,:) , 'T', 1., jbdy )266 CALL lbc_bdy_lnk( 'bdyice', oa_i(:,:,:) , 'T', 1., jbdy )267 CALL lbc_bdy_lnk( 'bdyice', a_ip(:,:,:) , 'T', 1., jbdy )268 CALL lbc_bdy_lnk( 'bdyice', v_ip(:,:,:) , 'T', 1., jbdy )269 CALL lbc_bdy_lnk( 'bdyice', s_i (:,:,:) , 'T', 1., jbdy )270 CALL lbc_bdy_lnk( 'bdyice', t_su(:,:,:) , 'T', 1., jbdy )271 CALL lbc_bdy_lnk( 'bdyice', v_i (:,:,:) , 'T', 1., jbdy )272 CALL lbc_bdy_lnk( 'bdyice', v_s (:,:,:) , 'T', 1., jbdy )273 CALL lbc_bdy_lnk( 'bdyice', sv_i(:,:,:) , 'T', 1., jbdy )274 CALL lbc_bdy_lnk( 'bdyice', t_s (:,:,:,:), 'T', 1., jbdy )275 CALL lbc_bdy_lnk( 'bdyice', e_s (:,:,:,:), 'T', 1., jbdy )276 CALL lbc_bdy_lnk( 'bdyice', t_i (:,:,:,:), 'T', 1., jbdy )277 CALL lbc_bdy_lnk( 'bdyice', e_i (:,:,:,:), 'T', 1., jbdy )278 280 ! 279 281 END SUBROUTINE bdy_ice_frs … … 297 299 INTEGER :: jbdy ! BDY set index 298 300 REAL(wp) :: zmsk1, zmsk2, zflag 301 LOGICAL, DIMENSION(4) :: lsend2, lrecv2, lsend3, lrecv3 ! indicate how communications are to be carried out 299 302 !!------------------------------------------------------------------------------ 300 303 IF( ln_timing ) CALL timing_start('bdy_ice_dyn') … … 339 342 ! 340 343 END DO 341 CALL lbc_bdy_lnk( 'bdyice', u_ice(:,:), 'U', -1., jbdy )342 344 ! 343 345 CASE ( 'V' ) … … 371 373 ! 372 374 END DO 373 CALL lbc_bdy_lnk( 'bdyice', v_ice(:,:), 'V', -1., jbdy )374 375 ! 375 376 END SELECT … … 379 380 END SELECT 380 381 ! 381 END DO 382 END DO ! jbdy 383 ! 384 SELECT CASE ( cd_type ) 385 CASE ( 'U' ) 386 lsend2(:) = .false. ; lrecv2(:) = .false. 387 DO jbdy = 1, nb_bdy 388 IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN 389 lsend2(:) = lsend2(:) .OR. lsend_bdy(jbdy,2,:) ! to every bdy neighbour, U points 390 lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(jbdy,2,:) ! from every bdy neighbour, U points 391 END IF 392 END DO 393 IF( ANY(lsend2) .OR. ANY(lrecv2) ) THEN ! if need to send/recv in at least one direction 394 CALL lbc_bdy_lnk( 'bdyice', lsend2, lrecv2, u_ice, 'U', -1. ) 395 END IF 396 CASE ( 'V' ) 397 lsend3(:) = .false. ; lrecv3(:) = .false. 398 DO jbdy = 1, nb_bdy 399 IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN 400 lsend3(:) = lsend3(:) .OR. lsend_bdy(jbdy,3,:) ! to every bdy neighbour, V points 401 lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(jbdy,3,:) ! from every bdy neighbour, V points 402 END IF 403 END DO 404 IF( ANY(lsend3) .OR. ANY(lrecv3) ) THEN ! if need to send/recv in at least one direction 405 CALL lbc_bdy_lnk( 'bdyice', lsend3, lrecv3, v_ice, 'V', -1. ) 406 END IF 407 END SELECT 382 408 ! 383 409 IF( ln_timing ) CALL timing_stop('bdy_ice_dyn') -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyini.F90
r11059 r11067 37 37 INTEGER, PARAMETER :: jp_nseg = 100 ! 38 38 INTEGER, PARAMETER :: nrimmax = 20 ! maximum rimwidth in structured 39 INTEGER :: nde = 1 ! domain extended in the halo to deal with bondaries40 39 ! open boundary data files 41 40 ! Straight open boundary segment parameters: … … 1177 1176 END DO 1178 1177 1178 1179 ALLOCATE( lsend_bdy(nb_bdy,jpbgrd,4), lrecv_bdy(nb_bdy,jpbgrd,4) ) 1180 lsend_bdy(:,:,:) = .false. 1181 lrecv_bdy(:,:,:) = .false. 1182 ! 1183 ! Check which boundaries might need communication 1184 DO igrd = 1, jpbgrd 1185 DO ib_bdy = 1, nb_bdy 1186 IF ( nbondi_bdy (ib_bdy) == 0 ) THEN 1187 lsend_bdy(ib_bdy,igrd,1) = .true. 1188 lsend_bdy(ib_bdy,igrd,2) = .true. 1189 ELSE IF( nbondi_bdy (ib_bdy) == 1 ) THEN 1190 lsend_bdy(ib_bdy,igrd,1) = .true. 1191 ELSE IF( nbondi_bdy (ib_bdy) == -1 ) THEN 1192 lsend_bdy(ib_bdy,igrd,2) = .true. 1193 END IF 1194 IF ( nbondi_bdy_b(ib_bdy) == 0 ) THEN 1195 lrecv_bdy(ib_bdy,igrd,1) = .true. 1196 lrecv_bdy(ib_bdy,igrd,2) = .true. 1197 ELSE IF( nbondi_bdy_b(ib_bdy) == 1 ) THEN 1198 lrecv_bdy(ib_bdy,igrd,1) = .true. 1199 ELSE IF( nbondi_bdy_b(ib_bdy) == -1 ) THEN 1200 lrecv_bdy(ib_bdy,igrd,2) = .true. 1201 END IF 1202 IF( nbondj_bdy (ib_bdy) == 0 ) THEN 1203 lsend_bdy(ib_bdy,igrd,3) = .true. 1204 lsend_bdy(ib_bdy,igrd,4) = .true. 1205 ELSE IF( nbondj_bdy (ib_bdy) == 1 ) THEN 1206 lsend_bdy(ib_bdy,igrd,3) = .true. 1207 ELSE IF( nbondj_bdy (ib_bdy) == -1 ) THEN 1208 lsend_bdy(ib_bdy,igrd,4) = .true. 1209 END IF 1210 IF( nbondj_bdy_b(ib_bdy) == 0 ) THEN 1211 lrecv_bdy(ib_bdy,igrd,3) = .true. 1212 lrecv_bdy(ib_bdy,igrd,4) = .true. 1213 ELSE IF( nbondj_bdy_b(ib_bdy) == 1 ) THEN 1214 lrecv_bdy(ib_bdy,igrd,3) = .true. 1215 ELSE IF( nbondj_bdy_b(ib_bdy) == -1 ) THEN 1216 lrecv_bdy(ib_bdy,igrd,4) = .true. 1217 END IF 1218 END DO 1219 END DO 1179 1220 ! 1180 1221 ! Tidy up -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdytra.F90
r11049 r11067 51 51 INTEGER :: ib_bdy, jn, igrd ! Loop indeces 52 52 TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure 53 LOGICAL, DIMENSION(4) :: lsend1, lrecv1 ! indicate how communications are to be carried out 53 54 !!---------------------------------------------------------------------- 54 55 igrd = 1 … … 71 72 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 72 73 END SELECT 73 ! Boundary points should be updated74 CALL lbc_bdy_lnk( 'bdytra', tsa(:,:,:,jn), 'T', 1., ib_bdy )75 74 ! 76 75 END DO 77 76 END DO 77 ! 78 lsend1(:) = .false. 79 lrecv1(:) = .false. 80 DO ib_bdy=1, nb_bdy 81 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 82 CASE('neumann') 83 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 84 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 85 CASE('orlanski') 86 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 87 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 88 CASE('orlanski_npo') 89 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 90 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 91 CASE('runoff') 92 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 93 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 94 END SELECT 95 END DO 96 IF( ANY(lsend1) .OR. ANY(lrecv1) ) THEN ! if need to send/recv in at least one direction 97 CALL lbc_bdy_lnk( 'bdytra', lsend1, lrecv1, tsa, 'T', 1. ) 98 END IF 78 99 ! 79 100 END SUBROUTINE bdy_tra -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90
r11049 r11067 80 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv 81 81 REAL(wp) :: zweightu, zweightv 82 LOGICAL, DIMENSION(4) :: lsend1, lrecv1 ! indicate how bdy communications are to be carried out 82 83 !!---------------------------------------------------------------------- 83 84 ! … … 134 135 END DO 135 136 END IF 136 CALL lbc_bdy_lnk( 'dynkeg', zhke, 'T', 1., ib_bdy ) ! send 2 and recv jpi, jpj used in the computation of the speed tendencies 137 END DO 137 END DO 138 ! send 2 and recv jpi, jpj used in the computation of the speed tendencies 139 lsend1(:) = .false. 140 lrecv1(:) = .false. 141 DO ib_bdy = 1, nb_bdy 142 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 143 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 144 END DO 145 IF( COUNT(lsend1) > 0 .OR. COUNT(lrecv1) > 0 ) THEN ! if need to send/recv in at least one direction 146 CALL lbc_bdy_lnk( 'bdydyn2d', lsend1, lrecv1, zhke, 'T', 1. ) 147 END IF 138 148 END IF 139 149 ! -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbc_lnk_multi_generic.h90
r10425 r11067 14 14 # define PTR_ptab pt4d 15 15 #endif 16 SUBROUTINE ROUTINE_MULTI( cdname & 17 & , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3 & 18 & , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6 & 19 & , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval) 16 17 #if defined IS_BDY 18 SUBROUTINE ROUTINE_MULTI( cdname, lsend, lrecv & 19 & , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4 & 20 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 21 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 22 & , cd_mpp, pval ) 23 LOGICAL, DIMENSION(4) , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 24 #else 25 SUBROUTINE ROUTINE_MULTI( cdname & 26 & , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4 & 27 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 28 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 29 & , cd_mpp, pval ) 30 #endif 20 31 !!--------------------------------------------------------------------- 21 CHARACTER(len=*) , INTENT(in ) :: 22 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: 23 ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt924 CHARACTER(len=1) , INTENT(in ) :: 25 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna926 REAL(wp) , INTENT(in ) :: 27 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn928 CHARACTER(len=3) , OPTIONAL , INTENT(in ) :: 29 REAL(wp) , OPTIONAL , INTENT(in ) :: 32 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 33 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied 34 ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9 , pt10 , pt11 35 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 36 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 37 REAL(wp) , INTENT(in ) :: psgn1 ! sign used across the north fold 38 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 39 CHARACTER(len=3) , OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 40 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 30 41 !! 31 INTEGER :: kfld ! number of elements that will be attributed32 PTR_TYPE , DIMENSION( 9) :: ptab_ptr ! pointer array33 CHARACTER(len=1) , DIMENSION( 9) :: cdna_ptr ! nature of ptab_ptr grid-points34 REAL(wp) , DIMENSION( 9) :: psgn_ptr ! sign used across the north fold boundary42 INTEGER :: kfld ! number of elements that will be attributed 43 PTR_TYPE , DIMENSION(11) :: ptab_ptr ! pointer array 44 CHARACTER(len=1) , DIMENSION(11) :: cdna_ptr ! nature of ptab_ptr grid-points 45 REAL(wp) , DIMENSION(11) :: psgn_ptr ! sign used across the north fold boundary 35 46 !!--------------------------------------------------------------------- 36 47 ! … … 41 52 ! 42 53 ! ! Look if more arrays are added 43 IF( PRESENT(psgn2) ) CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 44 IF( PRESENT(psgn3) ) CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 45 IF( PRESENT(psgn4) ) CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 46 IF( PRESENT(psgn5) ) CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 47 IF( PRESENT(psgn6) ) CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 48 IF( PRESENT(psgn7) ) CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 49 IF( PRESENT(psgn8) ) CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 50 IF( PRESENT(psgn9) ) CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 54 IF( PRESENT(psgn2 ) ) CALL ROUTINE_LOAD( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 55 IF( PRESENT(psgn3 ) ) CALL ROUTINE_LOAD( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 56 IF( PRESENT(psgn4 ) ) CALL ROUTINE_LOAD( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 57 IF( PRESENT(psgn5 ) ) CALL ROUTINE_LOAD( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 58 IF( PRESENT(psgn6 ) ) CALL ROUTINE_LOAD( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 59 IF( PRESENT(psgn7 ) ) CALL ROUTINE_LOAD( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 60 IF( PRESENT(psgn8 ) ) CALL ROUTINE_LOAD( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 61 IF( PRESENT(psgn9 ) ) CALL ROUTINE_LOAD( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 62 IF( PRESENT(psgn10) ) CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 63 IF( PRESENT(psgn11) ) CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 51 64 ! 52 CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval ) 65 #if defined IS_BDY 66 CALL lbc_bdy_lnk_ptr( cdname, lsend, lrecv, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 67 #else 68 CALL lbc_lnk_ptr ( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval ) 69 #endif 53 70 ! 54 71 END SUBROUTINE ROUTINE_MULTI … … 72 89 ! 73 90 END SUBROUTINE ROUTINE_LOAD 91 74 92 #undef ARRAY_TYPE 75 93 #undef PTR_TYPE -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbclnk.F90
r10425 r11067 38 38 ! 39 39 INTERFACE lbc_bdy_lnk 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 40 MODULE PROCEDURE mpp_lnk_bdy_2d , mpp_lnk_bdy_3d , mpp_lnk_bdy_4d 41 END INTERFACE 42 INTERFACE lbc_bdy_lnk_ptr 43 MODULE PROCEDURE mpp_lnk_bdy_2d_ptr , mpp_lnk_bdy_3d_ptr , mpp_lnk_bdy_4d_ptr 44 END INTERFACE 45 INTERFACE lbc_bdy_lnk_multi 46 MODULE PROCEDURE lbc_lnk_bdy_2d_multi, lbc_lnk_bdy_3d_multi, lbc_lnk_bdy_4d_multi 41 47 END INTERFACE 42 48 ! … … 45 51 END INTERFACE 46 52 47 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 48 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 49 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 50 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 53 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 54 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 55 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 56 PUBLIC lbc_bdy_lnk_multi ! modified ocean lateral BDY boundary conditions 57 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 51 58 52 59 !!---------------------------------------------------------------------- … … 256 263 257 264 # define DIM_2d 265 # define ROUTINE_LOAD load_ptr_2d 258 266 # define ROUTINE_MULTI lbc_lnk_2d_multi 259 # define ROUTINE_LOAD load_ptr_2d 260 # include "lbc_lnk_multi_generic.h90" 261 # undef ROUTINE_MULTI 267 # include "lbc_lnk_multi_generic.h90" 268 # undef ROUTINE_MULTI 269 # undef ROUTINE_LOAD 270 # define IS_BDY 271 # define ROUTINE_LOAD load_ptr_bdy_2d 272 # define ROUTINE_MULTI lbc_lnk_bdy_2d_multi 273 # include "lbc_lnk_multi_generic.h90" 274 # undef ROUTINE_MULTI 275 # undef IS_BDY 262 276 # undef ROUTINE_LOAD 263 277 # undef DIM_2d 264 278 265 266 279 # define DIM_3d 280 # define ROUTINE_LOAD load_ptr_3d 267 281 # define ROUTINE_MULTI lbc_lnk_3d_multi 268 # define ROUTINE_LOAD load_ptr_3d 269 # include "lbc_lnk_multi_generic.h90" 270 # undef ROUTINE_MULTI 282 # include "lbc_lnk_multi_generic.h90" 283 # undef ROUTINE_MULTI 284 # undef ROUTINE_LOAD 285 # define IS_BDY 286 # define ROUTINE_LOAD load_ptr_bdy_3d 287 # define ROUTINE_MULTI lbc_lnk_bdy_3d_multi 288 # include "lbc_lnk_multi_generic.h90" 289 # undef ROUTINE_MULTI 290 # undef IS_BDY 271 291 # undef ROUTINE_LOAD 272 292 # undef DIM_3d 273 293 274 275 294 # define DIM_4d 295 # define ROUTINE_LOAD load_ptr_4d 276 296 # define ROUTINE_MULTI lbc_lnk_4d_multi 277 # define ROUTINE_LOAD load_ptr_4d 278 # include "lbc_lnk_multi_generic.h90" 279 # undef ROUTINE_MULTI 297 # include "lbc_lnk_multi_generic.h90" 298 # undef ROUTINE_MULTI 299 # undef ROUTINE_LOAD 300 # define IS_BDY 301 # define ROUTINE_LOAD load_ptr_bdy_4d 302 # define ROUTINE_MULTI lbc_lnk_bdy_4d_multi 303 # include "lbc_lnk_multi_generic.h90" 304 # undef ROUTINE_MULTI 305 # undef IS_BDY 280 306 # undef ROUTINE_LOAD 281 307 # undef DIM_4d 282 308 309 283 310 !!====================================================================== 284 311 END MODULE lbclnk -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lib_mpp.F90
r10982 r11067 69 69 70 70 ! Interface associated to the mpp_lnk_... routines is defined in lbclnk 71 PUBLIC mpp_lnk_2d , mpp_lnk_3d , mpp_lnk_4d 72 PUBLIC mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr 71 PUBLIC mpp_lnk_2d , mpp_lnk_3d , mpp_lnk_4d 72 PUBLIC mpp_lnk_2d_ptr , mpp_lnk_3d_ptr , mpp_lnk_4d_ptr 73 PUBLIC mpp_lnk_bdy_2d , mpp_lnk_bdy_3d , mpp_lnk_bdy_4d 74 PUBLIC mpp_lnk_bdy_2d_ptr, mpp_lnk_bdy_3d_ptr, mpp_lnk_bdy_4d_ptr 73 75 ! 74 76 !!gm this should be useless … … 87 89 PUBLIC mpp_ini_znl 88 90 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 89 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d90 91 91 92 !! * Interfaces … … 451 452 # include "mpp_bdy_generic.h90" 452 453 # undef ROUTINE_BDY 454 # define MULTI 455 # define ROUTINE_BDY mpp_lnk_bdy_2d_ptr 456 # include "mpp_bdy_generic.h90" 457 # undef ROUTINE_BDY 458 # undef MULTI 453 459 # undef DIM_2d 454 460 ! … … 459 465 # include "mpp_bdy_generic.h90" 460 466 # undef ROUTINE_BDY 467 # define MULTI 468 # define ROUTINE_BDY mpp_lnk_bdy_3d_ptr 469 # include "mpp_bdy_generic.h90" 470 # undef ROUTINE_BDY 471 # undef MULTI 461 472 # undef DIM_3d 462 473 ! … … 467 478 # include "mpp_bdy_generic.h90" 468 479 # undef ROUTINE_BDY 480 # define MULTI 481 # define ROUTINE_BDY mpp_lnk_bdy_4d_ptr 482 # include "mpp_bdy_generic.h90" 483 # undef ROUTINE_BDY 484 # undef MULTI 469 485 # undef DIM_4d 470 486 -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/mpp_bdy_generic.h90
r10629 r11067 1 #if defined MULTI 2 # define NAT_IN(k) cd_nat(k) 3 # define SGN_IN(k) psgn(k) 4 # define F_SIZE(ptab) kfld 5 # define OPT_K(k) ,ipf 6 # if defined DIM_2d 7 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D) , INTENT(inout) :: ptab(f) 8 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 9 # define K_SIZE(ptab) 1 10 # define L_SIZE(ptab) 1 11 # endif 12 # if defined DIM_3d 13 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D) , INTENT(inout) :: ptab(f) 14 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 15 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) 16 # define L_SIZE(ptab) 1 17 # endif 18 # if defined DIM_4d 19 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D) , INTENT(inout) :: ptab(f) 20 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 21 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 22 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) 23 # endif 24 #else 1 25 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 2 26 # define NAT_IN(k) cd_nat 3 27 # define SGN_IN(k) psgn 4 # define IBD_IN(k) kb_bdy5 28 # define F_SIZE(ptab) 1 6 29 # define OPT_K(k) … … 20 43 # define L_SIZE(ptab) SIZE(ptab,4) 21 44 # endif 22 23 SUBROUTINE ROUTINE_BDY( cdname, ptab, cd_nat, psgn , kb_bdy ) 45 #endif 24 46 !!---------------------------------------------------------------------- 25 !! *** routine mpp_lnk_bdy _3d***47 !! *** routine mpp_lnk_bdy *** 26 48 !! 27 49 !! ** Purpose : Message passing management … … 32 54 !! nlci : first dimension of the local subdomain 33 55 !! nlcj : second dimension of the local subdomain 34 !! nbondi_bdy : mark for "east-west local boundary"35 !! nbondj_bdy : mark for "north-south local boundary"36 56 !! noea : number for local neighboring processors 37 57 !! nowe : number for local neighboring processors … … 42 62 !! 43 63 !!---------------------------------------------------------------------- 44 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 64 #if defined MULTI 65 SUBROUTINE ROUTINE_BDY( cdname, lsend, lrecv, ptab, cd_nat, psgn, kfld ) 66 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 67 #else 68 SUBROUTINE ROUTINE_BDY( cdname, lsend, lrecv, ptab, cd_nat, psgn ) 69 #endif 70 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 45 71 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied 46 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points47 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary48 INTEGER , INTENT(in ) :: IBD_IN(:) ! BDY boundary set72 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 73 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 74 LOGICAL, DIMENSION(4) , INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 49 75 ! 50 76 INTEGER :: ji, jj, jk, jl, jh, jf ! dummy loop indices … … 52 78 INTEGER :: imigr, iihom, ijhom ! local integers 53 79 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 54 REAL(wp) :: zland ! local scalar55 80 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 56 ! 57 REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 58 REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 81 LOGICAL :: llsend_we, llsend_ea, llsend_no, llsend_so ! communication send 82 LOGICAL :: llrecv_we, llrecv_ea, llrecv_no, llrecv_so ! communication receive 83 ! 84 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsend_no, zsend_so ! 3d for north-south & south-north send 85 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsend_ea, zsend_we ! 3d for east-west & west-east send 86 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zrecv_no, zrecv_so ! 3d for north-south & south-north receive 87 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zrecv_ea, zrecv_we ! 3d for east-west & west-east receive 59 88 !!---------------------------------------------------------------------- 60 89 ! … … 62 91 ipl = L_SIZE(ptab) ! 4th - 63 92 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 93 llsend_we = lsend(1); llsend_ea = lsend(2); llsend_so = lsend(3); llsend_no = lsend(4); 94 llrecv_we = lrecv(1); llrecv_ea = lrecv(2); llrecv_so = lrecv(3); llrecv_no = lrecv(4); 64 95 ! 65 96 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 66 ! 67 ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2), & 68 & zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) ) 69 70 zland = 0._wp 97 71 98 72 99 ! 1. standard boundary treatment 73 100 ! ------------------------------ 74 ! 101 ! Bdy treatment does not update land points 75 102 DO jf = 1, ipf ! number of arrays to be treated 76 ! 77 ! ! East-West boundaries 78 ! 79 IF( nbondi == 2) THEN ! neither subdomain to the east nor to the west 80 ! !* Cyclic 103 IF( nbondi == 2 ) THEN ! neither subdomain to the east nor to the west 104 ! !* Cyclic East-West boundaries 81 105 IF( l_Iperio ) THEN 82 106 ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf) 83 107 ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN( 2 ,:,:,:,jf) 84 ELSE !* Closed 85 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN( 1 :nn_hls,:,:,:,jf) = zland ! east except F-point 86 ARRAY_IN(nlci-nn_hls+1:jpi ,:,:,:,jf) = zland ! west 87 ENDIF 88 ELSEIF(nbondi == -1) THEN ! subdomain to the east only 89 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(1:nn_hls,:,:,:,jf) = zland ! south except F-point 90 ! 91 ELSEIF(nbondi == 1) THEN ! subdomain to the west only 92 ARRAY_IN(nlci-nn_hls+1:jpi,:,:,:,jf) = zland ! north 93 ENDIF 94 ! ! North-South boundaries 95 ! 108 END IF 109 END IF 96 110 IF( nbondj == 2) THEN ! neither subdomain to the north nor to the south 97 ! !* Cyclic 111 ! !* Cyclic North-South boundaries 98 112 IF( l_Jperio ) THEN 99 113 ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:,jpjm1,:,:,jf) 100 114 ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:, 2 ,:,:,jf) 101 ELSE !* Closed 102 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:, 1 :nn_hls,:,:,jf) = zland ! east except F-point 103 ARRAY_IN(:,nlcj-nn_hls+1:jpj ,:,:,jf) = zland ! west 104 ENDIF 105 ELSEIF(nbondj == -1) THEN ! subdomain to the east only 106 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:,1:nn_hls,:,:,jf) = zland ! south except F-point 107 ! 108 ELSEIF(nbondj == 1) THEN ! subdomain to the west only 109 ARRAY_IN(:,nlcj-nn_hls+1:jpj,:,:,jf) = zland ! north 110 ENDIF 111 ! 115 END IF 116 END IF 112 117 END DO 118 113 119 114 120 ! 2. East and west directions exchange … … 116 122 ! we play with the neigbours AND the row number because of the periodicity 117 123 ! 118 ! 119 DO jf = 1, ipf 120 SELECT CASE ( nbondi_bdy(IBD_IN(jf)) ) ! Read Dirichlet lateral conditions 121 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 122 iihom = nlci-nreci 123 DO jl = 1, ipl 124 DO jk = 1, ipk 125 DO jh = 1, nn_hls 126 zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf) 127 zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf) 128 END DO 129 END DO 130 END DO 131 END SELECT 132 ! 133 ! ! Migrations 134 !!gm imigr = nn_hls * jpj * ipk * ipl * ipf 135 imigr = nn_hls * jpj * ipk * ipl 136 ! 137 IF( ln_timing ) CALL tic_tac(.TRUE.) 138 ! 139 SELECT CASE ( nbondi_bdy(IBD_IN(jf)) ) 140 CASE ( -1 ) 141 CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 ) 142 CASE ( 0 ) 143 CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 ) 144 CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 ) 145 CASE ( 1 ) 146 CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 ) 147 END SELECT 148 ! 149 SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) ) 150 CASE ( -1 ) 151 CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea ) 152 CASE ( 0 ) 153 CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea ) 154 CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe ) 155 CASE ( 1 ) 156 CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe ) 157 END SELECT 158 ! 159 SELECT CASE ( nbondi_bdy(IBD_IN(jf)) ) 160 CASE ( -1 ) 161 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 162 CASE ( 0 ) 163 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 164 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 165 CASE ( 1 ) 166 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 167 END SELECT 168 ! 169 IF( ln_timing ) CALL tic_tac(.FALSE.) 170 ! 171 ! ! Write Dirichlet lateral conditions 124 IF( llsend_we ) ALLOCATE( zsend_we(jpj,nn_hls,ipk,ipl,ipf) ) 125 IF( llsend_ea ) ALLOCATE( zsend_ea(jpj,nn_hls,ipk,ipl,ipf) ) 126 IF( llrecv_we ) ALLOCATE( zrecv_we(jpj,nn_hls,ipk,ipl,ipf) ) 127 IF( llrecv_ea ) ALLOCATE( zrecv_ea(jpj,nn_hls,ipk,ipl,ipf) ) 128 ! 129 ! Load arrays to the east and to the west to be sent 130 IF( llsend_we ) THEN ! Read Dirichlet lateral conditions 131 DO jf = 1, ipf 132 DO jl = 1, ipl 133 DO jk = 1, ipk 134 DO jh = 1, nn_hls 135 zsend_we(:,jh,jk,jl,jf) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf) 136 END DO 137 END DO 138 END DO 139 END DO 140 END IF 141 ! 142 IF( llsend_ea ) THEN ! Read Dirichlet lateral conditions 143 iihom = nlci-nreci 144 DO jf = 1, ipf 145 DO jl = 1, ipl 146 DO jk = 1, ipk 147 DO jh = 1, nn_hls 148 zsend_ea(:,jh,jk,jl,jf) = ARRAY_IN(iihom +jh,:,jk,jl,jf) 149 END DO 150 END DO 151 END DO 152 END DO 153 END IF 154 ! 155 ! Send/receive arrays to the east and to the west 156 imigr = nn_hls * jpj * ipk * ipl * ipf ! Migrations 157 ! 158 IF( ln_timing ) CALL tic_tac(.TRUE.) 159 ! 160 IF( llsend_ea ) CALL mppsend( 2, zsend_ea(1,1,1,1,1), imigr, noea, ml_req1 ) 161 IF( llsend_we ) CALL mppsend( 1, zsend_we(1,1,1,1,1), imigr, nowe, ml_req2 ) 162 ! 163 IF( llrecv_ea ) CALL mpprecv( 1, zrecv_ea(1,1,1,1,1), imigr, noea ) 164 IF( llrecv_we ) CALL mpprecv( 2, zrecv_we(1,1,1,1,1), imigr, nowe ) 165 ! 166 IF( l_isend .AND. llsend_ea ) CALL mpi_wait(ml_req1, ml_stat, ml_err) 167 IF( l_isend .AND. llsend_we ) CALL mpi_wait(ml_req2, ml_stat, ml_err) 168 ! 169 IF( ln_timing ) CALL tic_tac(.FALSE.) 170 ! 171 ! ! Write Dirichlet lateral conditions 172 ! Update with the received arrays 173 IF( llrecv_we ) THEN 174 DO jf = 1, ipf 175 DO jl = 1, ipl 176 DO jk = 1, ipk 177 DO jh = 1, nn_hls 178 ARRAY_IN( jh,:,jk,jl,jf) = zrecv_we(:,jh,jk,jl,jf) 179 END DO 180 END DO 181 END DO 182 END DO 183 END IF 184 ! 185 IF( llrecv_ea ) THEN 172 186 iihom = nlci-nn_hls 173 ! 174 ! 175 SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) ) 176 CASE ( -1 ) 177 DO jl = 1, ipl 178 DO jk = 1, ipk 179 DO jh = 1, nn_hls 180 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 181 END DO 182 END DO 183 END DO 184 CASE ( 0 ) 185 DO jl = 1, ipl 186 DO jk = 1, ipk 187 DO jh = 1, nn_hls 188 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 189 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 190 END DO 191 END DO 192 END DO 193 CASE ( 1 ) 194 DO jl = 1, ipl 195 DO jk = 1, ipk 196 DO jh = 1, nn_hls 197 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 198 END DO 199 END DO 200 END DO 201 END SELECT 202 ! 203 END DO 187 DO jf = 1, ipf 188 DO jl = 1, ipl 189 DO jk = 1, ipk 190 DO jh = 1, nn_hls 191 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zrecv_ea(:,jh,jk,jl,jf) 192 END DO 193 END DO 194 END DO 195 END DO 196 END IF 197 ! 198 ! Clean up 199 IF( llsend_we ) DEALLOCATE( zsend_we ) 200 IF( llsend_ea ) DEALLOCATE( zsend_ea ) 201 IF( llrecv_we ) DEALLOCATE( zrecv_we ) 202 IF( llrecv_ea ) DEALLOCATE( zrecv_ea ) 204 203 205 204 ! 3. north fold treatment … … 220 219 ! always closed : we play only with the neigbours 221 220 ! 222 DO jf = 1, ipf 223 IF( nbondj_bdy(IBD_IN(jf)) /= 2 ) THEN ! Read Dirichlet lateral conditions 224 ijhom = nlcj-nrecj 225 DO jl = 1, ipl 226 DO jk = 1, ipk 227 DO jh = 1, nn_hls 228 zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf) 229 zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf) 230 END DO 231 END DO 232 END DO 233 ENDIF 234 ! 235 ! ! Migrations 236 !!gm imigr = nn_hls * jpi * ipk * ipl * ipf 237 imigr = nn_hls * jpi * ipk * ipl 238 ! 239 IF( ln_timing ) CALL tic_tac(.TRUE.) 240 ! 241 SELECT CASE ( nbondj_bdy(IBD_IN(jf)) ) 242 CASE ( -1 ) 243 CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 ) 244 CASE ( 0 ) 245 CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 ) 246 CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 ) 247 CASE ( 1 ) 248 CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 ) 249 END SELECT 250 ! 251 SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) ) 252 CASE ( -1 ) 253 CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono ) 254 CASE ( 0 ) 255 CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono ) 256 CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso ) 257 CASE ( 1 ) 258 CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso ) 259 END SELECT 260 ! 261 SELECT CASE ( nbondj_bdy(IBD_IN(jf)) ) 262 CASE ( -1 ) 263 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 264 CASE ( 0 ) 265 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 266 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 267 CASE ( 1 ) 268 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 269 END SELECT 270 ! 271 IF( ln_timing ) CALL tic_tac(.FALSE.) 272 ! 273 ! ! Write Dirichlet lateral conditions 221 IF( llsend_so ) ALLOCATE( zsend_so(jpi,nn_hls,ipk,ipl,ipf) ) 222 IF( llsend_no ) ALLOCATE( zsend_no(jpi,nn_hls,ipk,ipl,ipf) ) 223 IF( llrecv_so ) ALLOCATE( zrecv_so(jpi,nn_hls,ipk,ipl,ipf) ) 224 IF( llrecv_no ) ALLOCATE( zrecv_no(jpi,nn_hls,ipk,ipl,ipf) ) 225 ! 226 ! Load arrays to the south and to the north to be sent 227 IF( llsend_so ) THEN ! Read Dirichlet lateral conditions 228 DO jf = 1, ipf 229 DO jl = 1, ipl 230 DO jk = 1, ipk 231 DO jh = 1, nn_hls 232 zsend_so(:,jh,jk,jl,jf) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf) 233 END DO 234 END DO 235 END DO 236 END DO 237 END IF 238 ! 239 IF( llsend_no ) THEN ! Read Dirichlet lateral conditions 240 ijhom = nlcj-nrecj 241 DO jf = 1, ipf 242 DO jl = 1, ipl 243 DO jk = 1, ipk 244 DO jh = 1, nn_hls 245 zsend_no(:,jh,jk,jl,jf) = ARRAY_IN(:,ijhom +jh,jk,jl,jf) 246 END DO 247 END DO 248 END DO 249 END DO 250 END IF 251 ! 252 ! Send/receive arrays to the south and to the north 253 imigr = nn_hls * jpi * ipk * ipl * ipf ! Migrations 254 ! 255 IF( ln_timing ) CALL tic_tac(.TRUE.) 256 ! 257 IF( llsend_no ) CALL mppsend( 4, zsend_no(1,1,1,1,1), imigr, nono, ml_req1 ) 258 IF( llsend_so ) CALL mppsend( 3, zsend_so(1,1,1,1,1), imigr, noso, ml_req2 ) 259 ! 260 IF( llrecv_no ) CALL mpprecv( 3, zrecv_no(1,1,1,1,1), imigr, nono ) 261 IF( llrecv_so ) CALL mpprecv( 4, zrecv_so(1,1,1,1,1), imigr, noso ) 262 ! 263 IF( l_isend .AND. llsend_no ) CALL mpi_wait(ml_req1, ml_stat, ml_err) 264 IF( l_isend .AND. llsend_so ) CALL mpi_wait(ml_req2, ml_stat, ml_err) 265 ! 266 IF( ln_timing ) CALL tic_tac(.FALSE.) 267 ! 268 ! ! Write Dirichlet lateral conditions 269 ! Update with the received arrays 270 IF( llrecv_so ) THEN 271 DO jf = 1, ipf 272 DO jl = 1, ipl 273 DO jk = 1, ipk 274 DO jh = 1, nn_hls 275 ARRAY_IN(:, jh,jk,jl,jf) = zrecv_so(:,jh,jk,jl,jf) 276 END DO 277 END DO 278 END DO 279 END DO 280 END IF 281 IF( llrecv_no ) THEN 274 282 ijhom = nlcj-nn_hls 275 ! 276 SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) ) 277 CASE ( -1 ) 278 DO jl = 1, ipl 279 DO jk = 1, ipk 280 DO jh = 1, nn_hls 281 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 282 END DO 283 END DO 284 END DO 285 CASE ( 0 ) 286 DO jl = 1, ipl 287 DO jk = 1, ipk 288 DO jh = 1, nn_hls 289 ARRAY_IN(:, jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 290 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 291 END DO 292 END DO 293 END DO 294 CASE ( 1 ) 295 DO jl = 1, ipl 296 DO jk = 1, ipk 297 DO jh = 1, nn_hls 298 ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 299 END DO 300 END DO 301 END DO 302 END SELECT 303 END DO 304 ! 305 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 283 DO jf = 1, ipf 284 DO jl = 1, ipl 285 DO jk = 1, ipk 286 DO jh = 1, nn_hls 287 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zrecv_no(:,jh,jk,jl,jf) 288 END DO 289 END DO 290 END DO 291 END DO 292 END IF 293 ! 294 ! Clean up 295 IF( llsend_so ) DEALLOCATE( zsend_so ) 296 IF( llsend_no ) DEALLOCATE( zsend_no ) 297 IF( llrecv_so ) DEALLOCATE( zrecv_so ) 298 IF( llrecv_no ) DEALLOCATE( zrecv_no ) 306 299 ! 307 300 END SUBROUTINE ROUTINE_BDY … … 310 303 #undef NAT_IN 311 304 #undef SGN_IN 312 #undef IBD_IN313 305 #undef ARRAY_IN 314 306 #undef K_SIZE … … 316 308 #undef F_SIZE 317 309 #undef OPT_K 310 -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/TOP/trcbdy.F90
r10425 r11067 49 49 REAL(wp), POINTER, DIMENSION(:,:) :: ztrc 50 50 REAL(wp), POINTER :: zfac 51 LOGICAL, DIMENSION(4) :: lsend1, lrecv1 ! indicate how communications are to be carried out 51 52 !!---------------------------------------------------------------------- 52 53 ! … … 70 71 CASE DEFAULT ; CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 71 72 END SELECT 72 ! Boundary points should be updated73 CALL lbc_bdy_lnk( 'trcbdy', tra(:,:,:,jn), 'T', 1., ib_bdy )74 73 ! 75 74 END DO 76 75 END DO 77 76 ! 77 lsend1(:) = .false. 78 lrecv1(:) = .false. 79 DO ib_bdy=1, nb_bdy 80 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 81 CASE('neumann') 82 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 83 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 84 CASE('orlanski') 85 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 86 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 87 CASE('orlanski_npo') 88 lsend1(:) = lsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! to every bdy neighbour, T points 89 lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! from every bdy neighbour, T points 90 END SELECT 91 END DO 92 IF( ANY(lsend1) .OR. ANY(lrecv1) ) THEN ! if need to send/recv in at least one direction 93 CALL lbc_bdy_lnk( 'bdytra', lsend1, lrecv1, tsa, 'T', 1. ) 94 END IF 95 ! 78 96 IF( ln_timing ) CALL timing_stop('trc_bdy') 79 97 ! 80 98 END SUBROUTINE trc_bdy 81 99
Note: See TracChangeset
for help on using the changeset viewer.