Changeset 11191 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90

Timestamp:

2019-06-27T10:14:39+02:00 (5 years ago)

Author:

girrmann

Message:

dev_r10984_HPC-13 : bdy treatment can now handel a rim 0 and a rim 1, results are unchanged when only rim 1 is provided, see #2288 and #2285

File:

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

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

@@ -92 +92 @@
 
 
-   SUBROUTINE bdy_orl( idx, ptb, pta, dta, ll_npo )
+   SUBROUTINE bdy_orl( idx, ptb, pta, dta, lrim0, ll_npo )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_orl  ***
@@ -104 +104 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptb  ! before tracer field
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      LOGICAL                 , OPTIONAL,  INTENT(in) ::   lrim0   ! indicate if rim 0 is treated
       LOGICAL,                             INTENT(in) ::   ll_npo  ! switch for NPO version
       !!
@@ -111 +112 @@
       igrd = 1                       ! Everything is at T-points here
       !
-      CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, ll_npo )
+      CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, lrim0, ll_npo )
       !
    END SUBROUTINE bdy_orl
 
 
-   SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, ll_npo )
+   SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, lrim0, ll_npo )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_orlanski_2d  ***
@@ -132 +133 @@
       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   phia     ! model after 2D field (to be updated)
       REAL(wp), DIMENSION(:)  , INTENT(in   ) ::   phi_ext  ! external forcing data
+      LOGICAL, OPTIONAL,        INTENT(in   ) ::   lrim0    ! indicate if rim 0 is treated
       LOGICAL ,                 INTENT(in   ) ::   ll_npo   ! switch for NPO version
       !
@@ -140 +142 @@
       INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices
       INTEGER  ::   flagu, flagv                           ! short cuts
+      INTEGER  ::   ibeg, iend                             ! length of rim to be treated (rim 0 or rim 1 or both)
       REAL(wp) ::   zmask_x, zmask_y1, zmask_y2
       REAL(wp) ::   zex1, zex2, zey, zey1, zey2
@@ -185 +188 @@
       END SELECT
       !
-      DO jb = 1, idx%nblenrim(igrd)
+      IF( PRESENT(lrim0) ) THEN
+         IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
+         ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
+         END IF
+      ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both
+      END IF
+      !
+      DO jb = ibeg, iend
          ii  = idx%nbi(jb,igrd)
          ij  = idx%nbj(jb,igrd) 
@@ -272 +282 @@
 
 
-   SUBROUTINE bdy_orlanski_3d( idx, igrd, phib, phia, phi_ext, ll_npo )
+   SUBROUTINE bdy_orlanski_3d( idx, igrd, phib, phia, phi_ext, lrim0, ll_npo )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_orlanski_3d  ***
@@ -288 +298 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phia     ! model after 3D field (to be updated)
       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   phi_ext  ! external forcing data
+      LOGICAL, OPTIONAL,          INTENT(in   ) ::   lrim0    ! indicate if rim 0 is treated
       LOGICAL ,                   INTENT(in   ) ::   ll_npo   ! switch for NPO version
       !
@@ -296 +307 @@
       INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices
       INTEGER  ::   flagu, flagv                           ! short cuts
+      INTEGER  ::   ibeg, iend                             ! length of rim to be treated (rim 0 or rim 1 or both)
       REAL(wp) ::   zmask_x, zmask_y1, zmask_y2
       REAL(wp) ::   zex1, zex2, zey, zey1, zey2
@@ -340 +352 @@
          CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_orlanksi_2d' )
       END SELECT
-
+      !
+      IF( PRESENT(lrim0) ) THEN
+         IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
+         ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
+         END IF
+      ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both
+      END IF
+      !
       DO jk = 1, jpk
          !            
-         DO jb = 1, idx%nblenrim(igrd)
+         DO jb = ibeg, iend
             ii  = idx%nbi(jb,igrd)
             ij  = idx%nbj(jb,igrd) 
@@ -430 +449 @@
    END SUBROUTINE bdy_orlanski_3d
 
-   SUBROUTINE bdy_nmn( idx, igrd, phia )
+   SUBROUTINE bdy_nmn( idx, igrd, phia, lrim0 )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_nmn  ***
@@ -444 +463 @@
       !!                                                   !      o      
       !!----------------------------------------------------------------------
-      INTEGER,                    INTENT(in)     ::   igrd     ! grid index
+      INTEGER,                    INTENT(in   )  ::   igrd     ! grid index
       REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated), must be masked
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_INDEX),            INTENT(in   )  ::   idx      ! OBC indices
+      LOGICAL, OPTIONAL,          INTENT(in   )  ::   lrim0    ! indicate if rim 0 is treated
       !! 
       REAL(wp) ::   zweight
@@ -453 +473 @@
       INTEGER  ::   ii, ij   ! 2D addresses
       INTEGER  ::   ipkm1    ! size of phia third dimension minus 1
+      INTEGER  ::   ibeg, iend                          ! length of rim to be treated (rim 0 or rim 1 or both)
       INTEGER  ::   ii1, ii2, ii3, ij1, ij2, ij3, itreat
       !!----------------------------------------------------------------------
@@ -465 +486 @@
       END SELECT
       !
-      DO ib = 1, idx%nblenrim(igrd)
+      IF( PRESENT(lrim0) ) THEN
+         IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
+         ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
+         END IF
+      ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both
+      END IF
+      !
+      DO ib = ibeg, iend
          ii = idx%nbi(ib,igrd)
          ij = idx%nbj(ib,igrd)
          itreat = idx%ntreat(ib,igrd)
-         CALL find_neib( ii, ij, itreat, ii1, ij1, ii2, ij2, ii3, ij3 )
+         CALL find_neib( ii, ij, itreat, ii1, ij1, ii2, ij2, ii3, ij3 )   ! find free ocean neighbours
          SELECT CASE( itreat )
          CASE( 1:8 )