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.
trcbdy.F90 in NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/TOP – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.1_GO8_package/src/TOP/trcbdy.F90 @ 12088

Last change on this file since 12088 was 12088, checked in by deazer, 4 years ago

Updating GO8 Package branch to bring in required BDY bug fixes frouse with CO8
The mirror branch is already updated to have this change, where we merge in the mirror to the package branch
File size: 7.8 KB
Line 
1MODULE trcbdy
2   !!======================================================================
3   !!                       ***  MODULE  bdytrc  ***
4   !! Ocean tracers:   Apply boundary conditions for tracers in TOP component
5   !!======================================================================
6   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
7   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
8   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
9   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
10   !!            3.6  !  2015     (T. Lovato) Adapt BDY for tracers in TOP component
11   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure
12   !!----------------------------------------------------------------------
13#if defined key_top
14   !!----------------------------------------------------------------------
15   !!   trc_bdy       : Apply open boundary conditions & damping to tracers
16   !!----------------------------------------------------------------------
17   USE timing                       ! Timing
18   USE oce_trc                      ! ocean dynamics and tracers variables
19   USE par_trc
20   USE trc                          ! ocean space and time domain variables
21   USE bdylib                       ! for orlanski library routines
22   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
23   USE in_out_manager               ! I/O manager
24   USE bdy_oce                      ! ocean open boundary conditions
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC trc_bdy      ! routine called in trcnxt.F90
30   PUBLIC trc_bdy_dmp  ! routine called in trcstp.F90
31
32   !!----------------------------------------------------------------------
33   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
34   !! $Id$
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE trc_bdy( kt )
40      !!----------------------------------------------------------------------
41      !!                  ***  SUBROUTINE trc_bdy  ***
42      !!
43      !! ** Purpose : - Apply open boundary conditions for TOP tracers
44      !!
45      !!----------------------------------------------------------------------
46      INTEGER, INTENT( in ) :: kt     ! Main time step counter
47      !!
48      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices
49      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc
50      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
53      !!----------------------------------------------------------------------
54      !
55      IF( ln_timing )   CALL timing_start('trc_bdy')
56      !
57      igrd = 1 
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
94            END SELECT
95         END DO
96         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
97            CALL lbc_lnk( 'trcbdy', tra, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
98         END IF
99         !
100      END DO   ! ir
101      !
102      IF( ln_timing )   CALL timing_stop('trc_bdy')
103      !
104   END SUBROUTINE trc_bdy
105
106
107   SUBROUTINE trc_bdy_dmp( kt )
108      !!----------------------------------------------------------------------
109      !!                 ***  SUBROUTINE trc_bdy_dmp  ***
110      !!                   
111      !! ** Purpose : Apply damping for tracers at open boundaries.
112      !!             It currently applies the damping to all tracers!!!
113      !!
114      !!----------------------------------------------------------------------
115      INTEGER,         INTENT(in) ::   kt
116      !!
117      INTEGER  ::   jn             ! Tracer index
118      REAL(wp) ::   zwgt           ! boundary weight
119      REAL(wp) ::   zta, zsa, ztime
120      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
121      INTEGER  ::   ii, ij         ! 2D addresses
122      INTEGER  ::   ib_bdy         ! Loop index
123      !!----------------------------------------------------------------------
124      !
125      IF( ln_timing )   CALL timing_start('trc_bdy_dmp')
126      !
127      DO jn = 1, jptra
128         DO ib_bdy=1, nb_bdy
129            IF( trcdta_bdy(jn, ib_bdy)%dmp ) THEN
130               igrd = 1                       ! Everything is at T-points here
131               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
132                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
133                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
134                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
135                  DO ik = 1, jpkm1
136                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik)
137                     tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta
138                  END DO
139               END DO
140            ENDIF
141         END DO
142      END DO
143      !
144      IF( ln_timing )   CALL timing_stop('trc_bdy_dmp')
145      !
146   END SUBROUTINE trc_bdy_dmp
147 
148#else
149   !!----------------------------------------------------------------------
150   !!   Dummy module                   NO Unstruct Open Boundary Conditions
151   !!----------------------------------------------------------------------
152CONTAINS
153   SUBROUTINE trc_bdy(kt)      ! Empty routine
154      WRITE(*,*) 'trc_bdy: You should not have seen this print! error?', kt
155   END SUBROUTINE trc_bdy
156
157   SUBROUTINE trc_bdy_dmp(kt)      ! Empty routine
158      WRITE(*,*) 'trc_bdy_dmp: You should not have seen this print! error?', kt
159   END SUBROUTINE trc_bdy_dmp
160
161#endif
162
163   !!======================================================================
164END MODULE trcbdy
Note: See TracBrowser for help on using the repository browser.