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

source: branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90 @ 6862

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