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 11191 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90 – NEMO

Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed

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

    r11071 r11191  
    4242      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    4343      ! 
    44       INTEGER ::   ib_bdy   ! loop index 
     44      INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index 
     45      LOGICAL  ::   llrim0         ! indicate if rim 0 is treated 
    4546      LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3  ! indicate how communications are to be carried out 
    4647 
    4748      !!---------------------------------------------------------------------- 
    48       DO ib_bdy=1, nb_bdy 
     49      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     50         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     51         ELSE                 ;   llrim0 = .FALSE. 
     52         END IF 
     53         DO ib_bdy=1, nb_bdy 
     54            ! 
     55            SELECT CASE( cn_dyn3d(ib_bdy) ) 
     56            CASE('none')        ;   CYCLE 
     57            CASE('frs' )        ! treat the whole boundary at once 
     58               IF( ir == 0) CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     59            CASE('specified')   ! treat the whole rim      at once 
     60               IF( ir == 0) CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     61            CASE('zero')        ! treat the whole rim      at once 
     62               IF( ir == 0) CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     63            CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. ) 
     64            CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true.  ) 
     65            CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 ) 
     66            CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy, llrim0 ) 
     67            CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
     68            END SELECT 
     69         END DO 
    4970         ! 
    50          SELECT CASE( cn_dyn3d(ib_bdy) ) 
    51          CASE('none')        ;   CYCLE 
    52          CASE('frs' )        ;   CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    53          CASE('specified')   ;   CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    54          CASE('zero')        ;   CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    55          CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
    56          CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    57          CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    58          CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy ) 
    59          CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    60          END SELECT 
    61       END DO 
    62       ! 
    63       llsend2(:) = .false. 
    64       llrecv2(:) = .false. 
    65       llsend3(:) = .false. 
    66       llrecv3(:) = .false. 
    67       DO ib_bdy=1, nb_bdy 
    68          SELECT CASE( cn_dyn3d(ib_bdy) ) 
    69          CASE('orlanski', 'orlanski_npo') 
    70             llsend2(:) = llsend2(:) .OR. lsend_bdy(ib_bdy,2,:)   ! possibly every direction, U points 
    71             llrecv2(:) = llrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:)   ! possibly every direction, U points 
    72             llsend3(:) = llsend3(:) .OR. lsend_bdy(ib_bdy,3,:)   ! possibly every direction, V points 
    73             llrecv3(:) = llrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:)   ! possibly every direction, V points 
    74          CASE('zerograd') 
    75             llsend2(3:4) = llsend2(3:4) .OR. lsend_bdyint(ib_bdy,2,3:4)   ! north/south, U points 
    76             llrecv2(3:4) = llrecv2(3:4) .OR. lrecv_bdyint(ib_bdy,2,3:4)   ! north/south, U points 
    77             llsend3(1:2) = llsend3(1:2) .OR. lsend_bdyint(ib_bdy,3,1:2)   ! west/east, V points 
    78             llrecv3(1:2) = llrecv3(1:2) .OR. lrecv_bdyint(ib_bdy,3,1:2)   ! west/east, V points 
    79          CASE('neumann') 
    80             llsend2(:) = llsend2(:) .OR. lsend_bdyint(ib_bdy,2,:)   ! possibly every direction, U points 
    81             llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(ib_bdy,2,:)   ! possibly every direction, U points 
    82             llsend3(:) = llsend3(:) .OR. lsend_bdyint(ib_bdy,3,:)   ! possibly every direction, V points 
    83             llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(ib_bdy,3,:)   ! possibly every direction, V points 
    84          END SELECT 
    85       END DO 
    86       ! 
    87       IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    88          CALL lbc_bdy_lnk( 'bdydyn2d', llsend2, llrecv2, ua, 'U', -1. ) 
    89       END IF 
    90       IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    91          CALL lbc_bdy_lnk( 'bdydyn2d', llsend3, llrecv3, va, 'V', -1. ) 
    92       END IF 
     71         llsend2(:) = .false. 
     72         llrecv2(:) = .false. 
     73         llsend3(:) = .false. 
     74         llrecv3(:) = .false. 
     75         DO ib_bdy=1, nb_bdy 
     76            SELECT CASE( cn_dyn3d(ib_bdy) ) 
     77            CASE('orlanski', 'orlanski_npo') 
     78               llsend2(:) = llsend2(:) .OR. lsend_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     79               llrecv2(:) = llrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     80               llsend3(:) = llsend3(:) .OR. lsend_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     81               llrecv3(:) = llrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     82            CASE('zerograd') 
     83               llsend2(3:4) = llsend2(3:4) .OR. lsend_bdyint(ib_bdy,2,3:4,ir)   ! north/south, U points 
     84               llrecv2(3:4) = llrecv2(3:4) .OR. lrecv_bdyint(ib_bdy,2,3:4,ir)   ! north/south, U points 
     85               llsend3(1:2) = llsend3(1:2) .OR. lsend_bdyint(ib_bdy,3,1:2,ir)   ! west/east, V points 
     86               llrecv3(1:2) = llrecv3(1:2) .OR. lrecv_bdyint(ib_bdy,3,1:2,ir)   ! west/east, V points 
     87            CASE('neumann') 
     88               llsend2(:) = llsend2(:) .OR. lsend_bdyint(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     89               llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     90               llsend3(:) = llsend3(:) .OR. lsend_bdyint(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     91               llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     92            END SELECT 
     93         END DO 
     94         ! 
     95         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
     96            CALL lbc_bdy_lnk( 'bdydyn2d', llsend2, llrecv2, ua, 'U', -1. ) 
     97         END IF 
     98         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
     99            CALL lbc_bdy_lnk( 'bdydyn2d', llsend3, llrecv3, va, 'V', -1. ) 
     100         END IF 
     101      END DO 
    93102      ! 
    94103   END SUBROUTINE bdy_dyn3d 
    … …  
    133142 
    134143 
    135    SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 
     144   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt, ib_bdy, llrim0 ) 
    136145      !!---------------------------------------------------------------------- 
    137146      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  *** 
    … …  
    141150      !!---------------------------------------------------------------------- 
    142151      INTEGER                     ::   kt 
    143       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    144       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    145       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     152      TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices 
     153      TYPE(OBC_DATA),  INTENT(in) ::   dta      ! OBC external data 
     154      INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index 
     155      LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    146156      !! 
    147157      INTEGER  ::   jb, jk         ! dummy loop indices 
    148158      INTEGER  ::   ii, ij, igrd   ! local integers 
    149159      INTEGER  ::   flagu, flagv           ! short cuts 
     160      INTEGER  ::   ibeg, iend     ! length of rim to be treated (rim 0 or rim 1 or both) 
    150161      !!---------------------------------------------------------------------- 
    151162      ! 
    152163      igrd = 2                      ! Copying tangential velocity into bdy points 
    153       DO jb = 1, idx%nblenrim(igrd) 
     164      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     165      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
     166      ENDIF 
     167      DO jb = ibeg, iend 
    154168         ii    = idx%nbi(jb,igrd) 
    155169         ij    = idx%nbj(jb,igrd) 
    … …  
    168182      ! 
    169183      igrd = 3                      ! Copying tangential velocity into bdy points 
    170       DO jb = 1, idx%nblenrim(igrd) 
     184      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     185      ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
     186      ENDIF 
     187      DO jb = ibeg, iend 
    171188         ii    = idx%nbi(jb,igrd) 
    172189         ij    = idx%nbj(jb,igrd) 
    … …  
    268285 
    269286 
    270    SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     287   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, llrim0, ll_npo ) 
    271288      !!---------------------------------------------------------------------- 
    272289      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  *** 
    … …  
    280297      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    281298      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    282       INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    283       LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
     299      INTEGER,                      INTENT(in) ::   ib_bdy   ! BDY set index 
     300      LOGICAL,                      INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     301      LOGICAL,                      INTENT(in) ::   ll_npo   ! switch for NPO version 
    284302 
    285303      INTEGER  ::   jb, igrd                               ! dummy loop indices 
    … …  
    290308      igrd = 2      ! Orlanski bc on u-velocity;  
    291309      !             
    292       CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo ) 
     310      CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo, llrim0 ) 
    293311 
    294312      igrd = 3      ! Orlanski bc on v-velocity 
    295313      !   
    296       CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 
     314      CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo, llrim0 ) 
    297315      ! 
    298316   END SUBROUTINE bdy_dyn3d_orlanski 
    … …  
    347365 
    348366 
    349    SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 
     367   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy, llrim0 ) 
    350368      !!---------------------------------------------------------------------- 
    351369      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  *** 
    … …  
    356374      !! 
    357375      !!---------------------------------------------------------------------- 
    358       TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    359       INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    360       INTEGER  ::   igrd                                    ! dummy indice 
     376      TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices 
     377      INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index 
     378      LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     379      INTEGER  ::   igrd                        ! dummy indice 
    361380      !!---------------------------------------------------------------------- 
    362381      ! 
    … …  
    365384      igrd = 2      ! Neumann bc on u-velocity;  
    366385      !             
    367       CALL bdy_nmn( idx, igrd, ua )   ! ua is masked 
     386      CALL bdy_nmn( idx, igrd, ua, llrim0 )   ! ua is masked 
    368387 
    369388      igrd = 3      ! Neumann bc on v-velocity 
    370389      !   
    371       CALL bdy_nmn( idx, igrd, va )   ! va is masked 
     390      CALL bdy_nmn( idx, igrd, va, llrim0 )   ! va is masked 
    372391      ! 
    373392   END SUBROUTINE bdy_dyn3d_nmn 
Note: See TracChangeset for help on using the changeset viewer.