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.
bdytra.F90 in branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90 @ 4291

Last change on this file since 4291 was 3777, checked in by epico, 11 years ago

fixed bug #1034 Missplacing of the call to lbc_lnk in the bdy_tra
see ticket https://forge.ipsl.jussieu.fr/nemo/ticket/1034
  • Property svn:keywords set to Id
File size: 12.8 KB
Line 
1MODULE bdytra
2   !!======================================================================
3   !!                       ***  MODULE  bdytra  ***
4   !! Ocean tracers:   Apply boundary conditions for tracers
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   !!----------------------------------------------------------------------
11#if defined key_bdy
12   !!----------------------------------------------------------------------
13   !!   'key_bdy'                     Unstructured Open Boundary Conditions
14   !!----------------------------------------------------------------------
15   !!   bdy_tra            : Apply open boundary conditions to T and S
16   !!   bdy_tra_frs        : Apply Flow Relaxation Scheme
17   !!----------------------------------------------------------------------
18   USE timing          ! Timing
19   USE oce             ! ocean dynamics and tracers variables
20   USE dom_oce         ! ocean space and time domain variables
21   USE bdy_oce         ! ocean open boundary conditions
22   USE bdydta, ONLY:   bf
23   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
24   USE in_out_manager  ! I/O manager
25
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC bdy_tra      ! routine called in tranxt.F90
31   PUBLIC bdy_tra_dmp  ! routine called in step.F90
32
33   !!----------------------------------------------------------------------
34   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
35   !! $Id$
36   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
37   !!----------------------------------------------------------------------
38CONTAINS
39
40   SUBROUTINE bdy_tra( kt )
41      !!----------------------------------------------------------------------
42      !!                  ***  SUBROUTINE bdy_tra  ***
43      !!
44      !! ** Purpose : - Apply open boundary conditions for temperature and salinity
45      !!
46      !!----------------------------------------------------------------------
47      INTEGER, INTENT( in ) :: kt     ! Main time step counter
48      !!
49      INTEGER               :: ib_bdy ! Loop index
50
51      DO ib_bdy=1, nb_bdy
52
53         SELECT CASE( nn_tra(ib_bdy) )
54         CASE(jp_none)
55            CYCLE
56         CASE(jp_frs)
57            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
58         CASE(2)
59            CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
60         CASE(3)
61            CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
62         CASE(4)
63            CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
64         CASE DEFAULT
65            CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
66         END SELECT
67         ! Boundary points should be updated
68         CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy )
69         CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy )
70      ENDDO
71      !
72
73   END SUBROUTINE bdy_tra
74
75   SUBROUTINE bdy_tra_frs( idx, dta, kt )
76      !!----------------------------------------------------------------------
77      !!                 ***  SUBROUTINE bdy_tra_frs  ***
78      !!                   
79      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.
80      !!
81      !! Reference : Engedahl H., 1995, Tellus, 365-382.
82      !!----------------------------------------------------------------------
83      INTEGER,         INTENT(in) ::   kt
84      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
85      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
86      !!
87      REAL(wp) ::   zwgt           ! boundary weight
88      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
89      INTEGER  ::   ii, ij         ! 2D addresses
90      !!----------------------------------------------------------------------
91      !
92      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs')
93      !
94      igrd = 1                       ! Everything is at T-points here
95      DO ib = 1, idx%nblen(igrd)
96         DO ik = 1, jpkm1
97            ii = idx%nbi(ib,igrd)
98            ij = idx%nbj(ib,igrd)
99            zwgt = idx%nbw(ib,igrd)
100            tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik)         
101            tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik)
102         END DO
103      END DO 
104      !
105      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
106      !
107      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs')
108      !
109   END SUBROUTINE bdy_tra_frs
110 
111   SUBROUTINE bdy_tra_spe( idx, dta, kt )
112      !!----------------------------------------------------------------------
113      !!                 ***  SUBROUTINE bdy_tra_frs  ***
114      !!                   
115      !! ** Purpose : Apply a specified value for tracers at open boundaries.
116      !!
117      !!----------------------------------------------------------------------
118      INTEGER,         INTENT(in) ::   kt
119      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
120      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
121      !!
122      REAL(wp) ::   zwgt           ! boundary weight
123      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
124      INTEGER  ::   ii, ij         ! 2D addresses
125      !!----------------------------------------------------------------------
126      !
127      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe')
128      !
129      igrd = 1                       ! Everything is at T-points here
130      DO ib = 1, idx%nblenrim(igrd)
131         ii = idx%nbi(ib,igrd)
132         ij = idx%nbj(ib,igrd)
133         DO ik = 1, jpkm1
134            tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik)
135            tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik)
136         END DO
137      END DO
138      !
139      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
140      !
141      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe')
142      !
143   END SUBROUTINE bdy_tra_spe
144
145   SUBROUTINE bdy_tra_nmn( idx, dta, kt )
146      !!----------------------------------------------------------------------
147      !!                 ***  SUBROUTINE bdy_tra_nmn  ***
148      !!                   
149      !! ** Purpose : Duplicate the value for tracers at open boundaries.
150      !!
151      !!----------------------------------------------------------------------
152      INTEGER,         INTENT(in) ::   kt
153      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
154      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
155      !!
156      REAL(wp) ::   zwgt           ! boundary weight
157      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
158      INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses
159      !!----------------------------------------------------------------------
160      !
161      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn')
162      !
163      igrd = 1                       ! Everything is at T-points here
164      DO ib = 1, idx%nblenrim(igrd)
165         ii = idx%nbi(ib,igrd)
166         ij = idx%nbj(ib,igrd)
167         DO ik = 1, jpkm1
168            ! search the sense of the gradient
169            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
170            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
171            IF ( zcoef1+zcoef2 == 0) THEN
172               ! corner
173               zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik)
174               tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij  ,ik,jp_tem) * tmask(ii-1,ij  ,ik) + &
175                 &                    tsa(ii+1,ij  ,ik,jp_tem) * tmask(ii+1,ij  ,ik) + &
176                 &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + &
177                 &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik)
178               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
179               tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + &
180                 &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + &
181                 &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + &
182                 &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik)
183               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
184            ELSE
185               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
186               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
187               tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik)
188               tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik)
189            ENDIF
190         END DO
191      END DO
192      !
193      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
194      !
195      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn')
196      !
197   END SUBROUTINE bdy_tra_nmn
198
199   SUBROUTINE bdy_tra_rnf( idx, dta, kt )
200      !!----------------------------------------------------------------------
201      !!                 ***  SUBROUTINE bdy_tra_rnf  ***
202      !!                   
203      !! ** Purpose : Apply the runoff values for tracers at open boundaries:
204      !!                  - specified to 0.1 PSU for the salinity
205      !!                  - duplicate the value for the temperature
206      !!
207      !!----------------------------------------------------------------------
208      INTEGER,         INTENT(in) ::   kt
209      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
210      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
211      !!
212      REAL(wp) ::   zwgt           ! boundary weight
213      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
214      INTEGER  ::   ii, ij, ip, jp ! 2D addresses
215      !!----------------------------------------------------------------------
216      !
217      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf')
218      !
219      igrd = 1                       ! Everything is at T-points here
220      DO ib = 1, idx%nblenrim(igrd)
221         ii = idx%nbi(ib,igrd)
222         ij = idx%nbj(ib,igrd)
223         DO ik = 1, jpkm1
224            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
225            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
226            tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik)
227            tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik)
228         END DO
229      END DO
230      !
231      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
232      !
233      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf')
234      !
235   END SUBROUTINE bdy_tra_rnf
236
237   SUBROUTINE bdy_tra_dmp( kt )
238      !!----------------------------------------------------------------------
239      !!                 ***  SUBROUTINE bdy_tra_dmp  ***
240      !!                   
241      !! ** Purpose : Apply damping for tracers at open boundaries.
242      !!
243      !!----------------------------------------------------------------------
244      INTEGER,         INTENT(in) ::   kt
245      !!
246      REAL(wp) ::   zwgt           ! boundary weight
247      REAL(wp) ::   zta, zsa, ztime
248      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
249      INTEGER  ::   ii, ij         ! 2D addresses
250      INTEGER  ::   ib_bdy         ! Loop index
251      !!----------------------------------------------------------------------
252      !
253      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp')
254      !
255      DO ib_bdy=1, nb_bdy
256         IF ( ln_tra_dmp(ib_bdy) ) 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 * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)
264                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)
265                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta
266                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa
267               END DO
268            END DO
269         ENDIF
270      ENDDO
271      !
272      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp')
273      !
274   END SUBROUTINE bdy_tra_dmp
275 
276#else
277   !!----------------------------------------------------------------------
278   !!   Dummy module                   NO Unstruct Open Boundary Conditions
279   !!----------------------------------------------------------------------
280CONTAINS
281   SUBROUTINE bdy_tra(kt)      ! Empty routine
282      WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt
283   END SUBROUTINE bdy_tra
284
285   SUBROUTINE bdy_tra_dmp(kt)      ! Empty routine
286      WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt
287   END SUBROUTINE bdy_tra_dmp
288
289#endif
290
291   !!======================================================================
292END MODULE bdytra
Note: See TracBrowser for help on using the repository browser.