New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11067 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90 – NEMO

Ignore:
Timestamp:
2019-05-29T11:34:32+02:00 (5 years ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : new implementation of lbc_bdy_lnk in prevision of step 2, regroup communications, see #2285

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90

    r11049 r11067  
    4343      ! 
    4444      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      !!---------------------------------------------------------------------- 
    4748      DO ib_bdy=1, nb_bdy 
    4849         ! 
     
    6061      END DO 
    6162      ! 
     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      ! 
    6299   END SUBROUTINE bdy_dyn3d 
    63100 
     
    78115      INTEGER  ::   jb, jk         ! dummy loop indices 
    79116      INTEGER  ::   ii, ij, igrd   ! local integers 
    80       REAL(wp) ::   zwgt           ! boundary weight 
    81117      !!---------------------------------------------------------------------- 
    82118      ! 
     
    98134         END DO 
    99135      END DO 
    100       ! 
    101       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
    102       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 
    103136      ! 
    104137   END SUBROUTINE bdy_dyn3d_spe 
     
    156189      END DO 
    157190      ! 
    158       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
    159       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    160       ! 
    161191   END SUBROUTINE bdy_dyn3d_zgrad 
    162192 
     
    176206      INTEGER  ::   ib, ik         ! dummy loop indices 
    177207      INTEGER  ::   ii, ij, igrd   ! local integers 
    178       REAL(wp) ::   zwgt           ! boundary weight 
    179208      !!---------------------------------------------------------------------- 
    180209      ! 
     
    187216         END DO 
    188217      END DO 
    189  
     218      ! 
    190219      igrd = 3                       ! Everything is at T-points here 
    191220      DO ib = 1, idx%nblenrim(igrd) 
     
    196225         END DO 
    197226      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 updated 
    200227      ! 
    201228   END SUBROUTINE bdy_dyn3d_zro 
     
    241268            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk) 
    242269         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    
    247271      ! 
    248272   END SUBROUTINE bdy_dyn3d_frs 
     
    276300      !   
    277301      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 updated 
    280       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    281302      ! 
    282303   END SUBROUTINE bdy_dyn3d_orlanski 
     
    326347      END DO 
    327348      ! 
    328       CALL lbc_lnk_multi( 'bdydyn3d', ua, 'U', -1.,  va, 'V', -1. )   ! Boundary points should be updated 
    329       ! 
    330349      IF( ln_timing )   CALL timing_stop('bdy_dyn3d_dmp') 
    331350      ! 
     
    346365 
    347366      INTEGER  ::   jb, igrd                               ! dummy loop indices 
     367      LOGICAL, DIMENSION(4) :: lsend2, lrecv2, lsend3, lrecv3  ! indicate how communications are to be carried out 
    348368      !!---------------------------------------------------------------------- 
    349369      ! 
     
    358378      CALL bdy_nmn( idx, igrd, va )   ! va is masked 
    359379      ! 
    360       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
    361       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 
    362       ! 
    363380   END SUBROUTINE bdy_dyn3d_nmn 
    364381 
Note: See TracChangeset for help on using the changeset viewer.