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.
trdini.F90 in NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90 @ 10761

Last change on this file since 10761 was 10761, checked in by jcastill, 5 years ago

Remove svn keys

File size: 5.5 KB
Line 
1MODULE trdini
2   !!======================================================================
3   !!                       ***  MODULE  trdini  ***
4   !! Ocean diagnostics:  ocean tracers and dynamic trends
5   !!=====================================================================
6   !! History :   3.5  !  2012-02  (G. Madec) add 3D trends output for T, S, U, V, PE and KE
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   trd_init      : initialization step
11   !!----------------------------------------------------------------------
12   USE dom_oce        ! ocean domain
13   USE trd_oce        ! trends: ocean variables
14   USE trdken         ! trends: 3D kinetic   energy
15   USE trdpen         ! trends: 3D potential energy
16   USE trdglo         ! trends: global domain averaged tracers and dynamics
17   USE trdmxl         ! trends: mixed layer averaged trends (tracer only)
18   USE trdvor         ! trends: vertical averaged vorticity
19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! MPP library
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   trd_init   ! called by nemogcm.F90 module
26
27   !! * Substitutions
28#  include "vectopt_loop_substitute.h90"
29   !!----------------------------------------------------------------------
30   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
31   !! $Id$
32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
33   !!----------------------------------------------------------------------
34CONTAINS
35
36   SUBROUTINE trd_init
37      !!----------------------------------------------------------------------
38      !!                  ***  ROUTINE trd_init  ***
39      !!
40      !! ** Purpose :   Initialization of trend diagnostics
41      !!----------------------------------------------------------------------
42      INTEGER ::   ios   ! local integer
43      !!
44      NAMELIST/namtrd/ ln_dyn_trd, ln_KE_trd, ln_vor_trd, ln_dyn_mxl,   &
45         &             ln_tra_trd, ln_PE_trd, ln_glo_trd, ln_tra_mxl, nn_trd 
46      !!----------------------------------------------------------------------
47      !
48      REWIND( numnam_ref )              ! Namelist namtrd in reference namelist : trends diagnostic
49      READ  ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901 )
50901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in reference namelist', lwp )
51      !
52      REWIND( numnam_cfg )              ! Namelist namtrd in configuration namelist : trends diagnostic
53      READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 )
54902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp )
55      IF(lwm) WRITE( numond, namtrd )
56      !
57      IF(lwp) THEN                  ! control print
58         WRITE(numout,*)
59         WRITE(numout,*) 'trd_init : Momentum/Tracers trends'
60         WRITE(numout,*) '~~~~~~~~'
61         WRITE(numout,*) '   Namelist namtrd : set trends parameters'
62         WRITE(numout,*) '      global domain averaged dyn & tra trends   ln_glo_trd  = ', ln_glo_trd
63         WRITE(numout,*) '      U & V trends: 3D output                   ln_dyn_trd  = ', ln_dyn_trd
64         WRITE(numout,*) '      U & V trends: Mixed Layer averaged        ln_dyn_mxl  = ', ln_dyn_mxl
65         WRITE(numout,*) '      T & S trends: 3D output                   ln_tra_trd  = ', ln_tra_trd
66         WRITE(numout,*) '      T & S trends: Mixed Layer averaged        ln_tra_mxl  = ', ln_tra_mxl
67         WRITE(numout,*) '      Kinetic   Energy trends                   ln_KE_trd   = ', ln_KE_trd
68         WRITE(numout,*) '      Potential Energy trends                   ln_PE_trd   = ', ln_PE_trd
69         WRITE(numout,*) '      Barotropic vorticity trends               ln_vor_trd  = ', ln_vor_trd
70         !
71         WRITE(numout,*) '      frequency of trends diagnostics (glo)     nn_trd      = ', nn_trd
72      ENDIF
73      !
74      !                             ! trend extraction flags 
75      l_trdtra = .FALSE.                                                       ! tracers 
76      IF ( ln_tra_trd .OR. ln_PE_trd .OR. ln_tra_mxl .OR.   &
77         & ln_glo_trd                                       )   l_trdtra = .TRUE. 
78      !
79      l_trddyn = .FALSE.                                                       ! momentum
80      IF ( ln_dyn_trd .OR. ln_KE_trd .OR. ln_dyn_mxl .OR.   &
81         & ln_vor_trd .OR. ln_glo_trd                       )   l_trddyn = .TRUE.
82      !
83
84!!gm check the stop below     
85      IF( ln_dyn_mxl )   CALL ctl_stop( 'ML diag on momentum are not yet coded we stop' )
86      !
87
88!!gm end
89      IF( ln_tra_mxl .OR. ln_vor_trd )   CALL ctl_stop( 'ML tracer and Barotropic vorticity diags are still using old IOIPSL' )
90!!gm end
91      !
92!      IF( .NOT.ln_linssh .AND. ( l_trdtra .OR. l_trddyn ) )  CALL ctl_stop( 'trend diagnostics with variable volume not validated' )
93     
94!!gm  : Potential BUG : 3D output only for vector invariant form!  add a ctl_stop or code the flux form case
95!!gm  : bug/pb for vertical advection of tracer in vvl case: add T.dt[eta] in the output...
96
97      !                             ! diagnostic initialization 
98      IF( ln_glo_trd )   CALL trd_glo_init      ! global domain averaged trends
99      IF( ln_tra_mxl )   CALL trd_mxl_init      ! mixed-layer          trends 
100      IF( ln_vor_trd )   CALL trd_vor_init      ! barotropic vorticity trends
101      IF( ln_KE_trd  )   CALL trd_ken_init      ! 3D Kinetic    energy trends
102      IF( ln_PE_trd  )   CALL trd_pen_init      ! 3D Potential  energy trends
103      !
104   END SUBROUTINE trd_init
105
106   !!======================================================================
107END MODULE trdini
Note: See TracBrowser for help on using the repository browser.