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

Last change on this file since 7398 was 7398, checked in by cbricaud, 4 years ago

coarsening branch: first implementation of coarsening in PISCES

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