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.
dynzdf_imp_atsk.F90 in trunk/NEMO/OPA_SRC/DYN – NEMO

source: trunk/NEMO/OPA_SRC/DYN/dynzdf_imp_atsk.F90 @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.8 KB
Line 
1MODULE dynzdf_imp_atsk
2   !!==============================================================================
3   !!                    ***  MODULE  dynzdf_imp_atsk  ***
4   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dyn_zdf_imp_tsk : update the momentum trend with the vertical
9   !!                     diffusion using an implicit time-stepping and
10   !!                     j-k-i loops.
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE phycst          ! physical constants
16   USE zdf_oce         ! ocean vertical physics
17   USE in_out_manager  ! I/O manager
18   USE taumod          ! surface ocean stress
19   USE trdmod          ! ocean dynamics trends
20   USE trdmod_oce      ! ocean variables trends
21
22   IMPLICIT NONE
23   PRIVATE
24
25   !! * Routine accessibility
26   PUBLIC dyn_zdf_imp_tsk     ! called by step.F90
27
28   !! * Substitutions
29#  include "domzgr_substitute.h90"
30#  include "vectopt_loop_substitute.h90"
31   !!----------------------------------------------------------------------
32   !!   OPA 9.0 , LOCEAN-IPSL (2005)
33   !! $Header$
34   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE dyn_zdf_imp_tsk( kt )
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE dyn_zdf_imp_tsk  ***
42      !!                   
43      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
44      !!      and the surface forcing, and add it to the general trend of
45      !!      the momentum equations.
46      !!
47      !! ** Method  :   The vertical momentum mixing trend is given by :
48      !!             dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) )
49      !!      backward time stepping
50      !!      Surface boundary conditions: wind stress input
51      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F)
52      !!      Add this trend to the general trend ua :
53      !!         ua = ua + dz( avmu dz(u) )
54      !!
55      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive
56      !!               mixing trend.
57      !!             - Save the trends in (ztdua,ztdva) ('l_trddyn')
58      !!
59      !! History :
60      !!   8.5  !  02-08  (G. Madec)  auto-tasking option
61      !!   9.0  !  04-08  (C. Talandier)  New trends organization
62      !!---------------------------------------------------------------------
63      !! * Modules used     
64      USE oce, ONLY :    ztdua => ta,  & ! use ta as 3D workspace   
65                         ztdva => sa     ! use sa as 3D workspace   
66
67      !! * Arguments
68      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
69
70      !! * Local declarations
71      INTEGER ::   ji, jj, jk            ! dummy loop indices
72      INTEGER ::   &
73         ikst, ikenm2, ikstp1,         & ! temporary integers
74         ikbu, ikbum1, ikbv, ikbvm1      !    "         "     
75      REAL(wp) ::   &
76         zrau0r, z2dt, zua, zva,       & !temporary scalars
77         z2dtf, zcoef, zzws
78      REAL(wp), DIMENSION(jpi,jpk) ::  &
79         zwx, zwy, zwz,                & ! workspace
80         zwd, zws, zwi, zwt
81      REAL(wp), DIMENSION(jpi,jpj) ::  &
82         ztsx, ztsy, ztbx, ztby          ! temporary workspace arrays
83      !!----------------------------------------------------------------------
84
85      IF( kt == nit000 ) THEN
86         IF(lwp) WRITE(numout,*)
87         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp_tsk : vertical momentum diffusion implicit operator'
88         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   auto-task case (j-k-i loop)'
89      ENDIF
90
91
92      ! 0. Local constant initialization
93      ! --------------------------------
94      zrau0r = 1. / rau0      ! inverse of the reference density
95      z2dt   = 2. * rdt       ! Leap-frog environnement
96      ztsx(:,:)   = 0.e0
97      ztsy(:,:)   = 0.e0 
98      ztbx(:,:)   = 0.e0
99      ztby(:,:)   = 0.e0
100      ! Euler time stepping when starting from rest
101      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
102
103      ! Save ua and va trends
104      IF( l_trddyn )   THEN
105         ztdua(:,:,:) = ua(:,:,:) 
106         ztdva(:,:,:) = va(:,:,:) 
107      ENDIF
108
109      !                                                ! ===============
110      DO jj = 2, jpjm1                                 !  Vertical slab
111         !                                             ! ===============
112         ! 1. Vertical diffusion on u
113         ! ---------------------------
114
115         ! Matrix and second member construction
116         ! bottom boundary condition: only zws must be masked as avmu can take
117         ! non zero value at the ocean bottom depending on the bottom friction
118         ! used (see zdfmix.F)
119         DO jk = 1, jpkm1
120            DO ji = 2, jpim1
121               zcoef = - z2dt / fse3u(ji,jj,jk)
122               zwi(ji,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  )
123               zzws       = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
124               zws(ji,jk) = zzws * umask(ji,jj,jk+1)
125               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws
126               zwy(ji,jk) = ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)
127            END DO
128         END DO
129
130         ! Surface boudary conditions
131         DO ji = 2, jpim1
132            z2dtf = z2dt / ( fse3u(ji,jj,1)*rau0 )
133            zwi(ji,1) = 0.
134            zwd(ji,1) = 1. - zws(ji,1)
135            zwy(ji,1) = zwy(ji,1) + z2dtf * taux(ji,jj)
136         END DO
137
138         ! Matrix inversion starting from the first level
139         ikst = 1
140!!----------------------------------------------------------------------
141!!         ZDF.MATRIXSOLVER
142!!       ********************
143!!----------------------------------------------------------------------
144!! Matrix inversion
145!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
146!
147!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
148!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
149!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
150!        (        ...               )( ...  ) ( ...  )
151!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
152!
153!   m is decomposed in the product of an upper and lower triangular
154!   matrix
155!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
156!   The second member is in 2d array zwy
157!   The solution is in 2d array zwx
158!   The 2d arry zwt and zwz are work space arrays
159!
160!   N.B. the starting vertical index (ikst) is equal to 1 except for
161!   the resolution of tke matrix where surface tke value is prescribed
162!   so that ikstrt=2.
163!!----------------------------------------------------------------------
164
165         ikstp1 = ikst + 1
166         ikenm2 = jpk - 2
167         DO ji = 2, jpim1
168            zwt(ji,ikst) = zwd(ji,ikst)
169         END DO
170         DO jk = ikstp1, jpkm1
171            DO ji = 2, jpim1
172               zwt(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwt(ji,jk-1)
173            END DO
174         END DO
175         DO ji = 2, jpim1
176            zwz(ji,ikst) = zwy(ji,ikst)
177         END DO
178         DO jk = ikstp1, jpkm1
179            DO ji = 2, jpim1
180               zwz(ji,jk) = zwy(ji,jk) - zwi(ji,jk) / zwt(ji,jk-1) * zwz(ji,jk-1)
181            END DO
182         END DO
183         DO ji = 2, jpim1
184            zwx(ji,jpkm1) = zwz(ji,jpkm1) / zwt(ji,jpkm1)
185         END DO
186         DO jk = ikenm2, ikst, -1
187            DO ji = 2, jpim1
188            zwx(ji,jk) =( zwz(ji,jk) - zws(ji,jk) * zwx(ji,jk+1) ) / zwt(ji,jk)
189            END DO
190         END DO
191     
192         ! Normalization to obtain the general momentum trend ua
193         DO jk = 1, jpkm1
194            DO ji = 2, jpim1
195               ua(ji,jj,jk) = ( zwx(ji,jk) - ub(ji,jj,jk) ) / z2dt
196            END DO
197         END DO
198
199         ! diagnose surface and bottom momentum fluxes
200         ! for trends diagnostics
201         DO ji = 2, jpim1
202            ! save the surface forcing momentum fluxes
203            ztsx(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 )
204            ! save bottom friction momentum fluxes
205            ikbu   = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
206            ikbum1 = MAX( ikbu-1, 1 )
207            ztbx(ji,jj) = - avmu(ji,jj,ikbu) * zwx(ji,ikbum1)   &
208               / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) )
209            ! subtract surface forcing and bottom friction trend from vertical
210            ! diffusive momentum trend
211            ztdua(ji,jj,1     ) = ztdua(ji,jj,1     ) - ztsx(ji,jj)
212            ztdua(ji,jj,ikbum1) = ztdua(ji,jj,ikbum1) - ztbx(ji,jj)
213         END DO
214
215         ! 2. Vertical diffusion on v
216         ! ---------------------------
217
218         ! Matrix and second member construction
219         ! bottom boundary condition: only zws must be masked as avmv can take
220         ! non zero value at the ocean bottom depending on the bottom friction
221         ! used (see zdfmix.F)
222         DO jk = 1, jpkm1
223            DO ji = 2, jpim1
224               zcoef = -z2dt/fse3v(ji,jj,jk)
225               zwi(ji,jk) = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  )
226               zzws       = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
227               zws(ji,jk) =  zzws * vmask(ji,jj,jk+1)
228               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws
229               zwy(ji,jk) = vb(ji,jj,jk) + z2dt * va(ji,jj,jk)
230            END DO
231         END DO
232
233         ! Surface boudary conditions
234         DO ji = 2, jpim1
235            z2dtf = z2dt / ( fse3v(ji,jj,1)*rau0 )
236            zwi(ji,1) = 0.e0
237            zwd(ji,1) = 1. - zws(ji,1)
238            zwy(ji,1) = zwy(ji,1) + z2dtf * tauy(ji,jj)
239         END DO
240
241         ! Matrix inversion starting from the first level
242         ikst = 1
243!!----------------------------------------------------------------------
244!!         ZDF.MATRIXSOLVER
245!!       ********************
246!!----------------------------------------------------------------------
247!! Matrix inversion
248!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
249!
250!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
251!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
252!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
253!        (        ...               )( ...  ) ( ...  )
254!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
255!
256!   m is decomposed in the product of an upper and lower triangular
257!   matrix
258!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
259!   The second member is in 2d array zwy
260!   The solution is in 2d array zwx
261!   The 2d arry zwt and zwz are work space arrays
262!
263!   N.B. the starting vertical index (ikst) is equal to 1 except for
264!   the resolution of tke matrix where surface tke value is prescribed
265!   so that ikstrt=2.
266!!----------------------------------------------------------------------
267
268         ikstp1 = ikst + 1
269         ikenm2 = jpk - 2
270         DO ji = 2, jpim1
271            zwt(ji,ikst) = zwd(ji,ikst)
272         END DO
273         DO jk = ikstp1, jpkm1
274            DO ji = 2, jpim1
275               zwt(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwt(ji,jk-1)
276            END DO
277         END DO
278         DO ji = 2, jpim1
279            zwz(ji,ikst) = zwy(ji,ikst)
280         END DO
281         DO jk = ikstp1, jpkm1
282            DO ji = 2, jpim1
283               zwz(ji,jk) = zwy(ji,jk) - zwi(ji,jk) / zwt(ji,jk-1) * zwz(ji,jk-1)
284            END DO
285         END DO
286         DO ji = 2, jpim1
287            zwx(ji,jpkm1) = zwz(ji,jpkm1) / zwt(ji,jpkm1)
288         END DO
289         DO jk = ikenm2, ikst, -1
290            DO ji = 2, jpim1
291               zwx(ji,jk) =( zwz(ji,jk) - zws(ji,jk) * zwx(ji,jk+1) ) / zwt(ji,jk)
292            END DO
293         END DO
294     
295         ! Normalization to obtain the general momentum trend va
296         DO jk = 1, jpkm1
297            DO ji = 2, jpim1
298               va(ji,jj,jk) = ( zwx(ji,jk) - vb(ji,jj,jk) ) / z2dt
299            END DO
300         END DO
301
302         ! diagnose surface and bottom momentum fluxes
303         ! for trends diagnostics
304         DO ji = 2, jpim1
305            ! save the surface forcing momentum fluxes
306         ztsy(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 )
307            ! save bottom friction momentum fluxes
308            ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
309            ikbvm1 = MAX( ikbv-1, 1 )
310         ztby(ji,jj) = - avmv(ji,jj,ikbv) * zwx(ji,ikbvm1)   &
311               / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) )
312            ! subtract surface forcing and bottom friction trend from vertical
313            ! diffusive momentum trend
314            ztdva(ji,jj,1     ) = ztdva(ji,jj,1     ) - ztsy(ji,jj)
315            ztdva(ji,jj,ikbvm1) = ztdva(ji,jj,ikbvm1) - ztby(ji,jj)
316         END DO
317         !                                             ! ===============
318      END DO                                           !   End of slab
319      !                                                ! ===============
320
321      ! save the vertical diffusion trends for diagnostic
322      ! momentum trends
323      IF( l_trddyn )  THEN
324         ztdua(:,:,:) = ua(:,:,:) - ztdua(:,:,:)
325         ztdva(:,:,:) = va(:,:,:) - ztdva(:,:,:)
326
327         CALL trd_mod(ztdua, ztdva, jpdtdzdf, 'DYN', kt)
328         ztdua(:,:,:) = 0.e0
329         ztdva(:,:,:) = 0.e0
330         ztdua(:,:,1) = ztsx(:,:)
331         ztdva(:,:,1) = ztsy(:,:)
332         CALL trd_mod(ztdua , ztdva , jpdtdswf, 'DYN', kt)
333         ztdua(:,:,:) = 0.e0
334         ztdva(:,:,:) = 0.e0
335         ztdua(:,:,1) = ztbx(:,:)
336         ztdva(:,:,1) = ztby(:,:)
337         CALL trd_mod(ztdua , ztdva , jpdtdbfr, 'DYN', kt)
338      ENDIF
339
340      IF(l_ctl) THEN         ! print sum trends (used for debugging)
341         zua = SUM( ua(2:nictl,2:njctl,1:jpkm1) * umask(2:nictl,2:njctl,1:jpkm1) )
342         zva = SUM( va(2:nictl,2:njctl,1:jpkm1) * vmask(2:nictl,2:njctl,1:jpkm1) )
343         WRITE(numout,*) ' zdf  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
344         u_ctl = zua   ;   v_ctl = zva
345      ENDIF
346
347   END SUBROUTINE dyn_zdf_imp_tsk
348
349   !!==============================================================================
350END MODULE dynzdf_imp_atsk
Note: See TracBrowser for help on using the repository browser.