Changeset 11067 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyice.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/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')
Note: See TracChangeset
for help on using the changeset viewer.