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/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90 @ 3680

Last change on this file since 3680 was 3680, checked in by rblod, 11 years ago

First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028

  • Property svn:keywords set to Id
File size: 13.0 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, ib_bdy )
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      ENDDO
68      !
69      ! Boundary points should be updated
70      IF (nb_bdy>0) CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
71      IF (nb_bdy>0) CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
72
73   END SUBROUTINE bdy_tra
74
75   SUBROUTINE bdy_tra_frs( idx, dta, kt, ib_bdy )
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      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
87      !!
88      REAL(wp) ::   zwgt           ! boundary weight
89      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
90      INTEGER  ::   ii, ij         ! 2D addresses
91      !!----------------------------------------------------------------------
92      !
93      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs')
94      !
95      igrd = 1                       ! Everything is at T-points here
96      DO ib = 1, idx%nblen(igrd)
97         DO ik = 1, jpkm1
98            ii = idx%nbi(ib,igrd)
99            ij = idx%nbj(ib,igrd)
100            zwgt = idx%nbw(ib,igrd)
101            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)         
102            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)
103         END DO
104      END DO
105      CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy )   ; CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy )    ! Boundary points should be updated
106      !
107      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
108      !
109      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs')
110      !
111   END SUBROUTINE bdy_tra_frs
112 
113   SUBROUTINE bdy_tra_spe( idx, dta, kt )
114      !!----------------------------------------------------------------------
115      !!                 ***  SUBROUTINE bdy_tra_frs  ***
116      !!                   
117      !! ** Purpose : Apply a specified value for tracers at open boundaries.
118      !!
119      !!----------------------------------------------------------------------
120      INTEGER,         INTENT(in) ::   kt
121      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
122      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
123      !!
124      REAL(wp) ::   zwgt           ! boundary weight
125      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
126      INTEGER  ::   ii, ij         ! 2D addresses
127      !!----------------------------------------------------------------------
128      !
129      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe')
130      !
131      igrd = 1                       ! Everything is at T-points here
132      DO ib = 1, idx%nblenrim(igrd)
133         ii = idx%nbi(ib,igrd)
134         ij = idx%nbj(ib,igrd)
135         DO ik = 1, jpkm1
136            tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik)
137            tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik)
138         END DO
139      END DO
140      !
141      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
142      !
143      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe')
144      !
145   END SUBROUTINE bdy_tra_spe
146
147   SUBROUTINE bdy_tra_nmn( idx, dta, kt )
148      !!----------------------------------------------------------------------
149      !!                 ***  SUBROUTINE bdy_tra_nmn  ***
150      !!                   
151      !! ** Purpose : Duplicate the value for tracers at open boundaries.
152      !!
153      !!----------------------------------------------------------------------
154      INTEGER,         INTENT(in) ::   kt
155      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
156      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
157      !!
158      REAL(wp) ::   zwgt           ! boundary weight
159      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
160      INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses
161      !!----------------------------------------------------------------------
162      !
163      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn')
164      !
165      igrd = 1                       ! Everything is at T-points here
166      DO ib = 1, idx%nblenrim(igrd)
167         ii = idx%nbi(ib,igrd)
168         ij = idx%nbj(ib,igrd)
169         DO ik = 1, jpkm1
170            ! search the sense of the gradient
171            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
172            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
173            IF ( zcoef1+zcoef2 == 0) THEN
174               ! corner
175               zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik)
176               tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij  ,ik,jp_tem) * tmask(ii-1,ij  ,ik) + &
177                 &                    tsa(ii+1,ij  ,ik,jp_tem) * tmask(ii+1,ij  ,ik) + &
178                 &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + &
179                 &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik)
180               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
181               tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + &
182                 &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + &
183                 &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + &
184                 &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik)
185               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik)
186            ELSE
187               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
188               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
189               tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik)
190               tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik)
191            ENDIF
192         END DO
193      END DO
194      !
195      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
196      !
197      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn')
198      !
199   END SUBROUTINE bdy_tra_nmn
200
201   SUBROUTINE bdy_tra_rnf( idx, dta, kt )
202      !!----------------------------------------------------------------------
203      !!                 ***  SUBROUTINE bdy_tra_rnf  ***
204      !!                   
205      !! ** Purpose : Apply the runoff values for tracers at open boundaries:
206      !!                  - specified to 0.1 PSU for the salinity
207      !!                  - duplicate the value for the temperature
208      !!
209      !!----------------------------------------------------------------------
210      INTEGER,         INTENT(in) ::   kt
211      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
212      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
213      !!
214      REAL(wp) ::   zwgt           ! boundary weight
215      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
216      INTEGER  ::   ii, ij, ip, jp ! 2D addresses
217      !!----------------------------------------------------------------------
218      !
219      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf')
220      !
221      igrd = 1                       ! Everything is at T-points here
222      DO ib = 1, idx%nblenrim(igrd)
223         ii = idx%nbi(ib,igrd)
224         ij = idx%nbj(ib,igrd)
225         DO ik = 1, jpkm1
226            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
227            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
228            tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik)
229            tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik)
230         END DO
231      END DO
232      !
233      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
234      !
235      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf')
236      !
237   END SUBROUTINE bdy_tra_rnf
238
239   SUBROUTINE bdy_tra_dmp( kt )
240      !!----------------------------------------------------------------------
241      !!                 ***  SUBROUTINE bdy_tra_dmp  ***
242      !!                   
243      !! ** Purpose : Apply damping for tracers at open boundaries.
244      !!
245      !!----------------------------------------------------------------------
246      INTEGER,         INTENT(in) ::   kt
247      !!
248      REAL(wp) ::   zwgt           ! boundary weight
249      REAL(wp) ::   zta, zsa, ztime
250      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
251      INTEGER  ::   ii, ij         ! 2D addresses
252      INTEGER  ::   ib_bdy         ! Loop index
253      !!----------------------------------------------------------------------
254      !
255      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp')
256      !
257      DO ib_bdy=1, nb_bdy
258         IF ( ln_tra_dmp(ib_bdy) ) 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 * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)
266                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)
267                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta
268                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa
269               END DO
270            END DO
271         ENDIF
272      ENDDO
273      !
274      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp')
275      !
276   END SUBROUTINE bdy_tra_dmp
277 
278#else
279   !!----------------------------------------------------------------------
280   !!   Dummy module                   NO Unstruct Open Boundary Conditions
281   !!----------------------------------------------------------------------
282CONTAINS
283   SUBROUTINE bdy_tra(kt)      ! Empty routine
284      WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt
285   END SUBROUTINE bdy_tra
286
287   SUBROUTINE bdy_tra_dmp(kt)      ! Empty routine
288      WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt
289   END SUBROUTINE bdy_tra_dmp
290
291#endif
292
293   !!======================================================================
294END MODULE bdytra
Note: See TracBrowser for help on using the repository browser.