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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90 @ 4400

Last change on this file since 4400 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

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