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.
trasbc.F90 in NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/TRA – NEMO

source: NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/TRA/trasbc.F90 @ 15379

Last change on this file since 15379 was 15379, checked in by techene, 3 years ago

#2715 cosmetic changes
  • Property svn:keywords set to Id
File size: 21.6 KB
Line 
1MODULE trasbc
2   !!==============================================================================
3   !!                       ***  MODULE  trasbc  ***
4   !! Ocean active tracers:  surface boundary condition
5   !!==============================================================================
6   !! History :  OPA  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
7   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
8   !!  NEMO      1.0  !  2002-06  (G. Madec)  F90: Free form and module
9   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
10   !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
11   !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing
12   !!            4.1  !  2019-09  (P. Mathiot) isf moved in traisf
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   tra_sbc       : update the tracer trend at ocean surface
17   !!----------------------------------------------------------------------
18   USE oce            ! ocean dynamics and active tracers
19   USE sbc_oce        ! surface boundary condition: ocean
20   USE dom_oce        ! ocean space domain variables
21   USE phycst         ! physical constant
22   USE eosbn2         ! Equation Of State
23   USE sbcmod         ! ln_rnf
24   USE sbcrnf         ! River runoff
25   USE traqsr         ! solar radiation penetration
26   USE trd_oce        ! trends: ocean variables
27   USE trdtra         ! trends manager: tracers
28#if defined key_asminc
29   USE asminc         ! Assimilation increment
30#endif
31   !
32   USE in_out_manager ! I/O manager
33   USE prtctl         ! Print control
34   USE iom            ! xIOS server
35   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
36   USE timing         ! Timing
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   tra_sbc       ! routine called by step.F90
42   PUBLIC   tra_sbc_RK3   ! routine called by stprk3_.F90
43
44   !! * Substitutions
45#  include "do_loop_substitute.h90"
46#  include "domzgr_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
49   !! $Id$
50   !! Software governed by the CeCILL license (see ./LICENSE)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs, kstg )
55      !!----------------------------------------------------------------------
56      !!                  ***  ROUTINE tra_sbc  ***
57      !!
58      !! ** Purpose :   Compute the tracer surface boundary condition trend of
59      !!      (flux through the interface, concentration/dilution effect)
60      !!      and add it to the general trend of tracer equations.
61      !!
62      !! ** Method :   The (air+ice)-sea flux has two components:
63      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
64      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice.
65      !!               The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
66      !!             they are simply added to the tracer trend (ts(Krhs)).
67      !!               In linear free surface case (ln_linssh=T), the volume of the
68      !!             ocean does not change with the water exchanges at the (air+ice)-sea
69      !!             interface. Therefore another term has to be added, to mimic the
70      !!             concentration/dilution effect associated with water exchanges.
71      !!
72      !! ** Action  : - Update ts(Krhs) with the surface boundary condition trend
73      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
74      !!----------------------------------------------------------------------
75      INTEGER,                                   INTENT(in   ) ::   kt, Kmm, Krhs   ! ocean time-step and time-level indices
76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts             ! active tracers and RHS of tracer Eq.
77      INTEGER , OPTIONAL                       , INTENT(in   ) ::   kstg            ! RK3 stage index
78      !
79      INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices
80      INTEGER  ::   istg_1, istg_3               ! local integers
81      INTEGER  ::   ikt, ikb, isi, iei, isj, iej !   -       -
82      REAL(wp) ::   zfact, z1_e3t, zdep, ztim    ! local scalar
83      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds
84      !!----------------------------------------------------------------------
85      !
86      IF( ln_timing )   CALL timing_start('tra_sbc')
87      !
88      IF( PRESENT( kstg ) ) THEN      ! RK3 : a few things have to be done at only a specific stage
89         istg_1 = kstg   ;   istg_3 = kstg
90      ELSE                            ! MLF : only one call by time step
91         istg_1 =   1    ;   istg_3 =   3
92      ENDIF
93      !
94      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
95         IF( kt == nit000 ) THEN
96            IF(lwp) WRITE(numout,*)
97            IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
98            IF(lwp) WRITE(numout,*) '~~~~~~~ '
99         ENDIF
100      ENDIF
101      !
102      IF( l_trdtra ) THEN                    !* Save ta and sa trends
103         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
104         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
105         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
106      ENDIF
107      !
108      IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
109      IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF
110      IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF
111      IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF
112
113!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
114      IF( .NOT.ln_traqsr .AND. istg_1 == 1 ) THEN     ! no solar radiation penetration (RK3: only at stage 1)
115         DO_2D( isi, iei, isj, iej )
116            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)         ! total heat flux in qns
117            qsr(ji,jj) = 0._wp                           ! qsr set to zero
118         END_2D
119      ENDIF
120
121      !----------------------------------------
122      !        EMP, SFX and QNS effects
123      !----------------------------------------
124      !                             !==  Set before sbc tracer content fields  ==!
125      zfact = 0.5_wp
126      IF( kt == nit000 .AND. istg_1 == 1 ) THEN             !* 1st time-step
127         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN      ! Restart: read in restart file
128            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
129               IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
130               sbc_tsc(:,:,:) = 0._wp
131               CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
132               CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
133            ENDIF
134         ELSE                                             ! No restart or restart not found: Euler forward time stepping
135            zfact = 1._wp
136            DO_2D( isi, iei, isj, iej )
137               sbc_tsc(ji,jj,:) = 0._wp
138               sbc_tsc_b(ji,jj,:) = 0._wp
139            END_2D
140         ENDIF
141      ELSEIF( istg_3 == 3 ) THEN          !* other time-steps: swap of forcing fields (RK3: only at stage 3)
142         zfact = 0.5_wp
143         DO_2D( isi, iei, isj, iej )
144            sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:)
145         END_2D
146#if defined key_RK3
147         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
148            IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
149               CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
150               CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
151            ENDIF
152         ENDIF
153#endif
154      ENDIF
155      !                             !==  Now sbc tracer content fields  ==!
156      DO_2D( isi, iei, isj, iej )
157         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux
158         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting
159      END_2D
160      IF( ln_linssh ) THEN                !* linear free surface
161         DO_2D( isi, iei, isj, iej )                    !==>> add concentration/dilution effect due to constant volume cell
162            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
163            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
164         END_2D                                 !==>> output c./d. term
165         IF( ntile == 0 .OR. ntile == nijtile )  THEN             ! Do only on the last tile
166            IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
167            IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
168         ENDIF
169      ENDIF
170      !
171      DO jn = 1, jpts               !==  update tracer trend  ==!
172         DO_2D( 0, 0, 0, 0 )
173            pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) )    &
174               &                                                / e3t(ji,jj,1,Kmm)
175         END_2D
176      END DO
177      !
178#if ! defined key_RK3
179      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
180         IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
181            CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
182            CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
183         ENDIF
184      ENDIF
185#endif
186      !
187      !----------------------------------------
188      !        River Runoff effects
189      !----------------------------------------
190      !
191      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff
192         zfact = 0.5_wp
193         DO_2D( 0, 0, 0, 0 )
194            IF( rnf(ji,jj) /= 0._wp ) THEN
195!!st - Jerome               zdep = zfact / h_rnf(ji,jj)
196#if defined key_RK3
197               zdep = 1._wp / h_rnf(ji,jj)
198               DO jk = 1, nk_rnf(ji,jj)
199                                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)  + rnf_tsc(ji,jj,jp_tem) * zdep
200                  IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)  + rnf_tsc(ji,jj,jp_sal) * zdep
201               END DO
202
203#else
204               zdep = zfact / h_rnf(ji,jj)
205               DO jk = 1, nk_rnf(ji,jj)
206                                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)                                  &
207                                        &                      +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
208                  IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)                                  &
209                                        &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep
210               END DO
211#endif
212!!st
213            ENDIF
214         END_2D
215      ENDIF
216
217      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
218         IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
219         IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
220      ENDIF
221
222#if defined key_asminc
223      !
224      !----------------------------------------
225      !        Assmilation effects
226      !----------------------------------------
227      !
228      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation
229          !
230         IF( ln_linssh ) THEN
231            DO_2D( 0, 0, 0, 0 )
232               ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
233               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
234               pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
235            END_2D
236         ELSE
237            DO_2D( 0, 0, 0, 0 )
238               ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
239               pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
240               pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
241            END_2D
242         ENDIF
243         !
244      ENDIF
245      !
246#endif
247      !
248      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
249         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
250         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
251         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
252         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
253         DEALLOCATE( ztrdt , ztrds )
254      ENDIF
255      !
256      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
257         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
258      !
259      IF( ln_timing )   CALL timing_stop('tra_sbc')
260      !
261   END SUBROUTINE tra_sbc
262
263
264   SUBROUTINE tra_sbc_RK3 ( kt, Kmm, pts, Krhs, kstg )
265      !!----------------------------------------------------------------------
266      !!                  ***  ROUTINE tra_sbc_RK3  ***
267      !!
268      !! ** Purpose :   Compute the tracer surface boundary condition trend of
269      !!      (flux through the interface, concentration/dilution effect)
270      !!      and add it to the general trend of tracer equations.
271      !!
272      !! ** Method :   The (air+ice)-sea flux has two components:
273      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
274      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice.
275      !!               The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
276      !!             they are simply added to the tracer trend (ts(Krhs)).
277      !!               In linear free surface case (ln_linssh=T), the volume of the
278      !!             ocean does not change with the water exchanges at the (air+ice)-sea
279      !!             interface. Therefore another term has to be added, to mimic the
280      !!             concentration/dilution effect associated with water exchanges.
281      !!
282      !! ** Action  : - Update ts(Krhs) with the surface boundary condition trend
283      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
284      !!----------------------------------------------------------------------
285      INTEGER                                  , INTENT(in   ) ::   kt, Kmm, Krhs   ! ocean time-step and time-level indices
286      INTEGER                                  , INTENT(in   ) ::   kstg            ! RK3 stage index
287      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) ::   pts             ! active tracers and RHS of tracer Eq.
288      !
289      INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices
290      REAL(wp) ::   z1_rho0_e3t, zdep, ztim    ! local scalar
291      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds
292      !!----------------------------------------------------------------------
293      !
294      IF( ln_timing )   CALL timing_start('tra_sbc_RK3')
295      !
296      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
297         !
298         IF( kt == nit000 ) THEN
299            IF(lwp) WRITE(numout,*)
300            IF(lwp) WRITE(numout,*) 'tra_sbc_RK3 : TRAcer Surface Boundary Condition'
301            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
302         ENDIF
303         !
304         IF( l_trdtra ) THEN                    !* Save ta and sa trends
305            ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
306            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
307            ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
308         ENDIF
309         !
310      ENDIF
311      !
312           
313!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
314      IF( .NOT.ln_traqsr  .AND. kstg == 1) THEN     ! no solar radiation penetration
315         DO_2D( 0, 0, 0, 0 )
316            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)         ! total heat flux in qns
317            qsr(ji,jj) = 0._wp                           ! qsr set to zero
318         END_2D
319      ENDIF
320
321      !----------------------------------------
322      !        EMP, SFX and QNS effects
323      !----------------------------------------
324      !                             !==  update tracer trend  ==!
325      SELECT CASE( kstg )
326         !
327      CASE( 1 , 2 )                       !=  stage 1 and 2  =!   only in non linear ssh
328         !
329         IF( .NOT.ln_linssh ) THEN           !* only heat and salt fluxes associated with mass fluxes
330            DO_2D( 0, 0, 0, 0 )
331            z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
332            pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) - emp(ji,jj)*pts(ji,jj,1,jp_tem,Kmm) * z1_rho0_e3t
333            pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) - emp(ji,jj)*pts(ji,jj,1,jp_sal,Kmm) * z1_rho0_e3t
334            END_2D
335         ENDIF
336         !
337      CASE( 3 )
338         !
339         IF( ln_linssh ) THEN                !* linear free surface
340            DO_2D( 0, 0, 0, 0 )
341               z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
342               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + (  r1_rcp * qns(ji,jj)   &                                ! non solar heat flux
343                  &                                                +             emp(ji,jj)*pts(ji,jj,1,jp_tem,Kmm)  ) * z1_rho0_e3t  ! add concentration/dilution effect due to constant volume cell
344               pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + (           sfx(ji,jj)    &                               ! salt flux due to freezing/melting
345                  &                                                +             emp(ji,jj)*pts(ji,jj,1,jp_sal,Kmm)  ) * z1_rho0_e3t  ! add concentration/dilution effect due to constant volume cell
346            END_2D
347            IF( ntile == 0 .OR. ntile == nijtile ) THEN             ! Do only on the last tile
348               IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
349               IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
350            ENDIF
351         ELSE
352            DO_2D( 0, 0, 0, 0 )
353               z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
354               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) +  r1_rcp * qns(ji,jj) * z1_rho0_e3t
355               pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) +           sfx(ji,jj) * z1_rho0_e3t
356            END_2D
357         ENDIF
358      END SELECT
359      !
360      !
361      !----------------------------------------
362      !        River Runoff effects
363      !----------------------------------------
364      !
365      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff
366         DO_2D( 0, 0, 0, 0 )
367            IF( rnf(ji,jj) /= 0._wp ) THEN
368               zdep = 1._wp / h_rnf(ji,jj)
369               DO jk = 1, nk_rnf(ji,jj)
370                                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)  + rnf_tsc(ji,jj,jp_tem) * zdep
371                  IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)  + rnf_tsc(ji,jj,jp_sal) * zdep
372               END DO
373            ENDIF
374         END_2D
375      ENDIF
376      !
377      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
378         IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
379         IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
380      ENDIF
381
382#if defined key_asminc
383      !
384      !----------------------------------------
385      !        Assmilation effects
386      !----------------------------------------
387      !
388      IF( ln_sshinc .AND. kstg == 3 ) THEN         ! input of heat and salt due to assimilation
389         !
390         IF( ln_linssh ) THEN
391            DO_2D( 0, 0, 0, 0 )
392               ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
393               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
394               pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
395            END_2D
396         ELSE
397            DO_2D( 0, 0, 0, 0 )
398               ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
399               pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
400               pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
401            END_2D
402         ENDIF
403         !
404      ENDIF
405      !
406#endif
407      !
408      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
409         IF( ntile == 0 .OR. ntile == nijtile )  THEN
410            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
411            ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
412            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
413            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
414            DEALLOCATE( ztrdt , ztrds )
415         ENDIF
416      ENDIF
417      !
418      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
419         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
420      !
421      IF( ln_timing )   CALL timing_stop('tra_sbc_RK3')
422      !
423   END SUBROUTINE tra_sbc_RK3
424
425   !!======================================================================
426END MODULE trasbc
Note: See TracBrowser for help on using the repository browser.