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/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90 @ 6060

Last change on this file since 6060 was 6060, checked in by timgraham, 8 years ago

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch
  • Property svn:keywords set to Id
File size: 14.6 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 oce            ! ocean dynamics and tracers variables
19   USE dom_oce        ! ocean space and time domain variables
20   USE bdy_oce        ! ocean open boundary conditions
21   USE bdylib         ! for orlanski library routines
22   USE bdydta   , ONLY:   bf   !
23   !
24   USE in_out_manager ! I/O manager
25   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
26   USE timing         ! Timing
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   bdy_tra      ! called in tranxt.F90
32   PUBLIC   bdy_tra_dmp  ! called in step.F90
33
34   !!----------------------------------------------------------------------
35   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
36   !! $Id$
37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE bdy_tra( kt )
42      !!----------------------------------------------------------------------
43      !!                  ***  SUBROUTINE bdy_tra  ***
44      !!
45      !! ** Purpose : - Apply open boundary conditions for temperature and salinity
46      !!
47      !!----------------------------------------------------------------------
48      INTEGER, INTENT(in) ::   kt   ! Main time step counter
49      !
50      INTEGER ::   ib_bdy   ! Loop index
51      !!----------------------------------------------------------------------
52
53      DO ib_bdy=1, nb_bdy
54         !
55         SELECT CASE( cn_tra(ib_bdy) )
56         CASE('none'        )   ;   CYCLE
57         CASE('frs'         )   ;   CALL bdy_tra_frs     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
58         CASE('specified'   )   ;   CALL bdy_tra_spe     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
59         CASE('neumann'     )   ;   CALL bdy_tra_nmn     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
60         CASE('orlanski'    )   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. )
61         CASE('orlanski_npo')   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. )
62         CASE('runoff'      )   ;   CALL bdy_tra_rnf     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
63         CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
64         END SELECT
65         ! Boundary points should be updated
66         CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy )
67         CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy )
68      END DO
69      !
70   END SUBROUTINE bdy_tra
71
72
73   SUBROUTINE bdy_tra_frs( idx, dta, kt )
74      !!----------------------------------------------------------------------
75      !!                 ***  SUBROUTINE bdy_tra_frs  ***
76      !!                   
77      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.
78      !!
79      !! Reference : Engedahl H., 1995, Tellus, 365-382.
80      !!----------------------------------------------------------------------
81      INTEGER,         INTENT(in) ::   kt    !
82      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices
83      TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data
84      !
85      REAL(wp) ::   zwgt           ! boundary weight
86      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
87      INTEGER  ::   ii, ij         ! 2D addresses
88      !!----------------------------------------------------------------------
89      !
90      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_frs')
91      !
92      igrd = 1                       ! Everything is at T-points here
93      DO ib = 1, idx%nblen(igrd)
94         DO ik = 1, jpkm1
95            ii = idx%nbi(ib,igrd)
96            ij = idx%nbj(ib,igrd)
97            zwgt = idx%nbw(ib,igrd)
98            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)         
99            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)
100         END DO
101      END DO 
102      !
103      IF( kt .eq. nit000 )   CLOSE( unit = 102 )
104      !
105      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_frs')
106      !
107   END SUBROUTINE bdy_tra_frs
108
109
110   SUBROUTINE bdy_tra_spe( idx, dta, kt )
111      !!----------------------------------------------------------------------
112      !!                 ***  SUBROUTINE bdy_tra_frs  ***
113      !!                   
114      !! ** Purpose : Apply a specified value for tracers at open boundaries.
115      !!
116      !!----------------------------------------------------------------------
117      INTEGER,         INTENT(in) ::   kt    !
118      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices
119      TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data
120      !
121      REAL(wp) ::   zwgt           ! boundary weight
122      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
123      INTEGER  ::   ii, ij         ! 2D addresses
124      !!----------------------------------------------------------------------
125      !
126      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe')
127      !
128      igrd = 1                       ! Everything is at T-points here
129      DO ib = 1, idx%nblenrim(igrd)
130         ii = idx%nbi(ib,igrd)
131         ij = idx%nbj(ib,igrd)
132         DO ik = 1, jpkm1
133            tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik)
134            tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik)
135         END DO
136      END DO
137      !
138      IF( kt == nit000 )   CLOSE( unit = 102 )
139      !
140      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_spe')
141      !
142   END SUBROUTINE bdy_tra_spe
143
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 == 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
200   SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo )
201      !!----------------------------------------------------------------------
202      !!                 ***  SUBROUTINE bdy_tra_orlanski  ***
203      !!             
204      !!              - Apply Orlanski radiation to temperature and salinity.
205      !!              - Wrapper routine for bdy_orlanski_3d
206      !!
207      !!
208      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)   
209      !!----------------------------------------------------------------------
210      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
211      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
212      LOGICAL        , INTENT(in) ::   ll_npo  ! switch for NPO version
213      !
214      INTEGER  ::   igrd                                    ! grid index
215      !!----------------------------------------------------------------------
216      !
217      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski')
218      !
219      igrd = 1      ! Orlanski bc on temperature;
220      !           
221      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo )
222
223      igrd = 1      ! Orlanski bc on salinity;
224      ! 
225      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo )
226      !
227      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_orlanski')
228      !
229   END SUBROUTINE bdy_tra_orlanski
230
231
232   SUBROUTINE bdy_tra_rnf( idx, dta, kt )
233      !!----------------------------------------------------------------------
234      !!                 ***  SUBROUTINE bdy_tra_rnf  ***
235      !!                   
236      !! ** Purpose : Apply the runoff values for tracers at open boundaries:
237      !!                  - specified to 0.1 PSU for the salinity
238      !!                  - duplicate the value for the temperature
239      !!
240      !!----------------------------------------------------------------------
241      INTEGER        , INTENT(in) ::   kt    !
242      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices
243      TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data
244      !
245      REAL(wp) ::   zwgt           ! boundary weight
246      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
247      INTEGER  ::   ii, ij, ip, jp ! 2D addresses
248      !!----------------------------------------------------------------------
249      !
250      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_rnf')
251      !
252      igrd = 1                       ! Everything is at T-points here
253      DO ib = 1, idx%nblenrim(igrd)
254         ii = idx%nbi(ib,igrd)
255         ij = idx%nbj(ib,igrd)
256         DO ik = 1, jpkm1
257            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
258            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
259            tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik)
260            tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik)
261         END DO
262      END DO
263      !
264      IF( kt == nit000 )   CLOSE( unit = 102 )
265      !
266      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_rnf')
267      !
268   END SUBROUTINE bdy_tra_rnf
269
270
271   SUBROUTINE bdy_tra_dmp( kt )
272      !!----------------------------------------------------------------------
273      !!                 ***  SUBROUTINE bdy_tra_dmp  ***
274      !!                   
275      !! ** Purpose : Apply damping for tracers at open boundaries.
276      !!
277      !!----------------------------------------------------------------------
278      INTEGER, INTENT(in) ::   kt   !
279      !
280      REAL(wp) ::   zwgt           ! boundary weight
281      REAL(wp) ::   zta, zsa, ztime
282      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
283      INTEGER  ::   ii, ij         ! 2D addresses
284      INTEGER  ::   ib_bdy         ! Loop index
285      !!----------------------------------------------------------------------
286      !
287      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_dmp')
288      !
289      DO ib_bdy = 1, nb_bdy
290         IF( ln_tra_dmp(ib_bdy) ) THEN
291            igrd = 1                       ! Everything is at T-points here
292            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
293               ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
294               ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
295               zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
296               DO ik = 1, jpkm1
297                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)
298                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)
299                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta
300                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa
301               END DO
302            END DO
303         ENDIF
304      END DO
305      !
306      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_dmp')
307      !
308   END SUBROUTINE bdy_tra_dmp
309 
310#else
311   !!----------------------------------------------------------------------
312   !!   Dummy module                   NO Unstruct Open Boundary Conditions
313   !!----------------------------------------------------------------------
314CONTAINS
315   SUBROUTINE bdy_tra(kt)      ! Empty routine
316      WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt
317   END SUBROUTINE bdy_tra
318
319   SUBROUTINE bdy_tra_dmp(kt)      ! Empty routine
320      WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt
321   END SUBROUTINE bdy_tra_dmp
322#endif
323
324   !!======================================================================
325END MODULE bdytra
Note: See TracBrowser for help on using the repository browser.