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 7058 for branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2016-10-20T15:19:01+02:00 (8 years ago)
Author:
lovato
Message:

#1783 - trunk: Generalize the open boundary schemes and revise TRA and TRC BDY wrappers

Location:
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90

    r6862 r7058  
    99   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    1010   !!            3.6  !  2015     (T. Lovato) Adapt BDY for tracers in TOP component 
     11   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure 
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_top 
    1314   !!---------------------------------------------------------------------- 
    14    !!   trc_bdy            : Apply open boundary conditions to T and S 
    15    !!   trc_bdy_frs        : Apply Flow Relaxation Scheme 
     15   !!   trc_bdy       : Apply open boundary conditions & damping to tracers 
    1616   !!---------------------------------------------------------------------- 
    1717   USE timing                       ! Timing 
    … …  
    2222   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    2323   USE in_out_manager               ! I/O manager 
    24    USE bdy_oce, only: idx_bdy, OBC_INDEX, BDYTMASK, ln_bdy       ! ocean open boundary conditions 
     24   USE bdy_oce, only: idx_bdy       ! ocean open boundary conditions 
    2525 
    2626   IMPLICIT NONE 
    2727   PRIVATE 
     28 
     29   ! Local structure to rearrange tracers data 
     30   TYPE, PUBLIC ::   ztrcbdy 
     31      REAL(wp), POINTER, DIMENSION(:,:) ::  trc 
     32      REAL(wp), POINTER                 ::  fac 
     33   END TYPE 
    2834 
    2935   PUBLIC trc_bdy      ! routine called in trcnxt.F90  
    … …  
    3137 
    3238   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     39   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    3440   !! $Id$  
    3541   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4147      !!                  ***  SUBROUTINE trc_bdy  *** 
    4248      !! 
    43       !! ** Purpose : - Apply open boundary conditions for tracers in TOP component 
    44       !!                and scale the tracer data 
     49      !! ** Purpose : - Apply open boundary conditions for TOP tracers 
    4550      !! 
    4651      !!---------------------------------------------------------------------- 
    … …  
    4853      !! 
    4954      INTEGER               :: ib_bdy, jn ! Loop indeces 
     55      TYPE(ztrcbdy)         :: zdta       ! Temporary data structure 
    5056      !!---------------------------------------------------------------------- 
    5157      ! 
    5258      IF( nn_timing == 1 ) CALL timing_start('trc_bdy') 
    5359      ! 
    54       DO jn = 1, jptra 
    55          DO ib_bdy=1, nb_bdy 
    56  
    57             SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 
    58             CASE('none') 
    59                CYCLE 
    60             CASE('frs') 
    61                CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    62             CASE('specified') 
    63                CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    64             CASE('neumann') 
    65                CALL bdy_trc_nmn( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    66             CASE('orlanski') 
    67                CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.false. ) 
    68             CASE('orlanski_npo') 
    69                CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.true. ) 
    70             CASE DEFAULT 
    71                CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     60      DO ib_bdy=1, nb_bdy 
     61         DO jn = 1, jptra 
     62            ! 
     63            zdta%trc => trcdta_bdy(jn,ib_bdy)%trc  
     64            zdta%fac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     65            ! 
     66            SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     67            CASE('none'        )   ;   CYCLE 
     68            CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), zdta%trc*zdta%fac ) 
     69            CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), zdta%trc*zdta%fac ) 
     70            CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy),                tra(:,:,:,jn) ) 
     71            CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), zdta%trc*zdta%fac, ll_npo=.false. ) 
     72            CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), zdta%trc*zdta%fac, ll_npo=.true. ) 
     73            CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
    7274            END SELECT 
    73  
    7475            ! Boundary points should be updated 
    7576            CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy ) 
    76  
    77          ENDDO 
    78       ENDDO 
     77            ! 
     78         END DO 
     79      END DO 
    7980      ! 
    8081      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy') 
    8182 
    8283   END SUBROUTINE trc_bdy 
    83  
    84    SUBROUTINE bdy_trc_frs( jn, idx, dta, kt ) 
    85       !!---------------------------------------------------------------------- 
    86       !!                 ***  SUBROUTINE bdy_trc_frs  *** 
    87       !!                     
    88       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
    89       !!  
    90       !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    91       !!---------------------------------------------------------------------- 
    92       INTEGER,         INTENT(in) ::   kt 
    93       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    94       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    95       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    96       !!  
    97       REAL(wp) ::   zwgt           ! boundary weight 
    98       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    99       INTEGER  ::   ii, ij         ! 2D addresses 
    100       !!---------------------------------------------------------------------- 
    101       ! 
    102       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs') 
    103       !  
    104       igrd = 1                       ! Everything is at T-points here 
    105       DO ib = 1, idx%nblen(igrd) 
    106          DO ik = 1, jpkm1 
    107             ii = idx%nbi(ib,igrd) 
    108             ij = idx%nbj(ib,igrd) 
    109             zwgt = idx%nbw(ib,igrd) 
    110             tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac)  &  
    111                         &  - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik) 
    112          END DO 
    113       END DO  
    114       ! 
    115       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    116       ! 
    117       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs') 
    118       ! 
    119    END SUBROUTINE bdy_trc_frs 
    120    
    121    SUBROUTINE bdy_trc_spe( jn, idx, dta, kt ) 
    122       !!---------------------------------------------------------------------- 
    123       !!                 ***  SUBROUTINE bdy_trc_frs  *** 
    124       !!                     
    125       !! ** Purpose : Apply a specified value for tracers at open boundaries. 
    126       !!  
    127       !!---------------------------------------------------------------------- 
    128       INTEGER,         INTENT(in) ::   kt 
    129       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    130       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    131       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    132       !!  
    133       REAL(wp) ::   zwgt           ! boundary weight 
    134       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    135       INTEGER  ::   ii, ij         ! 2D addresses 
    136       !!---------------------------------------------------------------------- 
    137       ! 
    138       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_spe') 
    139       ! 
    140       igrd = 1                       ! Everything is at T-points here 
    141       DO ib = 1, idx%nblenrim(igrd) 
    142          ii = idx%nbi(ib,igrd) 
    143          ij = idx%nbj(ib,igrd) 
    144          DO ik = 1, jpkm1 
    145             tra(ii,ij,ik,jn) = dta%trc(ib,ik) * dta%rn_fac * tmask(ii,ij,ik) 
    146          END DO 
    147       END DO 
    148       ! 
    149       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    150       ! 
    151       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_spe') 
    152       ! 
    153    END SUBROUTINE bdy_trc_spe 
    154  
    155    SUBROUTINE bdy_trc_nmn( jn, idx, dta, kt ) 
    156       !!---------------------------------------------------------------------- 
    157       !!                 ***  SUBROUTINE bdy_trc_nmn  *** 
    158       !!                     
    159       !! ** Purpose : Duplicate the value for tracers at open boundaries. 
    160       !!  
    161       !!---------------------------------------------------------------------- 
    162       INTEGER,         INTENT(in) ::   kt 
    163       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    164       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    165       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    166       !!  
    167       REAL(wp) ::   zwgt           ! boundary weight 
    168       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    169       INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   ! 2D addresses 
    170       !!---------------------------------------------------------------------- 
    171       ! 
    172       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_nmn') 
    173       ! 
    174       igrd = 1                       ! Everything is at T-points here 
    175       DO ib = 1, idx%nblenrim(igrd) 
    176          ii = idx%nbi(ib,igrd) 
    177          ij = idx%nbj(ib,igrd) 
    178          DO ik = 1, jpkm1 
    179             ! search the sense of the gradient 
    180             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    181             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    182             IF ( zcoef1+zcoef2 == 0) THEN 
    183                ! corner 
    184                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
    185                tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik) + & 
    186                  &                tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik) + & 
    187                  &                tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik) + & 
    188                  &                tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik) 
    189                tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    190             ELSE 
    191                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    192                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    193                tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) 
    194             ENDIF 
    195          END DO 
    196       END DO 
    197       ! 
    198       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    199       ! 
    200       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_nmn') 
    201       ! 
    202    END SUBROUTINE bdy_trc_nmn 
    203   
    204  
    205    SUBROUTINE bdy_trc_orlanski( jn, idx, dta, ll_npo ) 
    206       !!---------------------------------------------------------------------- 
    207       !!                 ***  SUBROUTINE bdy_trc_orlanski  *** 
    208       !!              
    209       !!              - Apply Orlanski radiation to tracers of TOP component.  
    210       !!              - Wrapper routine for bdy_orlanski_3d 
    211       !!  
    212       !! 
    213       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    214       !!---------------------------------------------------------------------- 
    215       INTEGER,                      INTENT(in) ::   jn      ! Tracer index 
    216       TYPE(OBC_INDEX),              INTENT(in) ::   idx     ! OBC indices 
    217       TYPE(OBC_DATA),               INTENT(in) ::   dta     ! OBC external data 
    218       LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
    219  
    220       INTEGER  ::   igrd                                    ! grid index 
    221       !!---------------------------------------------------------------------- 
    222  
    223       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_orlanski') 
    224       ! 
    225       igrd = 1      ! Orlanski bc on tracers;  
    226       !             
    227       CALL bdy_orlanski_3d( idx, igrd, trb(:,:,:,jn), tra(:,:,:,jn), (dta%trc * dta%rn_fac), ll_npo ) 
    228       ! 
    229       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_orlanski') 
    230       ! 
    231  
    232    END SUBROUTINE bdy_trc_orlanski 
    23384 
    23485   SUBROUTINE trc_bdy_dmp( kt ) 

  • branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r6862 r7058  
    499499      z1_rau0 = 0.5 / rau0 
    500500      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    501 #if ! defined key_dynspg_ts 
     501 
     502      IF( .NOT.ln_dynspg_ts ) THEN 
    502503      ! These lines are not necessary with time splitting since 
    503504      ! boundary condition on sea level is set during ts loop 
    … …  
    505506      CALL agrif_ssh( kt ) 
    506507#endif 
    507       IF( ln_bdy ) THEN 
    508          ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    509          CALL lbc_lnk( ssha, 'T', 1. )  
    510       ENDIF 
    511 #endif 
     508         IF( ln_bdy ) THEN 
     509            ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
     510            CALL lbc_lnk( ssha, 'T', 1. )  
     511         ENDIF 
     512      ENDIF 
    512513      ! 
    513514      !                                           !------------------------------! 
Note: See TracChangeset for help on using the changeset viewer.