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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcbdy.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcbdy.F90

    r10425 r13463  
    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       ! ocean open boundary conditions 
     24   USE bdy_oce                      ! ocean open boundary conditions 
    2525 
    2626   IMPLICIT NONE 
    … …  
    3737CONTAINS 
    3838 
    39    SUBROUTINE trc_bdy( kt ) 
     39   SUBROUTINE trc_bdy( kt, Kbb, Kmm, Krhs ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                  ***  SUBROUTINE trc_bdy  *** 
    … …  
    4444      !! 
    4545      !!---------------------------------------------------------------------- 
    46       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
     46      INTEGER, INTENT( in ) :: kt              ! Main time step counter 
     47      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices 
    4748      !! 
    48       INTEGER                           :: ib_bdy ,jn ,igrd ! Loop indeces 
     49      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices 
    4950      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
    5051      REAL(wp), POINTER                 ::  zfac 
     52      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated 
     53      LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out 
    5154      !!---------------------------------------------------------------------- 
    5255      ! 
    … …  
    5457      ! 
    5558      igrd = 1  
    56       ! 
    57       DO ib_bdy=1, nb_bdy 
    58          DO jn = 1, jptra 
    59             ! 
    60             ztrc => trcdta_bdy(jn,ib_bdy)%trc  
    61             zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
    62             ! 
    63             SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
    64             CASE('none'        )   ;   CYCLE 
    65             CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
    66             CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
    67             CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) ) 
    68             CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 
    69             CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 
    70             CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     59      llsend1(:) = .false.  ;   llrecv1(:) = .false. 
     60      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     61         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     62         ELSE                 ;   llrim0 = .FALSE. 
     63         END IF 
     64         DO ib_bdy=1, nb_bdy 
     65            DO jn = 1, jptra 
     66               ! 
     67               ztrc => trcdta_bdy(jn,ib_bdy)%trc  
     68               zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     69               ! 
     70               SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     71               CASE('none'        )   ;   CYCLE 
     72               CASE('frs'         )   ! treat the whole boundary at once 
     73                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
     74               CASE('specified'   )   ! treat the whole rim      at once 
     75                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
     76               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tr(:,:,:,jn,Krhs) )   ! tra masked 
     77               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. ) 
     78               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. ) 
     79               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     80               END SELECT 
     81               ! 
     82            END DO 
     83         END DO 
     84         ! 
     85         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     86         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     87         DO ib_bdy=1, nb_bdy 
     88            SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     89            CASE('neumann') 
     90               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     91               llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     92            CASE('orlanski','orlanski_npo') 
     93               llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     94               llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    7195            END SELECT 
    72             ! Boundary points should be updated 
    73             CALL lbc_bdy_lnk( 'trcbdy', tra(:,:,:,jn), 'T', 1., ib_bdy ) 
    74             ! 
    7596         END DO 
    76       END DO 
     97         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     98            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     99         END IF 
     100         ! 
     101      END DO   ! ir 
    77102      ! 
    78103      IF( ln_timing )   CALL timing_stop('trc_bdy') 
    79  
     104      ! 
    80105   END SUBROUTINE trc_bdy 
    81106 
    82107 
    83    SUBROUTINE trc_bdy_dmp( kt ) 
     108   SUBROUTINE trc_bdy_dmp( kt, Kbb, Krhs ) 
    84109      !!---------------------------------------------------------------------- 
    85110      !!                 ***  SUBROUTINE trc_bdy_dmp  *** 
    … …  
    90115      !!---------------------------------------------------------------------- 
    91116      INTEGER,         INTENT(in) ::   kt 
     117      INTEGER,         INTENT(in) ::   Kbb, Krhs  ! time level indices 
    92118      !!  
    93119      INTEGER  ::   jn             ! Tracer index 
    … …  
    110136                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 
    111137                  DO ik = 1, jpkm1 
    112                      zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik) 
    113                      tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta 
     138                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - tr(ii,ij,ik,jn,Kbb) ) * tmask(ii,ij,ik) 
     139                     tr(ii,ij,ik,jn,Krhs) = tr(ii,ij,ik,jn,Krhs) + zta 
    114140                  END DO 
    115141               END DO 
Note: See TracChangeset for help on using the changeset viewer.