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 trunk/NEMO/OPA_SRC/OBC – NEMO

source: trunk/NEMO/OPA_SRC/OBC/obctra.F90 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision

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