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 branches/UKMO/dev_r6393_CO6_package_trunk/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r6393_CO6_package_trunk/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90 @ 7019

Last change on this file since 7019 was 7019, checked in by deazer, 7 years ago

Cleared svn keywords

File size: 12.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   !!----------------------------------------------------------------------
12#if defined key_bdy && key_top
13   !!----------------------------------------------------------------------
14   !!   'key_bdy'                     Unstructured Open Boundary Conditions
15   !!----------------------------------------------------------------------
16   !!   trc_bdy            : Apply open boundary conditions to T and S
17   !!   trc_bdy_frs        : Apply Flow Relaxation Scheme
18   !!----------------------------------------------------------------------
19   USE timing                       ! Timing
20   USE oce_trc                      ! ocean dynamics and tracers variables
21   USE par_trc
22   USE trc                          ! ocean space and time domain variables
23   USE bdylib                       ! for orlanski library routines
24   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
25   USE in_out_manager               ! I/O manager
26   USE bdy_oce, only: idx_bdy, OBC_INDEX, BDYTMASK, lk_bdy       ! ocean open boundary conditions
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC trc_bdy      ! routine called in trcnxt.F90
32   PUBLIC trc_bdy_dmp  ! routine called in trcstp.F90
33
34   !!----------------------------------------------------------------------
35   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
36   !! $Id$
37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE trc_bdy( kt )
42      !!----------------------------------------------------------------------
43      !!                  ***  SUBROUTINE trc_bdy  ***
44      !!
45      !! ** Purpose : - Apply open boundary conditions for tracers in TOP component
46      !!                and scale the tracer data
47      !!
48      !!----------------------------------------------------------------------
49      INTEGER, INTENT( in ) :: kt     ! Main time step counter
50      !!
51      INTEGER               :: ib_bdy, jn ! Loop indeces
52      !!----------------------------------------------------------------------
53      !
54      IF( nn_timing == 1 ) CALL timing_start('trc_bdy')
55      !
56      DO jn = 1, jptra
57         DO ib_bdy=1, nb_bdy
58
59            SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc )
60            CASE('none')
61               CYCLE
62            CASE('frs')
63               CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt )
64            CASE('specified')
65               CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt )
66            CASE('neumann')
67               CALL bdy_trc_nmn( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt )
68            CASE('orlanski')
69               CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.false. )
70            CASE('orlanski_npo')
71               CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.true. )
72            CASE DEFAULT
73               CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' )
74            END SELECT
75
76            ! Boundary points should be updated
77            CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy )
78
79         ENDDO
80      ENDDO
81      !
82      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy')
83
84   END SUBROUTINE trc_bdy
85
86   SUBROUTINE bdy_trc_frs( jn, idx, dta, kt )
87      !!----------------------------------------------------------------------
88      !!                 ***  SUBROUTINE bdy_trc_frs  ***
89      !!                   
90      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.
91      !!
92      !! Reference : Engedahl H., 1995, Tellus, 365-382.
93      !!----------------------------------------------------------------------
94      INTEGER,         INTENT(in) ::   kt
95      INTEGER,         INTENT(in) ::   jn   ! Tracer index
96      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
97      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
98      !!
99      REAL(wp) ::   zwgt           ! boundary weight
100      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
101      INTEGER  ::   ii, ij         ! 2D addresses
102      !!----------------------------------------------------------------------
103      !
104      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs')
105      !
106      igrd = 1                       ! Everything is at T-points here
107      DO ib = 1, idx%nblen(igrd)
108         DO ik = 1, jpkm1
109            ii = idx%nbi(ib,igrd)
110            ij = idx%nbj(ib,igrd)
111            zwgt = idx%nbw(ib,igrd)
112            tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac)  & 
113                        &  - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik)
114         END DO
115      END DO 
116      !
117      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
118      !
119      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs')
120      !
121   END SUBROUTINE bdy_trc_frs
122 
123   SUBROUTINE bdy_trc_spe( jn, idx, dta, kt )
124      !!----------------------------------------------------------------------
125      !!                 ***  SUBROUTINE bdy_trc_frs  ***
126      !!                   
127      !! ** Purpose : Apply a specified value for tracers at open boundaries.
128      !!
129      !!----------------------------------------------------------------------
130      INTEGER,         INTENT(in) ::   kt
131      INTEGER,         INTENT(in) ::   jn   ! Tracer index
132      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
133      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
134      !!
135      REAL(wp) ::   zwgt           ! boundary weight
136      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
137      INTEGER  ::   ii, ij         ! 2D addresses
138      !!----------------------------------------------------------------------
139      !
140      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_spe')
141      !
142      igrd = 1                       ! Everything is at T-points here
143      DO ib = 1, idx%nblenrim(igrd)
144         ii = idx%nbi(ib,igrd)
145         ij = idx%nbj(ib,igrd)
146         DO ik = 1, jpkm1
147            tra(ii,ij,ik,jn) = dta%trc(ib,ik) * dta%rn_fac * tmask(ii,ij,ik)
148         END DO
149      END DO
150      !
151      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
152      !
153      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_spe')
154      !
155   END SUBROUTINE bdy_trc_spe
156
157   SUBROUTINE bdy_trc_nmn( jn, idx, dta, kt )
158      !!----------------------------------------------------------------------
159      !!                 ***  SUBROUTINE bdy_trc_nmn  ***
160      !!                   
161      !! ** Purpose : Duplicate the value for tracers at open boundaries.
162      !!
163      !!----------------------------------------------------------------------
164      INTEGER,         INTENT(in) ::   kt
165      INTEGER,         INTENT(in) ::   jn   ! Tracer index
166      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
167      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
168      !!
169      REAL(wp) ::   zwgt           ! boundary weight
170      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
171      INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   ! 2D addresses
172      !!----------------------------------------------------------------------
173      !
174      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_nmn')
175      !
176      igrd = 1                       ! Everything is at T-points here
177      DO ib = 1, idx%nblenrim(igrd)
178         ii = idx%nbi(ib,igrd)
179         ij = idx%nbj(ib,igrd)
180         DO ik = 1, jpkm1
181            ! search the sense of the gradient
182            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
183            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
184            IF ( zcoef1+zcoef2 == 0) THEN
185               ! corner
186               zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik)
187               tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik) + &
188                 &                tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik) + &
189                 &                tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik) + &
190                 &                tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik)
191               tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
192            ELSE
193               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
194               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
195               tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik)
196            ENDIF
197         END DO
198      END DO
199      !
200      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
201      !
202      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_nmn')
203      !
204   END SUBROUTINE bdy_trc_nmn
205 
206
207   SUBROUTINE bdy_trc_orlanski( jn, idx, dta, ll_npo )
208      !!----------------------------------------------------------------------
209      !!                 ***  SUBROUTINE bdy_trc_orlanski  ***
210      !!             
211      !!              - Apply Orlanski radiation to tracers of TOP component.
212      !!              - Wrapper routine for bdy_orlanski_3d
213      !!
214      !!
215      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)   
216      !!----------------------------------------------------------------------
217      INTEGER,                      INTENT(in) ::   jn      ! Tracer index
218      TYPE(OBC_INDEX),              INTENT(in) ::   idx     ! OBC indices
219      TYPE(OBC_DATA),               INTENT(in) ::   dta     ! OBC external data
220      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version
221
222      INTEGER  ::   igrd                                    ! grid index
223      !!----------------------------------------------------------------------
224
225      IF( nn_timing == 1 ) CALL timing_start('bdy_trc_orlanski')
226      !
227      igrd = 1      ! Orlanski bc on tracers;
228      !           
229      CALL bdy_orlanski_3d( idx, igrd, trb(:,:,:,jn), tra(:,:,:,jn), (dta%trc * dta%rn_fac), ll_npo )
230      !
231      IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_orlanski')
232      !
233
234   END SUBROUTINE bdy_trc_orlanski
235
236   SUBROUTINE trc_bdy_dmp( kt )
237      !!----------------------------------------------------------------------
238      !!                 ***  SUBROUTINE trc_bdy_dmp  ***
239      !!                   
240      !! ** Purpose : Apply damping for tracers at open boundaries.
241      !!             It currently applies the damping to all tracers!!!
242      !!
243      !!----------------------------------------------------------------------
244      INTEGER,         INTENT(in) ::   kt
245      !!
246      INTEGER  ::   jn             ! Tracer index
247      REAL(wp) ::   zwgt           ! boundary weight
248      REAL(wp) ::   zta, zsa, ztime
249      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
250      INTEGER  ::   ii, ij         ! 2D addresses
251      INTEGER  ::   ib_bdy         ! Loop index
252      !!----------------------------------------------------------------------
253      !
254      IF( nn_timing == 1 ) CALL timing_start('trc_bdy_dmp')
255      !
256      DO jn = 1, jptra
257         DO ib_bdy=1, nb_bdy
258            IF ( trcdta_bdy(jn, ib_bdy)%dmp ) THEN
259               igrd = 1                       ! Everything is at T-points here
260               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
261                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
262                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
263                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
264                  DO ik = 1, jpkm1
265                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik)
266                     tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta
267                  END DO
268               END DO
269            ENDIF
270         ENDDO
271      ENDDO
272      !
273      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy_dmp')
274      !
275   END SUBROUTINE trc_bdy_dmp
276 
277#else
278   !!----------------------------------------------------------------------
279   !!   Dummy module                   NO Unstruct Open Boundary Conditions
280   !!----------------------------------------------------------------------
281CONTAINS
282   SUBROUTINE trc_bdy(kt)      ! Empty routine
283      WRITE(*,*) 'trc_bdy: You should not have seen this print! error?', kt
284   END SUBROUTINE trc_bdy
285
286   SUBROUTINE trc_bdy_dmp(kt)      ! Empty routine
287      WRITE(*,*) 'trc_bdy_dmp: You should not have seen this print! error?', kt
288   END SUBROUTINE trc_bdy_dmp
289
290#endif
291
292   !!======================================================================
293END MODULE trcbdy
Note: See TracBrowser for help on using the repository browser.