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.
trdtrc_oce.F90 in NEMO/branches/UKMO/r8395_cpl-pressure/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: NEMO/branches/UKMO/r8395_cpl-pressure/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90 @ 10797

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

Remove svn keywords

File size: 9.3 KB
Line 
1MODULE trdtrc_oce
2   !!======================================================================
3   !!                   ***  MODULE trdtrc_oce  ***
4   !! Ocean trends :   set tracer and momentum trend variables
5   !!======================================================================
6#if defined key_top
7   !!----------------------------------------------------------------------
8   !!   'key_top'                                                TOP models
9   !!----------------------------------------------------------------------
10   USE par_oce       ! ocean parameters
11   USE par_trc       ! passive tracers parameters
12
13   IMPLICIT NONE
14   PUBLIC
15
16   !                                         !!* Namelist namtoptrd:  diagnostics on passive tracers trends
17   INTEGER  ::    nn_trd_trc                  !: time step frequency dynamics and tracers trends
18   INTEGER  ::    nn_ctls_trc                 !: control surface type for trends vertical integration
19   REAL(wp) ::    rn_ucf_trc                  !: unit conversion factor (for netCDF trends outputs)
20   LOGICAL  ::    ln_trdmxl_trc_instant       !: flag to diagnose inst./mean ML trc trends
21   LOGICAL  ::    ln_trdmxl_trc_restart       !: flag to restart mixed-layer trc diagnostics
22   CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input)
23   CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output)
24   LOGICAL, DIMENSION(:), ALLOCATABLE ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist)
25
26# if defined key_trdtrc && defined key_iomput
27   LOGICAL, PARAMETER ::   lk_trdtrc = .TRUE. 
28# else
29   LOGICAL, PARAMETER ::   lk_trdtrc = .FALSE.   !: ML trend flag
30# endif
31
32# if defined key_trdmxl_trc
33   !!----------------------------------------------------------------------
34   !!   'key_trdmxl_trc'                     mixed layer trends diagnostics
35   !!----------------------------------------------------------------------
36
37   LOGICAL, PARAMETER ::   lk_trdmxl_trc = .TRUE.    !: ML trend flag
38
39   INTEGER, PARAMETER ::            & !: mixed layer trends indices
40        jpmxl_trc_xad     =  1,     & !:     zonal       advection     
41        jpmxl_trc_yad     =  2,     & !:     meridonal   =========
42        jpmxl_trc_zad     =  3,     & !:     vertical    =========
43        jpmxl_trc_ldf     =  4,     & !:     lateral diffusion (geopot. or iso-neutral)
44        jpmxl_trc_zdf     =  5,     & !:     vertical diffusion (TKE)
45        jpmxl_trc_bbl     =  6,     & !:     bottom boundary layer (advective/diffusive)
46        jpmxl_trc_dmp     =  7,     & !:     internal restoring trend
47        jpmxl_trc_sbc     =  8,     & !:     forcing
48        jpmxl_trc_sms     =  9,     & !:     sources minus sinks trend
49  !     jpmxl_trc_xxx     = xx,     & !:     add here any additional trend    (** AND UPDATE JPLTRD_TRC BELOW **)
50        jpmxl_trc_radn    = 10,     & !:     corr. trn<0 in trcrad
51        jpmxl_trc_radb    = 11,     & !:     corr. trb<0 in trcrad (like atf) (** MUST BE BEFORE THE LAST ONE **)
52        jpmxl_trc_atf     = 12        !:     asselin trend                    (** MUST BE    THE      LAST ONE**)
53
54   !! Trends diagnostics parameters
55   !!---------------------------------------------------------------------
56   INTEGER, PARAMETER :: jpltrd_trc = 12    !: number of mixed-layer trends arrays
57     
58   INTEGER            :: jpktrd_trc         !: max level for mixed-layer trends diag.
59
60   !! Arrays used for diagnosing mixed-layer trends
61   !!---------------------------------------------------------------------
62   CHARACTER(LEN=80) :: clname_trc, ctrd_trc(jpltrd_trc+1,2)
63
64   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &
65      nmld_trc       , &                            !: mixed layer depth indexes
66      nbol_trc                                   !: mixed-layer depth indexes when read from file
67
68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  wkx_trc  !:
69
70   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmld_trc     !: ML depth (m) corresponding to nmld_trc
71   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth
72   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmldbn_trc   !: idem
73
74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &
75      tml_trc    ,                        &      !: \ "now" mixed layer temperature/salinity
76      tmlb_trc   ,                        &      !: /  and associated "before" fields
77      tmlbb_trc  ,                        &      !: \  idem, but valid at the 1rst time step of the
78      tmlbn_trc  ,                        &      !: /  current analysis window
79      tml_sum_trc,                        &      !: mixed layer T, summed over the current analysis period
80      tml_sumb_trc,                       &      !: idem, but from the previous analysis period
81      tmltrd_atf_sumb_trc,                &      !: Asselin trends, summed over the previous analysis period
82      tmltrd_rad_sumb_trc                        !: trends due to trb correction in trcrad.F90, summed over the
83                                                 !:     previous analysis period
84                                                 
85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &     
86      tmlatfb_trc, tmlatfn_trc ,          &      !: "before" Asselin contrib. at beginning of the averaging
87                                                 !:     period (i.e. last contrib. from previous such period)
88                                                 !:     and "now" Asselin contrib. to the ML trc. trends
89      tmlatfm_trc,                        &      !: accumulator for Asselin trends (needed for storage only)
90      tmlradb_trc, tmlradn_trc ,          &      !: similar to Asselin above, but for the trend due to trb
91                                                 !:     correction in trcrad.F90
92      tmlradm_trc                                !: accumulator for the previous trcrad trend
93
94   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  &
95      tmltrd_trc,                         &      !: \ physical contributions to the total trend (for T/S),
96                                                 !: / cumulated over the current analysis window
97      tmltrd_sum_trc,                     &      !: sum of these trends over the analysis period
98      tmltrd_csum_ln_trc,                 &      !: now cumulated sum of trends over the "lower triangle"
99      tmltrd_csum_ub_trc                         !: before (prev. analysis period) cumulated sum over the
100                                                 !: upper triangle
101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &
102      tmltrdm_trc                                !: total cumulative trends over the analysis window
103
104# else
105   LOGICAL, PARAMETER ::   lk_trdmxl_trc = .FALSE.   !: ML trend flag
106# endif
107
108   !!----------------------------------------------------------------------
109   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
110   !! $Id$
111   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
112   !!----------------------------------------------------------------------
113CONTAINS
114
115   INTEGER FUNCTION trd_trc_oce_alloc()
116      !!----------------------------------------------------------------------
117      !!         *** ROUTINE trd_trc_oce_alloc ***
118      !!----------------------------------------------------------------------
119      USE lib_mpp, ONLY: ctl_warn
120      INTEGER :: ierr(2)
121      !!----------------------------------------------------------------------
122      ierr(:) = 0
123      !
124# if defined key_trdmxl_trc
125      ALLOCATE(nmld_trc(jpi,jpj),          nbol_trc(jpi,jpj),           &
126               wkx_trc(jpi,jpj,jpk),       rmld_trc(jpi,jpj),           &
127               rmld_sum_trc(jpi,jpj),      rmldbn_trc(jpi,jpj),         &
128               tml_trc(jpi,jpj,jptra),     tmlb_trc(jpi,jpj,jptra),     &
129               tmlbb_trc(jpi,jpj,jptra),   tmlbn_trc(jpi,jpj,jptra),    &
130               tml_sum_trc(jpi,jpj,jptra), tml_sumb_trc(jpi,jpj,jptra), &
131               tmltrd_atf_sumb_trc(jpi,jpj,jptra),                      &
132               tmltrd_rad_sumb_trc(jpi,jpj,jptra),                      &
133               !
134               tmlatfb_trc(jpi,jpj,jptra), tmlatfn_trc(jpi,jpj,jptra),  &
135               tmlatfm_trc(jpi,jpj,jptra), tmlradb_trc(jpi,jpj,jptra),  &
136               tmlradn_trc(jpi,jpj,jptra), tmlradm_trc(jpi,jpj,jptra),  &
137               !
138               tmltrd_trc(jpi,jpj,jpltrd_trc,jptra)         , &
139               tmltrd_sum_trc(jpi,jpj,jpltrd_trc,jptra)     , &
140               tmltrd_csum_ln_trc(jpi,jpj,jpltrd_trc,jptra) , &
141               tmltrd_csum_ub_trc(jpi,jpj,jpltrd_trc,jptra) , &
142               !
143               tmltrdm_trc(jpi,jpj,jptra)                   , STAT=ierr(1) )
144#endif
145      !
146      trd_trc_oce_alloc = MAXVAL(ierr)
147      !
148      IF( trd_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_trc_oce_alloc: failed to allocate arrays')
149      !
150# if defined key_trdmxl_trc
151      jpktrd_trc = jpk      ! Initialise what used to be a parameter - max level for mixed-layer trends diag.
152# endif
153      !
154   END FUNCTION trd_trc_oce_alloc
155
156#else
157   !!----------------------------------------------------------------------
158   !!  Empty module :                                     No passive tracer
159   !!----------------------------------------------------------------------
160#endif
161
162   !!======================================================================
163END MODULE trdtrc_oce
Note: See TracBrowser for help on using the repository browser.