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.
trcsub.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 @ 7795

Last change on this file since 7795 was 7795, checked in by cbricaud, 7 years ago

code cleaning and correct bug for wn computing in vvl case
  • Property svn:keywords set to Id
File size: 26.4 KB
Line 
1MODULE trcsub
2   !!======================================================================
3   !!                       ***  MODULE trcsubstp  ***
4   !!TOP :   Averages physics variables for TOP substepping.
5   !!======================================================================
6   !! History :  1.0  !  2011-10  (K. Edwards)  Original
7   !!----------------------------------------------------------------------
8#if defined key_top
9   !!----------------------------------------------------------------------
10   !!   trc_sub    : passive tracer system sub-stepping
11   !!----------------------------------------------------------------------
12   USE oce_trc          ! ocean dynamics and active tracers variables
13   USE trc
14   USE prtctl_trc       ! Print control for debbuging
15   USE iom, ONLY : jpnf90
16   USE iom_def, ONLY : jprstlib
17   USE lbclnk
18   USE divcur, ONLY : div_cur        ! hor. divergence and curl      (div & cur routines)
19   USE bdy_oce
20#if defined key_agrif
21   USE agrif_opa_update
22   USE agrif_opa_interp
23#endif
24
25   IMPLICIT NONE
26
27   PUBLIC   trc_sub_stp      ! called by trc_stp
28   PUBLIC   trc_sub_ini      ! called by trc_ini to initialize substepping arrays.
29   PUBLIC   trc_sub_reset    ! called by trc_stp to reset physics variables
30   PUBLIC   trc_sub_ssh      ! called by trc_stp to reset physics variables
31
32   !!* Module variables
33   REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc
34   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1)
35
36   !!* Substitution
37#  include "top_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
40   !! $Id$
41   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43CONTAINS
44
45   SUBROUTINE trc_sub_stp( kt )
46      !!-------------------------------------------------------------------
47      !!                     ***  ROUTINE trc_stp  ***
48      !!                     
49      !! ** Purpose : Average variables needed for sub-stepping passive tracers
50      !!
51      !! ** Method  : Called every timestep to increment _tm (time mean) variables
52      !!              on TOP steps, calculate averages.
53      !!-------------------------------------------------------------------
54      INTEGER, INTENT( in ) ::  kt        ! ocean time-step index
55      INTEGER               ::  ji,jj,jk  ! dummy loop indices
56      REAL(wp)              ::  z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w
57      !!-------------------------------------------------------------------
58      !
59      IF( nn_timing == 1 )  CALL timing_start('trc_sub_stp')
60      !
61      IF( kt == nit000 ) THEN
62           IF(lwp) WRITE(numout,*)
63           IF(lwp) WRITE(numout,*) 'trc_sub_stp : substepping of the passive tracers'
64           IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
65           !
66           sshb_hold  (:,:) = sshn  (:,:)
67           emp_b_hold (:,:) = emp_b (:,:)
68           !
69           r1_ndttrc        = 1._wp / REAL( nn_dttrc    , wp ) 
70           r1_ndttrcp1      = 1._wp / REAL( nn_dttrc + 1, wp )
71           !
72      ENDIF 
73
74       IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
75          !
76          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:) 
77          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:) 
78          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:) 
79          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:) 
80          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:) 
81          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:) 
82# if defined key_zdfddm
83          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:) 
84# endif
85#if defined key_ldfslp
86          wslpi_tm(:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)
87          wslpj_tm(:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)
88          uslp_tm (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)
89          vslp_tm (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)
90#endif
91# if defined key_trabbl
92          IF( nn_bbl_ldf == 1 ) THEN
93             ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:) 
94             ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:) 
95          ENDIF
96          IF( nn_bbl_adv == 1 ) THEN
97             utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:) 
98             vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:) 
99          ENDIF
100# endif
101          !
102          sshn_tm  (:,:)         = sshn_tm  (:,:)         + sshn  (:,:) 
103          IF( ln_rnf )THEN
104             rnf_tm   (:,:)         = rnf_tm   (:,:)         + rnf   (:,:) 
105             h_rnf_tm (:,:)         = h_rnf_tm (:,:)         + h_rnf (:,:) 
106          ENDIF
107          hmld_tm  (:,:)         = hmld_tm  (:,:)         + hmld  (:,:)
108          fr_i_tm  (:,:)         = fr_i_tm  (:,:)         + fr_i  (:,:)
109          emp_tm   (:,:)         = emp_tm   (:,:)         + emp   (:,:) 
110          fmmflx_tm(:,:)         = fmmflx_tm(:,:)         + fmmflx(:,:)
111          qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:)
112
113      ELSE                           !  It is time to substep
114         !   1. set temporary arrays to hold physics variables
115         un_temp    (:,:,:)      = un    (:,:,:)
116         vn_temp    (:,:,:)      = vn    (:,:,:)
117         wn_temp    (:,:,:)      = wn    (:,:,:)
118         tsn_temp   (:,:,:,:)    = tsn   (:,:,:,:)
119         rhop_temp  (:,:,:)      = rhop  (:,:,:)   
120         avt_temp   (:,:,:)      = avt   (:,:,:)
121# if defined key_zdfddm
122         avs_temp   (:,:,:)      = avs   (:,:,:)
123# endif
124#if defined key_ldfslp
125         wslpi_temp (:,:,:)      = wslpi (:,:,:)
126         wslpj_temp (:,:,:)      = wslpj (:,:,:)
127         uslp_temp  (:,:,:)      = uslp  (:,:,:)
128         vslp_temp  (:,:,:)      = vslp  (:,:,:)
129#endif
130# if defined key_trabbl
131          IF( nn_bbl_ldf == 1 ) THEN
132             ahu_bbl_temp(:,:)   = ahu_bbl(:,:) 
133             ahv_bbl_temp(:,:)   = ahv_bbl(:,:) 
134          ENDIF
135          IF( nn_bbl_adv == 1 ) THEN
136             utr_bbl_temp(:,:)   = utr_bbl(:,:) 
137             vtr_bbl_temp(:,:)   = vtr_bbl(:,:) 
138          ENDIF
139# endif
140         sshn_temp  (:,:)        = sshn  (:,:)
141         sshb_temp  (:,:)        = sshb  (:,:)
142         ssha_temp  (:,:)        = ssha  (:,:)
143         rnf_temp   (:,:)        = rnf   (:,:)
144         IF( ln_rnf )THEN
145            h_rnf_temp (:,:)        = h_rnf (:,:)
146            hmld_temp  (:,:)        = hmld  (:,:)
147         ENDIF
148         fr_i_temp  (:,:)        = fr_i  (:,:)
149         emp_temp   (:,:)        = emp   (:,:)
150         emp_b_temp (:,:)        = emp_b (:,:)
151         fmmflx_temp(:,:)        = fmmflx(:,:)
152         qsr_temp   (:,:)        = qsr   (:,:)
153         !                                    !  Variables reset in trc_sub_ssh
154#if ! defined key_crs
155         rotn_temp  (:,:,:)      = rotn  (:,:,:)
156# endif
157#if ! defined key_crs
158         rotb_temp  (:,:,:)      = rotb  (:,:,:)
159# endif
160         !
161         ! 2. Create averages and reassign variables
162         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:) 
163         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:) 
164         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:) 
165         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:) 
166         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:) 
167         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:) 
168# if defined key_zdfddm
169         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:) 
170# endif
171#if defined key_ldfslp
172         wslpi_tm (:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
173         wslpj_tm (:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
174         uslp_tm  (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:) 
175         vslp_tm  (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)
176#endif
177# if defined key_trabbl
178          IF( nn_bbl_ldf == 1 ) THEN
179             ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:) 
180             ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:) 
181          ENDIF
182          IF( nn_bbl_adv == 1 ) THEN
183             utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:) 
184             vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:) 
185          ENDIF
186# endif
187         sshn_tm  (:,:)          = sshn_tm    (:,:)       + sshn  (:,:) 
188         IF( ln_rnf )THEN
189            rnf_tm   (:,:)          = rnf_tm     (:,:)       + rnf   (:,:) 
190            h_rnf_tm (:,:)          = h_rnf_tm   (:,:)       + h_rnf (:,:) 
191         ENDIF
192         hmld_tm  (:,:)          = hmld_tm    (:,:)       + hmld  (:,:)
193         fr_i_tm  (:,:)          = fr_i_tm    (:,:)       + fr_i  (:,:)
194         emp_tm   (:,:)          = emp_tm     (:,:)       + emp   (:,:) 
195         fmmflx_tm(:,:)          = fmmflx_tm  (:,:)       + fmmflx(:,:)
196         qsr_tm   (:,:)          = qsr_tm     (:,:)       + qsr   (:,:)
197         !
198         sshn     (:,:)          = sshn_tm    (:,:) * r1_ndttrcp1 
199         sshb     (:,:)          = sshb_hold  (:,:)
200         IF( ln_rnf )THEN
201            rnf      (:,:)          = rnf_tm     (:,:) * r1_ndttrcp1 
202            h_rnf    (:,:)          = h_rnf_tm   (:,:) * r1_ndttrcp1 
203         ENDIF
204         hmld     (:,:)          = hmld_tm    (:,:) * r1_ndttrcp1 
205         !  variables that are initialized after averages
206         emp_b    (:,:) = emp_b_hold (:,:)
207         IF( kt == nittrc000 ) THEN
208            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrc 
209            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrc 
210            fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrc 
211            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrc
212# if defined key_trabbl
213            IF( nn_bbl_ldf == 1 ) THEN
214               ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrc 
215               ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrc 
216            ENDIF
217            IF( nn_bbl_adv == 1 ) THEN
218               utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrc 
219               vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrc 
220            ENDIF
221# endif
222         ELSE
223            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrcp1 
224            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrcp1 
225            fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrcp1 
226            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrcp1 
227# if defined key_trabbl
228            IF( nn_bbl_ldf == 1 ) THEN
229               ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrcp1 
230               ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrcp1 
231            ENDIF
232            IF( nn_bbl_adv == 1 ) THEN
233               utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrcp1 
234               vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrcp1 
235            ENDIF
236# endif
237         ENDIF
238         !
239         DO jk = 1, jpk
240            DO jj = 1, jpj
241               DO ji = 1, jpi
242                  z1_ne3t = r1_ndttrcp1  / fse3t(ji,jj,jk)
243                  z1_ne3u = r1_ndttrcp1  / fse3u(ji,jj,jk)
244                  z1_ne3v = r1_ndttrcp1  / fse3v(ji,jj,jk)
245                  z1_ne3w = r1_ndttrcp1  / fse3w(ji,jj,jk)
246                  !
247                  un   (ji,jj,jk)        = un_tm   (ji,jj,jk)        * z1_ne3u
248                  vn   (ji,jj,jk)        = vn_tm   (ji,jj,jk)        * z1_ne3v
249                  tsn  (ji,jj,jk,jp_tem) = tsn_tm  (ji,jj,jk,jp_tem) * z1_ne3t
250                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t
251                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t
252                  avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w
253# if defined key_zdfddm
254                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w
255# endif
256#if defined key_ldfslp
257                  wslpi(ji,jj,jk)        = wslpi_tm(ji,jj,jk) 
258                  wslpj(ji,jj,jk)        = wslpj_tm(ji,jj,jk)
259                  uslp (ji,jj,jk)        = uslp_tm (ji,jj,jk)
260                  vslp (ji,jj,jk)        = vslp_tm (ji,jj,jk)
261#endif
262               ENDDO
263            ENDDO
264         ENDDO
265         !
266         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity
267         !
268      ENDIF
269      !
270      IF( nn_timing == 1 )  CALL timing_start('trc_sub_stp')
271      !
272   END SUBROUTINE trc_sub_stp
273
274   SUBROUTINE trc_sub_ini
275      !!-------------------------------------------------------------------
276      !!                     ***  ROUTINE trc_sub_ini  ***
277      !!                     
278      !! ** Purpose : Initialize variables needed for sub-stepping passive tracers
279      !!
280      !! ** Method  :
281      !!              Compute the averages for sub-stepping
282      !!-------------------------------------------------------------------
283      INTEGER ::   ierr
284      !!-------------------------------------------------------------------
285      !
286      IF( nn_timing == 1 )  CALL timing_start('trc_sub_ini')
287      !
288      IF(lwp) WRITE(numout,*)
289      IF(lwp) WRITE(numout,*) 'trc_sub_ini : initial set up of the passive tracers substepping'
290      IF(lwp) WRITE(numout,*) '~~~~~~~'
291
292      ierr =  trc_sub_alloc    ()
293      IF( lk_mpp    )   CALL mpp_sum( ierr )
294      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
295
296      un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:) 
297      vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:) 
298      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:) 
299      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:) 
300      rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:) 
301      avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:) 
302# if defined key_zdfddm
303      avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:) 
304# endif
305#if defined key_ldfslp
306      wslpi_tm(:,:,:)        = wslpi(:,:,:)
307      wslpj_tm(:,:,:)        = wslpj(:,:,:)
308      uslp_tm (:,:,:)        = uslp (:,:,:)
309      vslp_tm (:,:,:)        = vslp (:,:,:)
310#endif
311      sshn_tm  (:,:) = sshn  (:,:) 
312      IF( ln_rnf )THEN
313         rnf_tm   (:,:) = rnf   (:,:) 
314         h_rnf_tm (:,:) = h_rnf (:,:) 
315      ENDIF
316      hmld_tm  (:,:) = hmld  (:,:)
317
318      ! Physics variables that are set after initialization:
319      fr_i_tm(:,:) = 0._wp
320      emp_tm (:,:) = 0._wp
321      fmmflx_tm(:,:)  = 0._wp
322      qsr_tm (:,:) = 0._wp
323      wndm_tm(:,:) = 0._wp
324# if defined key_trabbl
325      IF( nn_bbl_ldf == 1 ) THEN
326         ahu_bbl_tm(:,:) = 0._wp
327         ahv_bbl_tm(:,:) = 0._wp
328      ENDIF
329      IF( nn_bbl_adv == 1 ) THEN
330         utr_bbl_tm(:,:) = 0._wp
331         vtr_bbl_tm(:,:) = 0._wp
332      ENDIF
333# endif
334      !
335      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ini')
336      !
337   END SUBROUTINE trc_sub_ini
338
339   SUBROUTINE trc_sub_reset( kt )
340      !!-------------------------------------------------------------------
341      !!                     ***  ROUTINE trc_sub_reset  ***
342      !!                     
343      !! ** Purpose : Reset physics variables averaged for substepping
344      !!
345      !! ** Method  :
346      !!              Compute the averages for sub-stepping
347      !!-------------------------------------------------------------------
348      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
349      INTEGER :: jk                 ! dummy loop indices
350      !!-------------------------------------------------------------------
351      !
352      IF( nn_timing == 1 )  CALL timing_start('trc_sub_reset')
353      !
354      !   restore physics variables
355      un    (:,:,:)   =  un_temp    (:,:,:)
356      vn    (:,:,:)   =  vn_temp    (:,:,:)
357      wn    (:,:,:)   =  wn_temp    (:,:,:)
358      tsn   (:,:,:,:) =  tsn_temp   (:,:,:,:)
359      rhop  (:,:,:)   =  rhop_temp  (:,:,:)
360      avt   (:,:,:)   =  avt_temp   (:,:,:)
361# if defined key_zdfddm
362      avs   (:,:,:)   =  avs_temp   (:,:,:)
363# endif
364#if defined key_ldfslp
365      wslpi (:,:,:)   =  wslpi_temp (:,:,:)
366      wslpj (:,:,:)   =  wslpj_temp (:,:,:)
367      uslp  (:,:,:)   =  uslp_temp  (:,:,:)
368      vslp  (:,:,:)   =  vslp_temp  (:,:,:)
369#endif
370      sshn  (:,:)     =  sshn_temp  (:,:)
371      sshb  (:,:)     =  sshb_temp  (:,:)
372      ssha  (:,:)     =  ssha_temp  (:,:)
373      IF( ln_rnf )THEN
374         rnf   (:,:)     =  rnf_temp   (:,:)
375         h_rnf (:,:)     =  h_rnf_temp (:,:)
376      ENDIF
377      !
378      hmld  (:,:)     =  hmld_temp  (:,:)
379      fr_i  (:,:)     =  fr_i_temp  (:,:)
380      emp   (:,:)     =  emp_temp   (:,:)
381      fmmflx(:,:)     =  fmmflx_temp(:,:)
382      emp_b (:,:)     =  emp_b_temp (:,:)
383      qsr   (:,:)     =  qsr_temp   (:,:)
384# if defined key_trabbl
385      IF( nn_bbl_ldf == 1 ) THEN
386         ahu_bbl(:,:) = ahu_bbl_temp(:,:) 
387         ahv_bbl(:,:) = ahv_bbl_temp(:,:) 
388      ENDIF
389      IF( nn_bbl_adv == 1 ) THEN
390         utr_bbl(:,:) = utr_bbl_temp(:,:) 
391         vtr_bbl(:,:) = vtr_bbl_temp(:,:) 
392      ENDIF
393# endif
394      !
395      hdivn (:,:,:)   =  hdivn_temp (:,:,:)
396#if ! defined key_crs
397      rotn  (:,:,:)   =  rotn_temp  (:,:,:)
398      rotb  (:,:,:)   =  rotb_temp  (:,:,:)
399#endif
400      !                                     
401
402      ! Start new averages
403         un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:) 
404         vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:) 
405         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:) 
406         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:) 
407         rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:) 
408         avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:) 
409# if defined key_zdfddm
410         avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:) 
411# endif
412#if defined key_ldfslp
413         wslpi_tm(:,:,:)        = wslpi(:,:,:) 
414         wslpj_tm(:,:,:)        = wslpj(:,:,:)
415         uslp_tm (:,:,:)        = uslp (:,:,:)
416         vslp_tm (:,:,:)        = vslp (:,:,:)
417#endif
418      !
419      sshb_hold  (:,:) = sshn  (:,:)
420      emp_b_hold (:,:) = emp   (:,:)
421      sshn_tm    (:,:) = sshn  (:,:) 
422      IF( ln_rnf )THEN
423         rnf_tm     (:,:) = rnf   (:,:) 
424         h_rnf_tm   (:,:) = h_rnf (:,:) 
425      ENDIF
426      hmld_tm    (:,:) = hmld  (:,:)
427      fr_i_tm    (:,:) = fr_i  (:,:)
428      emp_tm     (:,:) = emp   (:,:)
429      fmmflx_tm  (:,:) = fmmflx(:,:)
430      qsr_tm     (:,:) = qsr   (:,:)
431# if defined key_trabbl
432      IF( nn_bbl_ldf == 1 ) THEN
433         ahu_bbl_tm(:,:) = ahu_bbl(:,:) 
434         ahv_bbl_tm(:,:) = ahv_bbl(:,:) 
435      ENDIF
436      IF( nn_bbl_adv == 1 ) THEN
437         utr_bbl_tm(:,:) = utr_bbl(:,:) 
438         vtr_bbl_tm(:,:) = vtr_bbl(:,:) 
439      ENDIF
440# endif
441      !
442      !
443      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_reset')
444      !
445   END SUBROUTINE trc_sub_reset
446
447
448   SUBROUTINE trc_sub_ssh( kt ) 
449      !!----------------------------------------------------------------------
450      !!                ***  ROUTINE trc_sub_ssh  ***
451      !!                   
452      !! ** Purpose :   compute the after ssh (ssha), the now vertical velocity
453      !!              and update the now vertical coordinate (lk_vvl=T).
454      !!
455      !! ** Method  : - Using the incompressibility hypothesis, the vertical
456      !!      velocity is computed by integrating the horizontal divergence 
457      !!      from the bottom to the surface minus the scale factor evolution.
458      !!        The boundary conditions are w=0 at the bottom (no flux) and.
459      !!
460      !! ** action  :   ssha    : after sea surface height
461      !!                wn      : now vertical velocity
462      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (lk_vvl=T)
463      !!
464      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
465      !!----------------------------------------------------------------------
466      !
467      INTEGER, INTENT(in) ::   kt   ! time step
468      !
469      INTEGER  ::   ji, jj, jk   ! dummy loop indices
470      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars
471      REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv
472      !!---------------------------------------------------------------------
473      !
474      IF( nn_timing == 1 )  CALL timing_start('trc_sub_ssh')
475      !
476      ! Allocate temporary workspace
477      CALL wrk_alloc( jpi, jpj, zhdiv )
478
479      IF( kt == nittrc000 ) THEN
480         !
481         IF(lwp) WRITE(numout,*)
482         IF(lwp) WRITE(numout,*) 'trc_sub_ssh : after sea surface height and now vertical velocity '
483         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
484         !
485         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
486         !
487      ENDIF
488      !
489      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
490      !
491      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
492      IF( neuler == 0 .AND. kt == nittrc000 )   z2dt = rdt
493
494      !                                           !------------------------------!
495      !                                           !   After Sea Surface Height   !
496      !                                           !------------------------------!
497      zhdiv(:,:) = 0._wp
498      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
499        zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
500      END DO
501      !                                                ! Sea surface elevation time stepping
502      ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
503      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
504      z1_rau0 = 0.5 / rau0
505      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1)
506#if ! defined key_dynspg_ts
507      ! These lines are not necessary with time splitting since
508      ! boundary condition on sea level is set during ts loop
509#if defined key_agrif
510      CALL agrif_ssh( kt )
511#endif
512#if defined key_bdy
513      ssha(:,:) = ssha(:,:) * bdytmask(:,:)
514      CALL lbc_lnk( ssha, 'T', 1. ) 
515#endif
516#endif
517
518
519      !                                           !------------------------------!
520      !                                           !     Now Vertical Velocity    !
521      !                                           !------------------------------!
522      z1_2dt = 1.e0 / z2dt
523      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
524         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
525         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
526            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
527            &                         * tmask(:,:,jk) * z1_2dt
528#if defined key_bdy
529         wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
530#endif
531      END DO
532
533      !
534      CALL wrk_dealloc( jpi, jpj, zhdiv )
535      !
536      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ssh')
537      !
538   END SUBROUTINE trc_sub_ssh
539
540   INTEGER FUNCTION trc_sub_alloc()
541      !!-------------------------------------------------------------------
542      !!                    *** ROUTINE trc_sub_alloc ***
543      !!-------------------------------------------------------------------
544      USE lib_mpp, ONLY: ctl_warn
545      INTEGER ::  ierr
546      !!-------------------------------------------------------------------
547      !
548      ALLOCATE( un_temp(jpi,jpj,jpk)        ,  vn_temp(jpi,jpj,jpk)  ,   &
549         &      wn_temp(jpi,jpj,jpk)        ,  avt_temp(jpi,jpj,jpk) ,   &
550         &      rhop_temp(jpi,jpj,jpk)      ,  rhop_tm(jpi,jpj,jpk) ,   &
551         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      &
552         &      ssha_temp(jpi,jpj)          ,                           &
553#if defined key_ldfslp
554         &      wslpi_temp(jpi,jpj,jpk)     ,  wslpj_temp(jpi,jpj,jpk),  &
555         &      uslp_temp(jpi,jpj,jpk)      ,  vslp_temp(jpi,jpj,jpk),   &
556#endif
557#if defined key_trabbl
558         &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    &
559         &      utr_bbl_temp(jpi,jpj)       ,  vtr_bbl_temp(jpi,jpj),    &
560#endif
561         &      rnf_temp(jpi,jpj)           ,  h_rnf_temp(jpi,jpj) ,     &
562         &      tsn_temp(jpi,jpj,jpk,2)     ,  emp_b_temp(jpi,jpj),      &
563         &      emp_temp(jpi,jpj)           ,  fmmflx_temp(jpi,jpj),     &
564         &      hmld_temp(jpi,jpj)          ,  qsr_temp(jpi,jpj) ,       &
565         &      fr_i_temp(jpi,jpj)          ,  fr_i_tm(jpi,jpj) ,        &
566         &      wndm_temp(jpi,jpj)          ,  wndm_tm(jpi,jpj) ,        &
567# if defined key_zdfddm
568         &      avs_tm(jpi,jpj,jpk)         ,  avs_temp(jpi,jpj,jpk) ,   &
569# endif
570         &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  &
571         &      rotn_temp(jpi,jpj,jpk)      ,  rotb_temp(jpi,jpj,jpk),   &
572         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     &
573         &      avt_tm(jpi,jpj,jpk)                                ,     &
574         &      sshn_tm(jpi,jpj)            ,  sshb_hold(jpi,jpj) ,      &
575         &      tsn_tm(jpi,jpj,jpk,2)       ,                            &
576         &      emp_tm(jpi,jpj)             ,  fmmflx_tm(jpi,jpj)  ,     &
577         &      emp_b_hold(jpi,jpj)         ,                            &
578         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         &
579#if defined key_ldfslp
580         &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    &
581         &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     &
582#endif
583#if defined key_trabbl
584         &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      &
585         &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      &
586#endif
587         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) ,       &
588         &                                    STAT=trc_sub_alloc ) 
589      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
590
591      !
592   END FUNCTION trc_sub_alloc
593
594#else
595   !!----------------------------------------------------------------------
596   !!   Default key                                     NO passive tracers
597   !!----------------------------------------------------------------------
598CONTAINS
599   SUBROUTINE trc_sub_stp( kt )        ! Empty routine
600      WRITE(*,*) 'trc_sub_stp: You should not have seen this print! error?', kt
601   END SUBROUTINE trc_sub_stp
602   SUBROUTINE trc_sub_ini        ! Empty routine
603      WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt
604   END SUBROUTINE trc_sub_ini
605
606#endif
607
608   !!======================================================================
609END MODULE trcsub
Note: See TracBrowser for help on using the repository browser.