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)

Author:

girrmann

Message:

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

File:

• NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyice.F90 (modified) (8 diffs)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyice.F90

@@ -55 +55 @@
       INTEGER, INTENT(in) ::   kt   ! Main time step counter
       !
-      INTEGER ::   jbdy   ! BDY set index
+      INTEGER ::   jbdy                               ! BDY set index
+      LOGICAL, DIMENSION(4)       :: lsend1, lrecv1   ! indicate how communications are to be carried out
       !!----------------------------------------------------------------------
       ! controls
@@ -73 +74 @@
          !
       END DO
+      !
+      ! Update bdy points
+      lsend1(:) = .false.
+      lrecv1(:) = .false.
+      DO jbdy = 1, nb_bdy
+         IF( cn_ice(jbdy) == 'frs' ) THEN
+            lsend1(:) = lsend1(:) .OR. lsend_bdy(jbdy,1,:)   ! to   every neighbour, T points
+            lrecv1(:) = lrecv1(:) .OR. lrecv_bdy(jbdy,1,:)   ! from every neighbour, T points
+         END IF
+      END DO
+      IF( ANY(lsend1) .OR. ANY(lrecv1) ) THEN   ! if need to send/recv in at least one direction
+         ! exchange 3d arrays
+         CALL lbc_bdy_lnk_multi( 'bdyice', lsend1, lrecv1, a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1. &
+              &                                          , oa_i, 'T', 1., a_ip, 'T', 1., v_ip, 'T', 1. &
+              &                                          , s_i , 'T', 1., t_su, 'T', 1., v_i , 'T', 1. &
+              &                                          , v_s , 'T', 1., sv_i, 'T', 1.                )
+         ! exchange 4d arrays
+         CALL lbc_bdy_lnk_multi( 'bdyice', lsend1, lrecv1, t_s , 'T', 1., e_s , 'T', 1. )   ! third dimension = 1
+         CALL lbc_bdy_lnk_multi( 'bdyice', lsend1, lrecv1, t_i , 'T', 1., e_i , 'T', 1. )   ! third dimension = 2
+      END IF
       !
       CALL ice_cor( kt , 0 )      ! -- In case categories are out of bounds, do a remapping
@@ -139 +160 @@
          ENDDO
       ENDDO
-      CALL lbc_bdy_lnk( 'bdyice', a_i(:,:,:), 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', h_i(:,:,:), 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', h_s(:,:,:), 'T', 1., jbdy )
 
       DO jl = 1, jpl
@@ -260 +278 @@
          !
       END DO ! jl
-
-      CALL lbc_bdy_lnk( 'bdyice', a_i (:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', h_i (:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', h_s (:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', oa_i(:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', a_ip(:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', v_ip(:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', s_i (:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', t_su(:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', v_i (:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', v_s (:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', sv_i(:,:,:)  , 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', t_s (:,:,:,:), 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', e_s (:,:,:,:), 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', t_i (:,:,:,:), 'T', 1., jbdy )
-      CALL lbc_bdy_lnk( 'bdyice', e_i (:,:,:,:), 'T', 1., jbdy )
       !      
    END SUBROUTINE bdy_ice_frs
@@ -297 +299 @@
       INTEGER  ::   jbdy             ! BDY set index
       REAL(wp) ::   zmsk1, zmsk2, zflag
+      LOGICAL, DIMENSION(4) :: lsend2, lrecv2, lsend3, lrecv3  ! indicate how communications are to be carried out
       !!------------------------------------------------------------------------------
       IF( ln_timing )   CALL timing_start('bdy_ice_dyn')
@@ -339 +342 @@
                   !
                END DO
-               CALL lbc_bdy_lnk( 'bdyice', u_ice(:,:), 'U', -1., jbdy )
                !
             CASE ( 'V' )
@@ -371 +373 @@
                   !
                END DO
-               CALL lbc_bdy_lnk( 'bdyice', v_ice(:,:), 'V', -1., jbdy )
                !
             END SELECT
@@ -379 +380 @@
          END SELECT
          !
-      END DO
+      END DO   ! jbdy
+      !
+      SELECT CASE ( cd_type )        
+      CASE ( 'U' ) 
+         lsend2(:) = .false.   ;   lrecv2(:) = .false.
+         DO jbdy = 1, nb_bdy
+            IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN
+               lsend2(:) = lsend2(:) .OR. lsend_bdy(jbdy,2,:)   ! to   every bdy neighbour, U points
+               lrecv2(:) = lrecv2(:) .OR. lrecv_bdy(jbdy,2,:)   ! from every bdy neighbour, U points
+            END IF
+         END DO
+         IF( ANY(lsend2) .OR. ANY(lrecv2) ) THEN   ! if need to send/recv in at least one direction
+            CALL lbc_bdy_lnk( 'bdyice', lsend2, lrecv2, u_ice, 'U', -1. )
+         END IF
+      CASE ( 'V' )
+         lsend3(:) = .false.   ;   lrecv3(:) = .false.
+         DO jbdy = 1, nb_bdy
+            IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN
+               lsend3(:) = lsend3(:) .OR. lsend_bdy(jbdy,3,:)   ! to   every bdy neighbour, V points
+               lrecv3(:) = lrecv3(:) .OR. lrecv_bdy(jbdy,3,:)   ! from every bdy neighbour, V points
+            END IF
+         END DO
+         IF( ANY(lsend3) .OR. ANY(lrecv3) ) THEN   ! if need to send/recv in at least one direction
+            CALL lbc_bdy_lnk( 'bdyice', lsend3, lrecv3, v_ice, 'V', -1. )
+         END IF
+      END SELECT
       !
       IF( ln_timing )   CALL timing_stop('bdy_ice_dyn')