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/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 @ 7088

Last change on this file since 7088 was 7088, checked in by lovato, 8 years ago

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