Changeset 11822 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcbdy.F90

Timestamp:

2019-10-29T11:41:36+01:00 (4 years ago)

Author:

acc

Message:

Branch 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. Sette tested updates to branch to align with trunk changes between 10721 and 11740. Sette tests are passing but results differ from branch before these changes (except for GYRE_PISCES and VORTEX) and branch results already differed from trunk because of algorithmic fixes. Will need more checks to confirm correctness.

File:

• NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcbdy.F90 (modified) (3 diffs)

NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/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
@@ -47 +47 @@
       INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices
       !!
-      INTEGER                           :: ib_bdy ,jn ,igrd ! Loop indeces
+      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices
       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
       !!----------------------------------------------------------------------
       !
@@ -55 +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), tr(:,:,:,jn,Krhs), ztrc*zfac )
-            CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy), tr(:,:,:,jn,Krhs), ztrc*zfac )
-            CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd            , tr(:,:,:,jn,Krhs) )
-            CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. )
-            CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. )
-            CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' )
+      llsend1(:) = .false.  ;   llrecv1(:) = .false.
+      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),                tr(:,:,:,jn,Krhs), ztrc*zfac )
+               CASE('specified'   )   ! treat the whole rim      at once
+                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac )
+               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tr(:,:,:,jn,Krhs) )   ! tra masked
+               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. )
+               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), 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
+         !
+         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0
+         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF
+         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
-            ! Boundary points should be updated
-            CALL lbc_bdy_lnk( 'trcbdy', tr(:,:,:,jn,Krhs), 'T', 1., ib_bdy )
-            !
          END DO
-      END DO
+         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
+            CALL lbc_lnk( 'bdytra', tr(:,:,:,:,Krhs), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+         END IF
+         !
+      END DO   ! ir
       !
       IF( ln_timing )   CALL timing_stop('trc_bdy')
-
+      !
    END SUBROUTINE trc_bdy