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.
obctra.F90 in branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90 @ 3592

Last change on this file since 3592 was 3592, checked in by vichi, 11 years ago

OBC and BDY optimization by CMCC

Also Added ARCH/CMCC folder with PW6_calypso archfiles.

The CMCC achitecture files for calypso are :

  • PW6_calypso fro compiling NEMO release configuration
  • PW6_calypso_debug for debugging NEMO
  • PW6_calypso_tools to compile toolswith xlf90 for serial job
  • Property svn:keywords set to Id
File size: 23.5 KB
Line 
1MODULE obctra
2   !!=================================================================================
3   !!                       ***  MODULE  obctra  ***
4   !! Ocean tracers:   Radiation of tracers on each open boundary
5   !!=================================================================================
6   !! History :  3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the
7   !!                             optimization of OBC communications
8#if defined key_obc
9   !!---------------------------------------------------------------------------------
10   !!   'key_obc'      :                                      Open Boundary Conditions
11   !!---------------------------------------------------------------------------------
12   !!   obc_tra        : call the subroutine for each open boundary
13   !!   obc_tra_east   : radiation of the east open boundary tracers
14   !!   obc_tra_west   : radiation of the west open boundary tracers
15   !!   obc_tra_north  : radiation of the north open boundary tracers
16   !!   obc_tra_south  : radiation of the south open boundary tracers
17   !!----------------------------------------------------------------------------------
18   !! * Modules used
19   USE oce             ! ocean dynamics and tracers variables
20   USE dom_oce         ! ocean space and time domain variables
21   USE phycst          ! physical constants
22   USE obc_oce         ! ocean open boundary conditions
23   USE lib_mpp         ! ???
24   USE lbclnk          ! ???
25   USE in_out_manager  ! I/O manager
26
27   IMPLICIT NONE
28   PRIVATE
29
30   !! * Accessibility
31   PUBLIC obc_tra     ! routine called in tranxt.F90
32
33   !! * Module variables
34   INTEGER ::      & ! ... boundary space indices
35      nib   = 1,   & ! nib   = boundary point
36      nibm  = 2,   & ! nibm  = 1st interior point
37      nibm2 = 3,   & ! nibm2 = 2nd interior point
38                     ! ... boundary time indices
39      nit   = 1,   & ! nit    = now
40      nitm  = 2,   & ! nitm   = before
41      nitm2 = 3      ! nitm2  = before-before
42
43   REAL(wp) ::     &
44      rtaue  , rtauw  , rtaun  , rtaus  ,  &  ! Boundary restoring coefficient
45      rtauein, rtauwin, rtaunin, rtausin      ! Boundary restoring coefficient for inflow
46
47   !! * Substitutions
48#  include "obc_vectopt_loop_substitute.h90"
49   !!---------------------------------------------------------------------------------
50   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
51   !! $Id$
52   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
53   !!---------------------------------------------------------------------------------
54
55CONTAINS
56
57   SUBROUTINE obc_tra( kt )
58      !!-------------------------------------------------------------------------------
59      !!                 ***  SUBROUTINE obc_tra  ***
60      !!                   
61      !! ** Purpose :   Compute tracer fields (t,s) along the open boundaries.
62      !!      This routine is called by the tranxt.F routine and updates tsa
63      !!      which are the actual temperature and salinity fields.
64      !!        The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
65      !!      and/or lp_obc_south allow the user to determine which boundary is an
66      !!      open one (must be done in the param_obc.h90 file).
67      !!
68      !! Reference :
69      !!   Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
70      !!
71      !!  History :
72      !!        !  95-03 (J.-M. Molines) Original, SPEM
73      !!        !  97-07 (G. Madec, J.-M. Molines) addition
74      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) F90
75      !!----------------------------------------------------------------------
76      !! * Arguments
77      INTEGER, INTENT( in ) ::   kt
78      !!----------------------------------------------------------------------
79
80      ! 0. Local constant initialization
81
82      IF( kt == nit000 .OR. ln_rstart) THEN
83         ! ... Boundary restoring coefficient
84         rtaue = 2. * rdt / rdpeob
85         rtauw = 2. * rdt / rdpwob
86         rtaun = 2. * rdt / rdpnob
87         rtaus = 2. * rdt / rdpsob
88         ! ... Boundary restoring coefficient for inflow ( all boundaries)
89         rtauein = 2. * rdt / rdpein 
90         rtauwin = 2. * rdt / rdpwin
91         rtaunin = 2. * rdt / rdpnin
92         rtausin = 2. * rdt / rdpsin 
93      END IF
94
95      IF( lp_obc_east  )   CALL obc_tra_east ( kt )    ! East open boundary
96
97      IF( lp_obc_west  )   CALL obc_tra_west ( kt )    ! West open boundary
98
99      IF( lp_obc_north )   CALL obc_tra_north( kt )    ! North open boundary
100
101      IF( lp_obc_south )   CALL obc_tra_south( kt )    ! South open boundary
102
103      IF( lk_mpp ) THEN                  !!bug ???
104         IF( kt >= nit000+3 .AND. ln_rstart ) THEN
105            CALL lbc_obc_lnk( tsb(:,:,:,jp_tem), 'T', 1. )
106            CALL lbc_obc_lnk( tsb(:,:,:,jp_sal), 'T', 1. )
107         END IF
108         CALL lbc_obc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
109         CALL lbc_obc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
110      ENDIF
111
112   END SUBROUTINE obc_tra
113
114
115   SUBROUTINE obc_tra_east ( kt )
116      !!------------------------------------------------------------------------------
117      !!                ***  SUBROUTINE obc_tra_east  ***
118      !!                 
119      !! ** Purpose :
120      !!      Apply the radiation algorithm on east OBC tracers tsa using the
121      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module
122      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
123      !!
124      !!  History :
125      !!         ! 95-03 (J.-M. Molines) Original from SPEM
126      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
127      !!         ! 97-12 (M. Imbard) Mpp adaptation
128      !!         ! 00-06 (J.-M. Molines)
129      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
130      !!------------------------------------------------------------------------------
131      !! * Arguments
132      INTEGER, INTENT( in ) ::   kt
133
134      !! * Local declaration
135      INTEGER ::   ji, jj, jk      ! dummy loop indices
136      REAL(wp) ::   z05cx, ztau, zin
137      !!------------------------------------------------------------------------------
138
139      ! 1. First three time steps and more if lfbceast is .TRUE.
140      !    In that case open boundary conditions are FIXED.
141      ! --------------------------------------------------------
142
143      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN
144         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
145            DO jk = 1, jpkm1
146               DO jj = 1, jpj
147                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) + &
148                                         tfoe(jj,jk)*temsk(jj,jk)
149                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) + &
150                                         sfoe(jj,jk)*temsk(jj,jk)
151               END DO
152            END DO
153         END DO
154
155      ELSE
156
157      ! 2. Beyond the fourth time step if lfbceast is .FALSE.
158      ! -----------------------------------------------------
159
160         ! Temperature and salinity radiation
161         ! ----------------------------------
162         !
163         !            nibm2      nibm      nib
164         !              |   nibm  |   nib///|///
165         !              |    |    |    |////|///
166         !  jj   line --v----f----v----f----v---
167         !              |    |    |    |////|///
168         !                   |         |///   //
169         !  jj   line   T    u    T    u/// T //
170         !                   |         |///   //
171         !              |    |    |    |////|///
172         !  jj-1 line --v----f----v----f----v---
173         !              |    |    |    |////|///
174         !                jpieob-1    jpieob / ///
175         !              |         |         |
176         !           jpieob-1    jpieob     jpieob+1
177         !
178         ! ... radiative conditions + relaxation toward a climatology
179         !     the phase velocity is taken as the phase velocity of the tangen-
180         !     tial velocity (here vn), which have been saved in (u_cxebnd,v_cxebnd)
181         ! ... (jpjedp1, jpjefm1), jpieob+1
182         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
183            DO jk = 1, jpkm1
184               DO jj = 2, jpjm1
185         ! ... i-phase speed ratio (from averaged of v_cxebnd)
186                  z05cx = ( 0.5 * ( v_cxebnd(jj,jk) + v_cxebnd(jj-1,jk) ) ) / e1t(ji-1,jj)
187                  z05cx = min( z05cx, 1. )
188         ! ... z05cx=< 0, inflow  zin=0, ztau=1   
189         !           > 0, outflow zin=1, ztau=rtaue
190                  zin = sign( 1., z05cx )
191                  zin = 0.5*( zin + abs(zin) )
192         ! ... for inflow rtauein is used for relaxation coefficient else rtaue
193                  ztau = (1.-zin ) * rtauein  + zin * rtaue
194                  z05cx = z05cx * zin
195         ! ... update tsa with radiative or climatological ts
196                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) +           &
197                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
198                                 * tebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
199                                 * tebnd(jj,jk,nibm,nit ) + ztau * tfoe (jj,jk) ) &
200                                 / (1. + z05cx)
201                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) +           &
202                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
203                                 * sebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
204                                 * sebnd(jj,jk,nibm,nit ) + ztau * sfoe (jj,jk) ) &
205                                 / (1. + z05cx)
206               END DO
207            END DO
208         END DO
209
210      END IF
211
212   END SUBROUTINE obc_tra_east
213
214
215   SUBROUTINE obc_tra_west ( kt )
216      !!------------------------------------------------------------------------------
217      !!                 ***  SUBROUTINE obc_tra_west  ***
218      !!           
219      !! ** Purpose :
220      !!      Apply the radiation algorithm on west OBC tracers tsa using the
221      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module
222      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
223      !!
224      !!  History :
225      !!         ! 95-03 (J.-M. Molines) Original from SPEM
226      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
227      !!         ! 97-12 (M. Imbard) Mpp adaptation
228      !!         ! 00-06 (J.-M. Molines)
229      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
230      !!------------------------------------------------------------------------------
231      !! * Arguments
232      INTEGER, INTENT( in ) ::   kt
233
234      !! * Local declaration
235      INTEGER ::   ji, jj, jk      ! dummy loop indices
236      REAL(wp) ::   z05cx, ztau, zin
237      !!------------------------------------------------------------------------------
238
239      ! 1. First three time steps and more if lfbcwest is .TRUE.
240      !    In that case open boundary conditions are FIXED.
241      ! --------------------------------------------------------
242
243      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN
244
245         DO ji = fs_niw0, fs_niw1 ! Vector opt.
246            DO jk = 1, jpkm1
247               DO jj = 1, jpj
248                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) + &
249                                         tfow(jj,jk)*twmsk(jj,jk)
250                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) + &
251                                         sfow(jj,jk)*twmsk(jj,jk)
252               END DO
253            END DO
254         END DO
255
256      ELSE
257
258      ! 2. Beyond the fourth time step if lfbcwest is .FALSE.
259      ! -----------------------------------------------------
260         
261         ! Temperature and salinity radiation
262         ! ----------------------------------
263         !
264         !          nib       nibm     nibm2
265         !     nib///|   nibm  |  nibm2  |
266         !   ///|////|    |    |    |    |   
267         !   ---v----f----v----f----v----f-- jj   line
268         !   ///|////|    |    |    |    |   
269         !   //   ///|         |         |   
270         !   // T ///u    T    u    T    u   jj   line
271         !   //   ///|         |         |   
272         !   ///|////|    |    |    |    |   
273         !   ---v----f----v----f----v----f-- jj-1 line
274         !   ///|////|    |    |    |    |   
275         !         jpiwob    jpiwob+1    jpiwob+2
276         !      |         |         |       
277         !    jpiwob    jpiwob+1   jpiwob+2
278         !
279         ! ... radiative conditions + relaxation toward a climatology
280         ! ... the phase velocity is taken as the phase velocity of the tangen-
281         ! ... tial velocity (here vn), which have been saved in (v_cxwbnd)
282         DO ji = fs_niw0, fs_niw1 ! Vector opt.
283            DO jk = 1, jpkm1
284               DO jj = 2, jpjm1
285         ! ... i-phase speed ratio (from averaged of v_cxwbnd)
286                  z05cx = (  0.5 * ( v_cxwbnd(jj,jk) + v_cxwbnd(jj-1,jk) ) ) / e1t(ji+1,jj)
287                  z05cx = max( z05cx, -1. )
288         ! ... z05cx > 0, inflow  zin=0, ztau=1   
289         !           < 0, outflow zin=1, ztau=rtauw
290                  zin = sign( 1., -1.* z05cx )
291                  zin = 0.5*( zin + abs(zin) )
292                  ztau = (1.-zin )*rtauwin + zin * rtauw
293                  z05cx = z05cx * zin
294         ! ... update tsa with radiative or climatological (ts)
295                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) +           &
296                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
297                                 * twbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
298                                 * twbnd(jj,jk,nibm,nit ) + ztau * tfow (jj,jk) ) &
299                                 / (1. - z05cx)
300                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) +           &
301                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
302                                 * swbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
303                                 * swbnd(jj,jk,nibm,nit ) + ztau * sfow (jj,jk) ) &
304                                 / (1. - z05cx)
305               END DO
306            END DO
307         END DO
308
309      END IF
310
311   END SUBROUTINE obc_tra_west
312
313
314   SUBROUTINE obc_tra_north ( kt )
315      !!------------------------------------------------------------------------------
316      !!                 ***  SUBROUTINE obc_tra_north  ***
317      !!
318      !! ** Purpose :
319      !!      Apply the radiation algorithm on north OBC tracers ta, sa using the
320      !!      phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module
321      !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
322      !!
323      !!  History :
324      !!         ! 95-03 (J.-M. Molines) Original from SPEM
325      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
326      !!         ! 97-12 (M. Imbard) Mpp adaptation
327      !!         ! 00-06 (J.-M. Molines)
328      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
329      !!------------------------------------------------------------------------------
330      !! * Arguments
331      INTEGER, INTENT( in ) ::   kt
332
333      !! * Local declaration
334      INTEGER ::   ji, jj, jk      ! dummy loop indices
335      REAL(wp) ::   z05cx, ztau, zin
336      !!------------------------------------------------------------------------------
337
338      ! 1. First three time steps and more if lfbcnorth is .TRUE.
339      !    In that case open boundary conditions are FIXED.
340      ! --------------------------------------------------------
341
342      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN
343
344         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
345            DO jk = 1, jpkm1
346               DO ji = 1, jpi
347                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) + &
348                                        tnmsk(ji,jk) * tfon(ji,jk)
349                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) + &
350                                        tnmsk(ji,jk) * sfon(ji,jk)
351               END DO
352            END DO
353         END DO
354
355      ELSE
356
357      ! 2. Beyond the fourth time step if lfbcnorth is .FALSE.
358      ! -------------------------------------------------------
359         
360         ! Temperature and salinity radiation
361         ! ----------------------------------
362         !
363         !           ji-1   ji   ji   ji +1
364         !             |
365         !    nib //// u // T // u // T //   jpjnob + 1
366         !        /////|//////////////////
367         !    nib  ----f----v----f----v---   jpjnob
368         !             |         |       
369         !      nibm-- u -- T -- u -- T --   jpjnob
370         !             |         |           
371         !   nibm  ----f----v----f----v---  jpjnob-1
372         !             |         |     
373         !     nibm2-- u -- T -- T -- T --  jpjnob-1
374         !             |         |   
375         !   nibm2 ----f----v----f----v---  jpjnob-2
376         !             |         |
377         !
378         ! ... radiative conditions + relaxation toward a climatology
379         ! ... the phase velocity is taken as the normal phase velocity of the tangen-
380         ! ... tial velocity (here un), which has been saved in (u_cynbnd)
381         ! ... jpjnob+1,(jpindp1, jpinfm1)
382         DO jj = fs_njn0+1, fs_njn1+1 ! Vector opt.
383            DO jk = 1, jpkm1
384               DO ji = 2, jpim1
385         ! ... j-phase speed ratio (from averaged of vtnbnd)
386         !        (bounded by 1)
387                  z05cx = ( 0.5 * ( u_cynbnd(ji,jk) + u_cynbnd(ji-1,jk) ) ) / e2t(ji,jj-1)
388                  z05cx = min( z05cx, 1. )
389         ! ... z05cx=< 0, inflow  zin=0, ztau=1   
390         !           > 0, outflow zin=1, ztau=rtaun
391                  zin = sign( 1., z05cx )
392                  zin = 0.5*( zin + abs(zin) )
393         ! ... for inflow rtaunin is used for relaxation coefficient else rtaun
394                  ztau = (1.-zin ) * rtaunin + zin * rtaun
395                  z05cx = z05cx * zin
396         ! ... update tsa with radiative or climatological (t, s)
397                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) +             &
398                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
399                                 * tnbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
400                                 * tnbnd(ji,jk,nibm,nit ) + ztau * tfon (ji,jk) ) &
401                                 / (1. + z05cx)
402                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) +             &
403                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
404                                 * snbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
405                                 * snbnd(ji,jk,nibm,nit ) + ztau * sfon (ji,jk) ) &
406                                 / (1. + z05cx)
407               END DO
408            END DO
409         END DO
410
411      END IF
412
413   END SUBROUTINE obc_tra_north
414
415
416   SUBROUTINE obc_tra_south ( kt )
417      !!------------------------------------------------------------------------------
418      !!                ***  SUBROUTINE obc_tra_south  ***
419      !!     
420      !! ** Purpose :
421      !!      Apply the radiation algorithm on south OBC tracers tsa using the
422      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module
423      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
424      !!
425      !!  History :
426      !!         ! 95-03 (J.-M. Molines) Original from SPEM
427      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
428      !!         ! 97-12 (M. Imbard) Mpp adaptation
429      !!         ! 00-06 (J.-M. Molines)
430      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
431      !!------------------------------------------------------------------------------
432      !! * Arguments
433      INTEGER, INTENT( in ) ::   kt
434
435      !! * Local declaration
436      INTEGER ::   ji, jj, jk      ! dummy loop indices
437      REAL(wp) ::   z05cx, ztau, zin
438      !!------------------------------------------------------------------------------
439
440      ! 1. First three time steps and more if lfbcsouth is .TRUE.
441      !    In that case open boundary conditions are FIXED.
442      ! --------------------------------------------------------
443
444      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN
445
446         DO jj = fs_njs0, fs_njs1  ! Vector opt.
447            DO jk = 1, jpkm1
448               DO ji = 1, jpi
449                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) + &
450                                        tsmsk(ji,jk) * tfos(ji,jk)
451                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) + &
452                                        tsmsk(ji,jk) * sfos(ji,jk)
453               END DO
454            END DO
455         END DO
456
457      ELSE
458
459      ! 2. Beyond the fourth time step if lfbcsouth is .FALSE.
460      ! -------------------------------------------------------
461         
462         ! Temperature and salinity radiation
463         ! ----------------------------------
464         !
465         !           ji-1   ji   ji   ji +1
466         !             |         |
467         !   nibm2 ----f----v----f----v---   jpjsob+2
468         !             |         |       
469         !   nibm2 --  u -- T -- u -- T --   jpjsob+2
470         !             |         |           
471         !   nibm  ----f----v----f----v---   jpjsob+1
472         !             |         |     
473         !    nibm --  u -- T -- T -- T --   jpjsob+1
474         !             |         |   
475         !   nib  -----f----v----f----v---   jpjsob
476         !       //////|/////////|////////
477         !    nib //// u // T // u // T //   jpjsob
478         !
479         !... radiative conditions + relaxation toward a climatology
480         !... the phase velocity is taken as the phase velocity of the tangen-
481         !... tial velocity (here un), which has been saved in (u_cysbnd)
482         !... jpjsob,(jpisdp1, jpisfm1)
483         DO jj = fs_njs0, fs_njs1  ! Vector opt.
484            DO jk = 1, jpkm1
485               DO ji = 2, jpim1
486         !... j-phase speed ratio (from averaged of u_cysbnd)
487         !       (bounded by 1)
488                  z05cx = ( 0.5 * ( u_cysbnd(ji,jk) + u_cysbnd(ji-1,jk) ) ) / e2t(ji,jj+1)
489                  z05cx = max( z05cx, -1. )
490         !... z05cx > 0, inflow  zin=0, ztau=1
491         !          < 0, outflow zin=1, ztau=rtaus
492                  zin = sign( 1., -1.* z05cx )
493                  zin = 0.5*( zin + abs(zin) )
494                  ztau = (1.-zin ) * rtausin + zin * rtaus
495                  z05cx = z05cx * zin
496
497         !... update tsa with radiative or climatological (t, s)
498                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) +             &
499                                 tsmsk(ji,jk) * ( ( 1. + z05cx - ztau )         &
500                                 * tsbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
501                                 * tsbnd(ji,jk,nibm,nit ) + ztau * tfos (ji,jk) ) &
502                                 / (1. - z05cx)
503                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) +             &
504                                 tsmsk(ji,jk) * (  ( 1. + z05cx - ztau )        &
505                                 * ssbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
506                                 * ssbnd(ji,jk,nibm,nit ) + ztau * sfos (ji,jk) ) &
507                                 / (1. - z05cx)
508               END DO
509            END DO
510         END DO
511
512      END IF   
513
514   END SUBROUTINE obc_tra_south
515
516#else
517   !!---------------------------------------------------------------------------------
518   !!   Default option                                                    Empty module
519   !!---------------------------------------------------------------------------------
520CONTAINS
521   SUBROUTINE obc_tra      ! Empty routine
522   END SUBROUTINE obc_tra
523#endif
524
525   !!=================================================================================
526END MODULE obctra
Note: See TracBrowser for help on using the repository browser.