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

Ignore:
Timestamp:
2019-12-11T12:02:38+01:00 (4 years ago)
Author:
agn
Message:

updated trunk to v 11653

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbdy.F90

    r10425 r12178  
    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 
     
    4646      INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    4747      !! 
    48       INTEGER                           :: ib_bdy ,jn ,igrd ! Loop indeces 
     48      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices 
    4949      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
    5050      REAL(wp), POINTER                 ::  zfac 
     51      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated 
     52      LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out 
    5153      !!---------------------------------------------------------------------- 
    5254      ! 
     
    5456      ! 
    5557      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' ) 
     58      llsend1(:) = .false.  ;   llrecv1(:) = .false. 
     59      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     60         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     61         ELSE                 ;   llrim0 = .FALSE. 
     62         END IF 
     63         DO ib_bdy=1, nb_bdy 
     64            DO jn = 1, jptra 
     65               ! 
     66               ztrc => trcdta_bdy(jn,ib_bdy)%trc  
     67               zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     68               ! 
     69               SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     70               CASE('none'        )   ;   CYCLE 
     71               CASE('frs'         )   ! treat the whole boundary at once 
     72                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
     73               CASE('specified'   )   ! treat the whole rim      at once 
     74                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
     75               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) )   ! tra masked 
     76               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 
     77               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 
     78               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     79               END SELECT 
     80               ! 
     81            END DO 
     82         END DO 
     83         ! 
     84         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     85         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     86         DO ib_bdy=1, nb_bdy 
     87            SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     88            CASE('neumann') 
     89               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     90               llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     91            CASE('orlanski','orlanski_npo') 
     92               llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     93               llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    7194            END SELECT 
    72             ! Boundary points should be updated 
    73             CALL lbc_bdy_lnk( 'trcbdy', tra(:,:,:,jn), 'T', 1., ib_bdy ) 
    74             ! 
    7595         END DO 
    76       END DO 
     96         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     97            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     98         END IF 
     99         ! 
     100      END DO   ! ir 
    77101      ! 
    78102      IF( ln_timing )   CALL timing_stop('trc_bdy') 
    79  
     103      ! 
    80104   END SUBROUTINE trc_bdy 
    81105 
Note: See TracChangeset for help on using the changeset viewer.