Changeset 11195 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/TOP/trcbdy.F90

Timestamp:

2019-06-28T12:59:32+02:00 (5 years ago)

Author:

girrmann

Message:

dev_r10984_HPC-13 : update of trc_bdy following [11191], merge of lbc_lnk and lbc_bdy_lnk in a single lbc_lnk routine, see #2285

File:

• NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/TOP/trcbdy.F90 (modified) (3 diffs)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/TOP/trcbdy.F90

@@ -22 +22 @@
    USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager               ! I/O manager
-   USE bdy_oce, only: idx_bdy       ! ocean open boundary conditions
+   USE bdy_oce                      ! ocean open boundary conditions
 
    IMPLICIT NONE
@@ -49 +49 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc
       REAL(wp), POINTER                 ::  zfac
+      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated
       LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out
       !!----------------------------------------------------------------------
@@ -56 +57 @@
       igrd = 1 
       !
-      DO ib_bdy=1, nb_bdy
-         DO jn = 1, jptra
-            !
-            ztrc => trcdta_bdy(jn,ib_bdy)%trc 
-            zfac => trcdta_bdy(jn,ib_bdy)%rn_fac
-            !
-            SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) )
-            CASE('none'        )   ;   CYCLE
-            CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
-            CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
-            CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) )
-            CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. )
-            CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. )
-            CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' )
+      DO ir = 1, 0, -1   ! treat rim 1 before rim 0
+         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE.
+         ELSE                 ;   llrim0 = .FALSE.
+         END IF
+         DO ib_bdy=1, nb_bdy
+            DO jn = 1, jptra
+               !
+               ztrc => trcdta_bdy(jn,ib_bdy)%trc 
+               zfac => trcdta_bdy(jn,ib_bdy)%rn_fac
+               !
+               SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) )
+               CASE('none'        )   ;   CYCLE
+               CASE('frs'         )   ! treat the whole boundary at once
+                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
+               CASE('specified'   )   ! treat the whole rim      at once
+                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
+               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) )   ! tra masked
+               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. )
+               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. )
+               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' )
+               END SELECT
+               !
+            END DO
+         END DO
+         !
+         llsend1(:) = .false.
+         llrecv1(:) = .false.
+         DO ib_bdy=1, nb_bdy
+            SELECT CASE( TRIM(cn_tra(ib_bdy)) )
+            CASE('neumann')
+               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points
+               llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points
+            CASE('orlanski','orlanski_npo')
+               llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points
+               llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points
             END SELECT
-            !
          END DO
-      END DO
-      !
-      llsend1(:) = .false.
-      llrecv1(:) = .false.
-      DO ib_bdy=1, nb_bdy
-         SELECT CASE( TRIM(cn_tra(ib_bdy)) )
-         CASE('neumann')
-            llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:)   ! possibly every direction, T points
-            llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:)   ! possibly every direction, T points
-         CASE('orlanski','orlanski_npo')
-            llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:)   ! possibly every direction, T points
-            llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:)   ! possibly every direction, T points
-         END SELECT
-      END DO
-      IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
-         CALL lbc_bdy_lnk( 'bdytra', llsend1, llrecv1, tsa, 'T',  1. )
-      END IF
+         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
+            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+         END IF
+         !
+      END DO   ! ir
       !
       IF( ln_timing )   CALL timing_stop('trc_bdy')