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.
trdvor.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 @ 3211

Last change on this file since 3211 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.

  • Property svn:keywords set to Id
File size: 27.9 KB
Line 
1MODULE trdvor
2   !!======================================================================
3   !!                       ***  MODULE  trdvor  ***
4   !! Ocean diagnostics:  momentum trends
5   !!=====================================================================
6   !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code
7   !!            2.0  !  04-2008  (C. Talandier) New trends organization
8   !!----------------------------------------------------------------------
9#if defined key_trdvor   ||   defined key_esopa
10   !!----------------------------------------------------------------------
11   !!   'key_trdvor'   : momentum trend diagnostics
12   !!----------------------------------------------------------------------
13   !!   trd_vor      : momentum trends averaged over the depth
14   !!   trd_vor_zint : vorticity vertical integration
15   !!   trd_vor_init : initialization step
16   !!----------------------------------------------------------------------
17   USE oce             ! ocean dynamics and tracers variables
18   USE dom_oce         ! ocean space and time domain variables
19   USE trdmod_oce      ! ocean variables trends
20   USE zdf_oce         ! ocean vertical physics
21   USE in_out_manager  ! I/O manager
22   USE phycst          ! Define parameters for the routines
23   USE ldfdyn_oce      ! ocean active tracers: lateral physics
24   USE dianam          ! build the name of file (routine)
25   USE zdfmxl          ! mixed layer depth
26   USE ioipsl          ! NetCDF library
27   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
28   USE lib_mpp         ! MPP library
29
30   IMPLICIT NONE
31   PRIVATE
32
33   INTERFACE trd_vor_zint
34      MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
35   END INTERFACE
36
37   PUBLIC   trd_vor        ! routine called by step.F90
38   PUBLIC   trd_vor_zint   ! routine called by dynamics routines
39   PUBLIC   trd_vor_init   ! routine called by opa.F90
40   PUBLIC   trd_vor_alloc  ! routine called by nemogcm.F90
41
42   INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount   ! needs for IOIPSL output
43   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) ::   ndexvor1   ! needed for IOIPSL output
44   INTEGER ::   ndebug     ! (0/1) set it to 1 in case of problem to have more print
45
46   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avr      ! average
47   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrb     ! before vorticity (kt-1)
48   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period
49   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbn    ! after vorticity at time step after the
50   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rotot        ! begining of the NWRITE-1 timesteps
51   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrtot   !
52   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrres   !
53   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd       ! curl of trends
54         
55   CHARACTER(len=12) ::   cvort
56
57   !! * Control permutation of array indices
58#  include "oce_ftrans.h90"
59#  include "dom_oce_ftrans.h90"
60#  include "zdf_oce_ftrans.h90"
61#  include "ldfdyn_oce_ftrans.h90"
62
63   !! * Substitutions
64#  include "domzgr_substitute.h90"
65#  include "ldfdyn_substitute.h90"
66#  include "vectopt_loop_substitute.h90"
67   !!----------------------------------------------------------------------
68   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
69   !! $Id$
70   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
71   !!----------------------------------------------------------------------
72CONTAINS
73
74   INTEGER FUNCTION trd_vor_alloc()
75      !!----------------------------------------------------------------------------
76      !!                  ***  ROUTINE trd_vor_alloc  ***
77      !!----------------------------------------------------------------------------
78      ALLOCATE( vor_avr   (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) ,   &
79         &      vor_avrbn (jpi,jpj) , rotot   (jpi,jpj) , vor_avrtot(jpi,jpj) ,   &
80         &      vor_avrres(jpi,jpj) , vortrd  (jpi,jpj,jpltot_vor) ,              &
81         &      ndexvor1  (jpi*jpj)                                ,   STAT= trd_vor_alloc )
82         !
83      IF( lk_mpp             )   CALL mpp_sum ( trd_vor_alloc )
84      IF( trd_vor_alloc /= 0 )   CALL ctl_warn('trd_vor_alloc: failed to allocate arrays')
85   END FUNCTION trd_vor_alloc
86
87
88   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )
89      !!----------------------------------------------------------------------------
90      !!                  ***  ROUTINE trd_vor_zint  ***
91      !!
92      !! ** Purpose :   computation of vertically integrated vorticity budgets
93      !!              from ocean surface down to control surface (NetCDF output)
94      !!
95      !! ** Method/usage :   integration done over nwrite-1 time steps
96      !!
97      !! ** Action :   trends :
98      !!                  vortrd (,, 1) = Pressure Gradient Trend
99      !!                  vortrd (,, 2) = KE Gradient Trend
100      !!                  vortrd (,, 3) = Relative Vorticity Trend
101      !!                  vortrd (,, 4) = Coriolis Term Trend
102      !!                  vortrd (,, 5) = Horizontal Diffusion Trend
103      !!                  vortrd (,, 6) = Vertical Advection Trend
104      !!                  vortrd (,, 7) = Vertical Diffusion Trend
105      !!                  vortrd (,, 8) = Surface Pressure Grad. Trend
106      !!                  vortrd (,, 9) = Beta V
107      !!                  vortrd (,,10) = forcing term
108      !!                  vortrd (,,11) = bottom friction term
109      !!                  rotot(,) : total cumulative trends over nwrite-1 time steps
110      !!                  vor_avrtot(,) : first membre of vrticity equation
111      !!                  vor_avrres(,) : residual = dh/dt entrainment
112      !!
113      !!      trends output in netCDF format using ioipsl
114      !!----------------------------------------------------------------------
115      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
116      USE wrk_nemo, ONLY:   zudpvor => wrk_2d_1 , zvdpvor => wrk_2d_2   ! total cmulative trends
117      !
118      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index
119      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend
120      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
121      !
122      INTEGER ::   ji, jj       ! dummy loop indices
123      INTEGER ::   ikbu, ikbv   ! local integers
124      !!----------------------------------------------------------------------
125
126      IF( wrk_in_use(2, 1,2) ) THEN
127         CALL ctl_stop('trd_vor_zint_2d: requested workspace arrays unavailable')   ;   RETURN
128      ENDIF
129
130      ! Initialization
131      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp
132      CALL lbc_lnk( putrdvor, 'U', -1. )   ;   CALL lbc_lnk( pvtrdvor, 'V', -1. )      ! lateral boundary condition
133     
134
135      !  =====================================
136      !  I vertical integration of 2D trends
137      !  =====================================
138
139      SELECT CASE (ktrd) 
140      !
141      CASE (jpvor_bfr)        ! bottom friction
142         DO jj = 2, jpjm1
143            DO ji = fs_2, fs_jpim1 
144               ikbu = mbkv(ji,jj)
145               ikbv = mbkv(ji,jj)           
146               zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
147               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
148            END DO
149         END DO
150         !
151      CASE (jpvor_swf)        ! wind stress
152         zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)
153         zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)
154         !
155      END SELECT
156
157      ! Average except for Beta.V
158      zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
159      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
160   
161      ! Curl
162      DO ji=1,jpim1
163         DO jj=1,jpjm1
164            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)       &
165                 &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) / ( e1f(ji,jj) * e2f(ji,jj) )
166         END DO
167      END DO
168      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)      ! Surface mask
169
170      IF( ndebug /= 0 ) THEN
171         IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
172         CALL FLUSH(numout)
173      ENDIF
174      !
175      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('trd_vor_zint_2d : failed to release workspace arrays.')
176      !
177   END SUBROUTINE trd_vor_zint_2d
178
179
180   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )
181      !!----------------------------------------------------------------------------
182      !!                  ***  ROUTINE trd_vor_zint  ***
183      !!
184      !! ** Purpose :   computation of vertically integrated vorticity budgets
185      !!              from ocean surface down to control surface (NetCDF output)
186      !!
187      !! ** Method/usage :   integration done over nwrite-1 time steps
188      !!
189      !! ** Action :     trends :
190      !!                  vortrd (,,1) = Pressure Gradient Trend
191      !!                  vortrd (,,2) = KE Gradient Trend
192      !!                  vortrd (,,3) = Relative Vorticity Trend
193      !!                  vortrd (,,4) = Coriolis Term Trend
194      !!                  vortrd (,,5) = Horizontal Diffusion Trend
195      !!                  vortrd (,,6) = Vertical Advection Trend
196      !!                  vortrd (,,7) = Vertical Diffusion Trend
197      !!                  vortrd (,,8) = Surface Pressure Grad. Trend
198      !!                  vortrd (,,9) = Beta V
199      !!                  vortrd (,,10) = forcing term
200      !!      vortrd (,,11) = bottom friction term
201      !!                  rotot(,) : total cumulative trends over nwrite-1 time steps
202      !!                  vor_avrtot(,) : first membre of vrticity equation
203      !!                  vor_avrres(,) : residual = dh/dt entrainment
204      !!
205      !!      trends output in netCDF format using ioipsl
206      !!----------------------------------------------------------------------
207      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
208      USE wrk_nemo, ONLY:   zubet   => wrk_2d_1,   zvbet => wrk_2d_2   ! Beta.V
209      USE wrk_nemo, ONLY:   zudpvor => wrk_2d_3, zvdpvor => wrk_2d_4   ! total cmulative trends
210      !
211      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index
212
213      !! DCSE_NEMO: This style defeats ftrans
214!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend
215!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
216
217!FTRANS putrdvor pvtrdvor :I :I :z
218      REAL(wp), INTENT(inout) ::   putrdvor(jpi,jpj,jpk)   ! u vorticity trend
219      REAL(wp), INTENT(inout) ::   pvtrdvor(jpi,jpj,jpk)   ! v vorticity trend
220      !
221      INTEGER ::   ji, jj, jk   ! dummy loop indices
222      !!----------------------------------------------------------------------
223     
224      IF( wrk_in_use(2, 1,2,3,4) ) THEN
225         CALL ctl_stop('trd_vor_zint_3d: requested workspace arrays unavailable.')   ;   RETURN
226      ENDIF
227
228      ! Initialization
229      zubet  (:,:) = 0._wp
230      zvbet  (:,:) = 0._wp
231      zudpvor(:,:) = 0._wp
232      zvdpvor(:,:) = 0._wp
233      !
234      CALL lbc_lnk( putrdvor, 'U', -1. )         ! lateral boundary condition on input momentum trends
235      CALL lbc_lnk( pvtrdvor, 'V', -1. )
236
237      !  =====================================
238      !  I vertical integration of 3D trends
239      !  =====================================
240      ! putrdvor and pvtrdvor terms
241#if defined key_z_first
242      DO jj = 1, jpj
243         DO ji = 1, jpi
244            DO jk = 1, jpk
245               zudpvor(ji,jj) = zudpvor(ji,jj) + putrdvor(ji,jj,jk) * fse3u(ji,jj,jk) * e1u(ji,jj) * umask(ji,jj,jk)
246               zvdpvor(ji,jj) = zvdpvor(ji,jj) + pvtrdvor(ji,jj,jk) * fse3v(ji,jj,jk) * e2v(ji,jj) * vmask(ji,jj,jk)
247            END DO
248         END DO
249      END DO
250#else
251      DO jk = 1,jpk
252        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk)
253        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
254      END DO
255#endif
256
257      ! Save Beta.V term to avoid average before Curl
258      ! Beta.V : intergration, no average
259      IF( ktrd == jpvor_bev ) THEN
260         zubet(:,:) = zudpvor(:,:)
261         zvbet(:,:) = zvdpvor(:,:)
262      ENDIF
263
264      ! Average except for Beta.V
265      zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
266      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
267   
268      ! Curl
269      DO ji=1,jpim1
270         DO jj=1,jpjm1
271            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)     &
272               &                  - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )
273         END DO
274      END DO
275
276      ! Surface mask
277      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)
278
279      ! Special treatement for the Beta.V term
280      ! Compute the Curl of the Beta.V term which is not averaged
281      IF( ktrd == jpvor_bev ) THEN
282         DO ji=1,jpim1
283            DO jj=1,jpjm1
284               vortrd(ji,jj,jpvor_bev) = (    zvbet(ji+1,jj) - zvbet(ji,jj)     &
285                  &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )
286            END DO
287         END DO
288
289         ! Average on the Curl
290         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:)
291
292         ! Surface mask
293         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1)
294      ENDIF
295   
296      IF( ndebug /= 0 ) THEN
297         IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
298         CALL FLUSH(numout)
299      ENDIF
300      !
301      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('trd_vor_zint_3d: failed to release workspace arrays')
302      !
303   END SUBROUTINE trd_vor_zint_3d
304
305   !! * Reset control of array index permutation
306!FTRANS CLEAR
307#  include "oce_ftrans.h90"
308#  include "dom_oce_ftrans.h90"
309#  include "zdf_oce_ftrans.h90"
310#  include "ldfdyn_oce_ftrans.h90"
311
312   SUBROUTINE trd_vor( kt )
313      !!----------------------------------------------------------------------
314      !!                  ***  ROUTINE trd_vor  ***
315      !!
316      !! ** Purpose :  computation of cumulated trends over analysis period
317      !!               and make outputs (NetCDF or DIMG format)
318      !!----------------------------------------------------------------------
319      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
320      USE wrk_nemo, ONLY:   zun => wrk_2d_1 , zvn => wrk_2d_2 ! 2D workspace
321      !
322      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
323      !
324      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
325      INTEGER  ::   it, itmod        ! local integers
326      REAL(wp) ::   zmean            ! local scalars
327      !!----------------------------------------------------------------------
328
329      IF( wrk_in_use(2, 1,2) ) THEN
330         CALL ctl_stop('trd_vor: requested workspace arrays unavailable.')   ;   RETURN
331      ENDIF
332
333      !  =================
334      !  I. Initialization
335      !  =================
336     
337     
338      ! I.1 set before values of vertically average u and v
339      ! ---------------------------------------------------
340
341      IF( kt > nit000 )   vor_avrb(:,:) = vor_avr(:,:)
342
343      IF( ndebug /= 0 ) THEN
344          WRITE(numout,*) ' debuging trd_vor: I.1 done '
345          CALL FLUSH(numout)
346      ENDIF
347
348      ! I.2 vertically integrated vorticity
349      !  ----------------------------------
350
351      vor_avr   (:,:) = 0._wp
352      zun       (:,:) = 0._wp
353      zvn       (:,:) = 0._wp
354      vor_avrtot(:,:) = 0._wp
355      vor_avrres(:,:) = 0._wp
356     
357      ! Vertically averaged velocity
358#if defined key_z_first
359      DO jj = 1, jpj
360         DO ji = 1, jpi
361            DO jk = 1, jpk - 1
362               zun(ji,jj) = zun(ji,jj) + e1u(ji,jj) * un(ji,jj,jk) * fse3u(ji,jj,jk)
363               zvn(ji,jj) = zvn(ji,jj) + e2v(ji,jj) * vn(ji,jj,jk) * fse3v(ji,jj,jk)
364            END DO
365         END DO
366      END DO
367#else
368      DO jk = 1, jpk - 1
369         zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)
370         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
371      END DO
372#endif
373 
374      zun(:,:) = zun(:,:) * hur(:,:)
375      zvn(:,:) = zvn(:,:) * hvr(:,:)
376
377      ! Curl
378      DO ji=1,jpim1
379         DO jj=1,jpjm1
380            vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    &
381               &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
382         END DO
383      END DO
384     
385      IF( ndebug /= 0 ) THEN
386         WRITE(numout,*) ' debuging trd_vor: I.2 done'
387         CALL FLUSH(numout)
388      ENDIF
389
390      !  =================================
391      !   II. Cumulated trends
392      !  =================================
393
394      ! II.1 set `before' mixed layer values for kt = nit000+1
395      ! ------------------------------------------------------
396      IF( kt == nit000+1 ) THEN
397         vor_avrbb(:,:) = vor_avrb(:,:)
398         vor_avrbn(:,:) = vor_avr (:,:)
399      ENDIF
400
401      IF( ndebug /= 0 ) THEN
402         WRITE(numout,*) ' debuging trd_vor: I1.1 done'
403         CALL FLUSH(numout)
404      ENDIF
405
406      ! II.2 cumulated trends over analysis period (kt=2 to nwrite)
407      ! ----------------------
408      ! trends cumulated over nwrite-2 time steps
409
410      IF( kt >= nit000+2 ) THEN
411         nmoydpvor = nmoydpvor + 1
412         DO jl = 1, jpltot_vor
413            IF( jl /= 9 ) THEN
414               rotot(:,:) = rotot(:,:) + vortrd(:,:,jl)
415            ENDIF
416         END DO
417      ENDIF
418
419      IF( ndebug /= 0 ) THEN
420         WRITE(numout,*) ' debuging trd_vor: II.2 done'
421         CALL FLUSH(numout)
422      ENDIF
423
424      !  =============================================
425      !   III. Output in netCDF + residual computation
426      !  =============================================
427
428      ! define time axis
429      it    = kt
430      itmod = kt - nit000 + 1
431
432      IF( MOD( it, nn_trd ) == 0 ) THEN
433
434         ! III.1 compute total trend
435         ! ------------------------
436         zmean = 1._wp / (  REAL( nmoydpvor, wp ) * 2._wp * rdt  )
437         vor_avrtot(:,:) = (  vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
438
439         IF( ndebug /= 0 ) THEN
440             WRITE(numout,*) ' zmean = ',zmean
441             WRITE(numout,*) ' debuging trd_vor: III.1 done'
442             CALL FLUSH(numout)
443         ENDIF
444
445         ! III.2 compute residual
446         ! ---------------------
447         zmean = 1._wp / REAL( nmoydpvor, wp )
448         vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
449
450         ! Boundary conditions
451         CALL lbc_lnk( vor_avrtot, 'F', 1. )
452         CALL lbc_lnk( vor_avrres, 'F', 1. )
453
454         IF( ndebug /= 0 ) THEN
455            WRITE(numout,*) ' debuging trd_vor: III.2 done'
456            CALL FLUSH(numout)
457         ENDIF
458
459         ! III.3 time evolution array swap
460         ! ------------------------------
461         vor_avrbb(:,:) = vor_avrb(:,:)
462         vor_avrbn(:,:) = vor_avr (:,:)
463
464         IF( ndebug /= 0 ) THEN
465            WRITE(numout,*) ' debuging trd_vor: III.3 done'
466            CALL FLUSH(numout)
467         ENDIF
468         !
469         nmoydpvor = 0
470         !
471      ENDIF
472
473      ! III.4 write trends to output
474      ! ---------------------------
475
476      IF( kt >=  nit000+1 ) THEN
477
478         IF( lwp .AND. MOD( itmod, nn_trd ) == 0 ) THEN
479            WRITE(numout,*) ''
480            WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt
481            WRITE(numout,*) '~~~~~~~  '
482         ENDIF
483 
484         CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,jpvor_prg),ndimvor1,ndexvor1)  ! grad Ph
485         CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,jpvor_keg),ndimvor1,ndexvor1)  ! Energy
486         CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,jpvor_rvo),ndimvor1,ndexvor1)  ! rel vorticity
487         CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,jpvor_pvo),ndimvor1,ndexvor1)  ! coriolis
488         CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,jpvor_ldf),ndimvor1,ndexvor1)  ! lat diff
489         CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,jpvor_zad),ndimvor1,ndexvor1)  ! vert adv
490         CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,jpvor_zdf),ndimvor1,ndexvor1)  ! vert diff
491         CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,jpvor_spg),ndimvor1,ndexvor1)  ! grad Ps
492         CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,jpvor_bev),ndimvor1,ndexvor1)  ! beta.V
493         CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,jpvor_swf),ndimvor1,ndexvor1) ! wind stress
494         CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,jpvor_bfr),ndimvor1,ndexvor1) ! bottom friction
495         CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot    ,ndimvor1,ndexvor1) ! First membre
496         CALL histwrite( nidvor,"sovorgap",it,vor_avrres    ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
497         !
498         IF( ndebug /= 0 ) THEN
499            WRITE(numout,*) ' debuging trd_vor: III.4 done'
500            CALL FLUSH(numout)
501         ENDIF
502         !
503      ENDIF
504      !
505      IF( MOD( it, nn_trd ) == 0 ) rotot(:,:)=0
506      !
507      IF( kt == nitend )   CALL histclo( nidvor )
508      !
509      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('trd_vor: failed to release workspace arrays')
510      !
511   END SUBROUTINE trd_vor
512
513
514   SUBROUTINE trd_vor_init
515      !!----------------------------------------------------------------------
516      !!                  ***  ROUTINE trd_vor_init  ***
517      !!
518      !! ** Purpose :   computation of vertically integrated T and S budgets
519      !!      from ocean surface down to control surface (NetCDF output)
520      !!----------------------------------------------------------------------
521      REAL(wp) ::   zjulian, zsto, zout
522      CHARACTER (len=40) ::   clhstnam
523      CHARACTER (len=40) ::   clop
524      !!----------------------------------------------------------------------
525
526      !  ===================
527      !   I. initialization
528      !  ===================
529
530      cvort='averaged-vor'
531
532      ! Open specifier
533      ndebug = 0      ! set it to 1 in case of problem to have more Print
534
535      IF(lwp) THEN
536         WRITE(numout,*) ' '
537         WRITE(numout,*) ' trd_vor_init: vorticity trends'
538         WRITE(numout,*) ' ~~~~~~~~~~~~'
539         WRITE(numout,*) ' '
540         WRITE(numout,*) '               ##########################################################################'
541         WRITE(numout,*) '                CAUTION: The interpretation of the vorticity trends is'
542         WRITE(numout,*) '                not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr '
543         WRITE(numout,*) '               ##########################################################################'
544         WRITE(numout,*) ' '
545      ENDIF
546
547      IF( trd_vor_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' )
548
549
550      ! cumulated trends array init
551      nmoydpvor = 0
552      rotot(:,:)=0
553      vor_avrtot(:,:)=0
554      vor_avrres(:,:)=0
555
556      IF( ndebug /= 0 ) THEN
557         WRITE(numout,*) ' debuging trd_vor_init: I. done'
558         CALL FLUSH(numout)
559      ENDIF
560
561      !  =================================
562      !   II. netCDF output initialization
563      !  =================================
564
565      !-----------------------------------------
566      ! II.1 Define frequency of output and means
567      ! -----------------------------------------
568      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
569      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
570      ENDIF
571#if defined key_diainstant
572      zsto = nwrite*rdt
573      clop = "inst("//TRIM(clop)//")"
574#else
575      zsto = rdt
576      clop = "ave("//TRIM(clop)//")"
577#endif
578      zout = nn_trd*rdt
579
580      IF(lwp) WRITE(numout,*) '               netCDF initialization'
581
582      ! II.2 Compute julian date from starting date of the run
583      ! ------------------------
584      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
585      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
586      IF(lwp) WRITE(numout,*)' ' 
587      IF(lwp) WRITE(numout,*)'               Date 0 used :',nit000,    &
588         &                   ' YEAR ', nyear,' MONTH '      , nmonth,   &
589         &                   ' DAY ' , nday, 'Julian day : ', zjulian
590
591      ! II.3 Define the T grid trend file (nidvor)
592      ! ---------------------------------
593      CALL dia_nam( clhstnam, nn_trd, 'vort' )                  ! filename
594      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
595      CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi,   &  ! Horizontal grid : glamt and gphit
596         &          1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
597      CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 )    ! surface
598
599      ! Declare output fields as netCDF variables
600      CALL histdef( nidvor, "sovortPh", cvort//"grad Ph" , "s-2",        & ! grad Ph
601         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
602      CALL histdef( nidvor, "sovortEk", cvort//"Energy", "s-2",          & ! Energy
603         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
604      CALL histdef( nidvor, "sovozeta", cvort//"rel vorticity", "s-2",   & ! rel vorticity
605         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
606      CALL histdef( nidvor, "sovortif", cvort//"coriolis", "s-2",        & ! coriolis
607         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
608      CALL histdef( nidvor, "sovodifl", cvort//"lat diff ", "s-2",       & ! lat diff
609         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
610      CALL histdef( nidvor, "sovoadvv", cvort//"vert adv", "s-2",        & ! vert adv
611         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
612      CALL histdef( nidvor, "sovodifv", cvort//"vert diff" , "s-2",      & ! vert diff
613         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
614      CALL histdef( nidvor, "sovortPs", cvort//"grad Ps", "s-2",         & ! grad Ps
615         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
616      CALL histdef( nidvor, "sovortbv", cvort//"Beta V", "s-2",          & ! beta.V
617         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
618      CALL histdef( nidvor, "sovowind", cvort//"wind stress", "s-2",     & ! wind stress
619         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
620      CALL histdef( nidvor, "sovobfri", cvort//"bottom friction", "s-2", & ! bottom friction
621         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
622      CALL histdef( nidvor, "1st_mbre", cvort//"1st mbre", "s-2",        & ! First membre
623         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
624      CALL histdef( nidvor, "sovorgap", cvort//"gap", "s-2",             & ! gap between 1st and 2 nd mbre
625         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
626      CALL histend( nidvor, snc4set )
627
628      IF( ndebug /= 0 ) THEN
629         WRITE(numout,*) ' debuging trd_vor_init: II. done'
630         CALL FLUSH(numout)
631      ENDIF
632      !
633   END SUBROUTINE trd_vor_init
634
635#else
636   !!----------------------------------------------------------------------
637   !!   Default option :                                       Empty module
638   !!----------------------------------------------------------------------
639   INTERFACE trd_vor_zint
640      MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
641   END INTERFACE
642CONTAINS
643   SUBROUTINE trd_vor( kt )        ! Empty routine
644      WRITE(*,*) 'trd_vor: You should not have seen this print! error?', kt
645   END SUBROUTINE trd_vor
646   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )
647      REAL, DIMENSION(:,:), INTENT( inout ) ::   putrdvor, pvtrdvor
648      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
649      WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd
650   END SUBROUTINE trd_vor_zint_2d
651   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )
652      REAL, DIMENSION(:,:,:), INTENT( inout ) ::   putrdvor, pvtrdvor
653      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
654      WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd
655   END SUBROUTINE trd_vor_zint_3d
656   SUBROUTINE trd_vor_init              ! Empty routine
657      WRITE(*,*) 'trd_vor_init: You should not have seen this print! error?'
658   END SUBROUTINE trd_vor_init
659#endif
660   !!======================================================================
661END MODULE trdvor
Note: See TracBrowser for help on using the repository browser.