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

source: branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90 @ 6863

Last change on this file since 6863 was 6862, checked in by lovato, 8 years ago

#1729 - trunk: removed key_bdy from the code and set usage of ln_bdy. Tested with SETTE.
File size: 12.6 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_top
13   !!----------------------------------------------------------------------
14   !!   trc_bdy            : Apply open boundary conditions to T and S
15   !!   trc_bdy_frs        : Apply Flow Relaxation Scheme
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, only: idx_bdy, OBC_INDEX, BDYTMASK, ln_bdy       ! 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/OPA 3.6 , NEMO Consortium (2015)
34   !! $Id$
35   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE trc_bdy( kt )
40      !!----------------------------------------------------------------------
41      !!                  ***  SUBROUTINE trc_bdy  ***
42      !!
43      !! ** Purpose : - Apply open boundary conditions for tracers in TOP component
44      !!                and scale the tracer data
45      !!
46      !!----------------------------------------------------------------------
47      INTEGER, INTENT( in ) :: kt     ! Main time step counter
48      !!
49      INTEGER               :: ib_bdy, jn ! Loop indeces
50      !!----------------------------------------------------------------------
51      !
52      IF( nn_timing == 1 ) CALL timing_start('trc_bdy')
53      !
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' )
72            END SELECT
73
74            ! Boundary points should be updated
75            CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy )
76
77         ENDDO
78      ENDDO
79      !
80      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy')
81
82   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
233
234   SUBROUTINE trc_bdy_dmp( kt )
235      !!----------------------------------------------------------------------
236      !!                 ***  SUBROUTINE trc_bdy_dmp  ***
237      !!                   
238      !! ** Purpose : Apply damping for tracers at open boundaries.
239      !!             It currently applies the damping to all tracers!!!
240      !!
241      !!----------------------------------------------------------------------
242      INTEGER,         INTENT(in) ::   kt
243      !!
244      INTEGER  ::   jn             ! Tracer index
245      REAL(wp) ::   zwgt           ! boundary weight
246      REAL(wp) ::   zta, zsa, ztime
247      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
248      INTEGER  ::   ii, ij         ! 2D addresses
249      INTEGER  ::   ib_bdy         ! Loop index
250      !!----------------------------------------------------------------------
251      !
252      IF( nn_timing == 1 ) CALL timing_start('trc_bdy_dmp')
253      !
254      DO jn = 1, jptra
255         DO ib_bdy=1, nb_bdy
256            IF ( trcdta_bdy(jn, ib_bdy)%dmp ) THEN
257               igrd = 1                       ! Everything is at T-points here
258               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
259                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
260                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
261                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
262                  DO ik = 1, jpkm1
263                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik)
264                     tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta
265                  END DO
266               END DO
267            ENDIF
268         ENDDO
269      ENDDO
270      !
271      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy_dmp')
272      !
273   END SUBROUTINE trc_bdy_dmp
274 
275#else
276   !!----------------------------------------------------------------------
277   !!   Dummy module                   NO Unstruct Open Boundary Conditions
278   !!----------------------------------------------------------------------
279CONTAINS
280   SUBROUTINE trc_bdy(kt)      ! Empty routine
281      WRITE(*,*) 'trc_bdy: You should not have seen this print! error?', kt
282   END SUBROUTINE trc_bdy
283
284   SUBROUTINE trc_bdy_dmp(kt)      ! Empty routine
285      WRITE(*,*) 'trc_bdy_dmp: You should not have seen this print! error?', kt
286   END SUBROUTINE trc_bdy_dmp
287
288#endif
289
290   !!======================================================================
291END MODULE trcbdy
Note: See TracBrowser for help on using the repository browser.