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.
trc.F90 in branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/TOP_SRC/trc.F90 @ 4291

Last change on this file since 4291 was 4148, checked in by cetlod, 10 years ago

merge in trunk changes between r3853 and r3940 and commit the changes, see ticket #1169

  • Property svn:keywords set to Id
File size: 17.9 KB
Line 
1MODULE trc
2   !!======================================================================
3   !!                      ***  MODULE  trc  ***
4   !! Passive tracers   :  module for tracers defined
5   !!======================================================================
6   !! History :   OPA  !  1996-01  (M. Levy)  Original code
7   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
8   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module
9   !!----------------------------------------------------------------------
10#if defined key_top
11   !!----------------------------------------------------------------------
12   !!   'key_top'                                                TOP models
13   !!----------------------------------------------------------------------
14   USE par_oce
15   USE par_trc
16   
17   IMPLICIT NONE
18   PUBLIC
19
20   PUBLIC   trc_alloc   ! called by nemogcm.F90
21
22   !! parameters for the control of passive tracers
23   !! ---------------------------------------------   
24   INTEGER, PUBLIC                                                 ::   numnat_ref = -1   !: logical unit for the reference passive tracer namelist_top_ref
25   INTEGER, PUBLIC                                                 ::   numnat_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg
26   INTEGER, PUBLIC                                                 ::   numont     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top
27   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics
28   INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read )
29   INTEGER, PUBLIC                                                 ::   numrtw        !: logical unit for trc restart ( write )
30
31   !! passive tracers fields (before,now,after)
32   !! --------------------------------------------------
33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)               ::  trai           !: initial total tracer
34   REAL(wp), PUBLIC                                                ::  areatot        !: total volume
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option-
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step
38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step
39
40   !! interpolated gradient
41   !!-------------------------------------------------- 
42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtru           !: hor. gradient at u-points at bottom ocean level
43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrv           !: hor. gradient at v-points at bottom ocean level
44   
45   !! passive tracers  (input and output)
46   !! ------------------------------------------ 
47   LOGICAL             , PUBLIC                                    ::  ln_rsttr       !: boolean term for restart i/o for passive tracers (namelist)
48   LOGICAL             , PUBLIC                                    ::  lrst_trc       !: logical to control the trc restart write
49   INTEGER             , PUBLIC                                    ::  nn_writetrc    !: time step frequency for concentration outputs (namelist)
50   INTEGER             , PUBLIC                                    ::  nutwrs         !: output FILE for passive tracers restart
51   INTEGER             , PUBLIC                                    ::  nutrst         !: logical unit for restart FILE for passive tracers
52   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr.
53   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input)
54   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
55   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step
56   LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration
57   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files
58   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag
59   LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas
60   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model
61
62   !! information for outputs
63   !! --------------------------------------------------
64   TYPE, PUBLIC :: PTRACER                                                            !: Passive tracer type
65       CHARACTER(len = 20)  :: clsname  !: short name
66       CHARACTER(len = 80)  :: cllname  !: long name
67       CHARACTER(len = 20)  :: clunit   !: unit
68       LOGICAL              :: llinit   !: read in a file or not
69       LOGICAL              :: llsave   !: save the tracer or not
70   END TYPE PTRACER
71   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name
72   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name
73   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit
74   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_wri     !: save the tracer or not
75
76   TYPE, PUBLIC :: DIAG                                                               !: passive trcacer ddditional diagnostic type
77      CHARACTER(len = 20)  :: sname    !: short name
78      CHARACTER(len = 80)  :: lname    !: long name
79      CHARACTER(len = 20)  :: units    !: unit
80   END TYPE DIAG
81
82   !! information for inputs
83   !! --------------------------------------------------
84   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file
85   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_obc     !: Use open boundary condition data
86   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_sbc     !: Use surface boundary condition data
87   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_cbc     !: Use coastal boundary condition data
88
89   !! additional 2D/3D outputs namelist
90   !! --------------------------------------------------
91   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d         !: additional 2d outputs array
92   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d         !: additional 3d outputs array
93   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2d        !: 2d field short name
94   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2l        !: 2d field long name
95   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2u        !: 2d field unit
96   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3d        !: 3d field short name
97   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3l        !: 3d field long name
98   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3u        !: 3d field unit
99   LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic
100   INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs
101
102   !! Biological trends
103   !! -----------------
104   LOGICAL            , PUBLIC                                        ::  ln_diabio      !: boolean term for biological diagnostic
105   INTEGER            , PUBLIC                                        ::  nn_writebio    !: frequency of biological outputs
106   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trbio          !: biological trends
107   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbio         !: bio field short name
108   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbil         !: bio field long name
109   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbiu         !: bio field unit
110
111   !! variables to average over physics over passive tracer sub-steps.
112   !! ----------------------------------------------------------------
113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_tm       !: i-horizontal velocity average     [m/s]
114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vn_tm       !: j-horizontal velocity average     [m/s]
115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s]
116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_tm      !: vertical diffusivity coeff. at  w-point   [m2/s]
117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !:
118# if defined key_zdfddm
119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s]
120# endif
121#if defined key_ldfslp
122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points
123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points
124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points
125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points
126#endif
127#if defined key_trabbl
128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points
129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm  !: j-direction slope at u-, w-points
130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm  !: j-direction slope at u-, w-points
131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm  !: j-direction slope at u-, w-points
132#endif
133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm     !: average ssh for the now step [m]
134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_tm   !: average ssh for the now step [m]
135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_tm   !: average ssh for the now step [m]
136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m] 
137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_b_hold !:hold sshb from the beginning of each sub-stepping[m] 
138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_b_hold !:hold sshb from the beginning of each sub-stepping[m]
139
140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  rnf_tm     !: river runoff
141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm   !: depth in metres to the bottom of the relevant grid box
142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_tm    !: mixed layer depth average [m]
143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fr_i_tm    !: average ice fraction     [m/s]
144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_tm     !: freshwater budget: volume flux [Kg/m2/s]
145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fmmflx_tm  !: freshwater budget: freezing/melting [Kg/m2/s]
146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_b_hold !: hold emp from the beginning of each sub-stepping[m] 
147   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_tm     !: solar radiation average [m]
148   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  wndm_tm    !: 10m wind average [m]
149   !
150#if defined key_traldf_c3d
151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 3D coefficients ** at T-,U-,V-,W-points
152#elif defined key_traldf_c2d
153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 2D coefficients ** at T-,U-,V-,W-points
154#elif defined key_traldf_c1d
155   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 1D coefficients ** at T-,U-,V-,W-points
156#else
157   REAL(wp), PUBLIC                                        ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 0D coefficients ** at T-,U-,V-,W-points
158#endif
159   !
160#if defined key_traldf_eiv
161#  if defined key_traldf_c3d
162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 3D coefficients **
163#  elif defined key_traldf_c2d
164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 2D coefficients **
165#  elif defined key_traldf_c1d
166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_tm , aeiv_tm, aeiw_tm   !: ** 1D coefficients **
167#  else
168   REAL(wp), PUBLIC                                        ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 0D coefficients **
169#  endif
170#endif
171
172   ! Temporary physical arrays for sub_stepping
173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_temp
174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_temp,vn_temp,wn_temp     !: hold current values of avt, un, vn, wn
175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp, rhop_temp     !: hold current values of avt, un, vn, wn
176   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  e3t_temp,e3u_temp,e3v_temp,e3w_temp     !: hold current values
177   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp
178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_temp, sshu_b_temp, sshu_a_temp
179   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshf_n_temp
180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_temp, sshv_b_temp, sshv_a_temp
181   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hu_temp, hv_temp, hur_temp, hvr_temp
182   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp
183   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp
184   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_temp, qsr_temp, fr_i_temp,wndm_temp
185   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_temp, fmmflx_temp, emp_b_temp
186   !
187#if defined key_trabbl
188   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values
189#endif
190   !
191#if defined key_ldfslp
192   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values
193#endif
194   !
195# if defined key_zdfddm
196   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s]
197# endif
198   !
199#if defined key_traldf_c3d
200   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp   
201#elif defined key_traldf_c2d
202   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 
203#elif defined key_traldf_c1d
204   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 
205#else
206   REAL(wp), PUBLIC                                        ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp
207#endif
208   !
209#if defined key_traldf_eiv
210# if defined key_traldf_c3d
211   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 3D coefficients **
212# elif defined key_traldf_c2d
213   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 2D coefficients **
214# elif defined key_traldf_c1d
215   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_temp , aeiv_temp, aeiw_temp   !: ** 1D coefficients **
216# else
217   REAL(wp), PUBLIC                                        ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 0D coefficients **
218# endif
219# endif
220
221   !!----------------------------------------------------------------------
222   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
223   !! $Id$
224   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
225   !!----------------------------------------------------------------------
226CONTAINS
227
228   INTEGER FUNCTION trc_alloc()
229      !!-------------------------------------------------------------------
230      !!                    *** ROUTINE trc_alloc ***
231      !!-------------------------------------------------------------------
232      USE lib_mpp, ONLY: ctl_warn
233      !!-------------------------------------------------------------------
234      !
235      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       & 
236         &      gtru(jpi,jpj,jpk)     , gtrv(jpi,jpj,jpk)                             ,       &
237         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       &
238         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
239         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  ) 
240
241      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
242      !
243   END FUNCTION trc_alloc
244
245#else
246   !!----------------------------------------------------------------------
247   !!  Empty module :                                     No passive tracer
248   !!----------------------------------------------------------------------
249#endif
250
251   !!======================================================================
252END MODULE trc
Note: See TracBrowser for help on using the repository browser.