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.
trcnam.F90 in branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcnam.F90 @ 6201

Last change on this file since 6201 was 6201, checked in by jpalmier, 8 years ago

JPALM -- 04-01-2016 -- add debugg prints under debugg_key

File size: 22.9 KB
Line 
1MODULE trcnam
2   !!======================================================================
3   !!                       ***  MODULE trcnam  ***
4   !! TOP :   Read and print options for the passive tracer run (namelist)
5   !!======================================================================
6   !! History :    -   !  1996-11  (M.A. Foujols, M. Levy)  original code
7   !!              -   !  1998-04  (M.A Foujols, L. Bopp) ahtrb0 for isopycnal mixing
8   !!              -   !  1999-10  (M.A. Foujols, M. Levy) separation of sms
9   !!              -   !  2000-07  (A. Estublier) add TVD and MUSCL : Tests on ndttrc
10   !!              -   !  2000-11  (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0
11   !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes
12   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
13   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2
14   !!----------------------------------------------------------------------
15#if defined key_top
16   !!----------------------------------------------------------------------
17   !!   'key_top'                                                TOP models
18   !!----------------------------------------------------------------------
19   !!   trc_nam    :  Read and print options for the passive tracer run (namelist)
20   !!----------------------------------------------------------------------
21   USE oce_trc           ! shared variables between ocean and passive tracers
22   USE trc               ! passive tracers common variables
23   USE trcnam_trp        ! Transport namelist
24   USE trcnam_pisces     ! PISCES namelist
25   USE trcnam_cfc        ! CFC SMS namelist
26   USE trcnam_c14b       ! C14 SMS namelist
27   USE trcnam_my_trc     ! MY_TRC SMS namelist
28   USE trcnam_medusa     ! MEDUSA namelist
29   USE trcnam_idtra      ! Idealise tracer namelist
30   USE trd_oce       
31   USE trdtrc_oce
32   USE iom               ! I/O manager
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC trc_nam_run  ! called in trcini
38   PUBLIC trc_nam      ! called in trcini
39
40   !! * Substitutions
41#  include "top_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
44   !! $Id$
45   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47
48CONTAINS
49
50
51   SUBROUTINE trc_nam
52      !!---------------------------------------------------------------------
53      !!                     ***  ROUTINE trc_nam  ***
54      !!
55      !! ** Purpose :   READ and PRINT options for the passive tracer run (namelist)
56      !!
57      !! ** Method  : - read passive tracer namelist
58      !!              - read namelist of each defined SMS model
59      !!                ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA )
60      !!---------------------------------------------------------------------
61      INTEGER  ::   jn, jk                     ! dummy loop indice
62      !                                        !   Parameters of the run
63      IF( .NOT. lk_offline ) CALL trc_nam_run
64     
65      !                                        !  passive tracer informations
66# if defined key_debug_medusa
67      CALL flush(numout)
68      IF (lwp) write (numout,*) '------------------------------'
69      IF (lwp) write (numout,*) 'Jpalm - debug'
70      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc'
71      IF (lwp) write (numout,*) ' '
72# endif
73      !
74      CALL trc_nam_trc
75     
76      !                                        !   Parameters of additional diagnostics
77# if defined key_debug_medusa
78      CALL flush(numout)
79      IF (lwp) write (numout,*) '------------------------------'
80      IF (lwp) write (numout,*) 'Jpalm - debug'
81      IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK'
82      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia'
83      IF (lwp) write (numout,*) ' '
84# endif
85      !
86
87      CALL trc_nam_dia
88
89      !                                        !   namelist of transport
90# if defined key_debug_medusa
91      CALL flush(numout)
92      IF (lwp) write (numout,*) '------------------------------'
93      IF (lwp) write (numout,*) 'Jpalm - debug'
94      IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK'
95      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp'
96      IF (lwp) write (numout,*) ' '
97# endif
98      !
99      CALL trc_nam_trp
100      !
101# if defined key_debug_medusa
102      CALL flush(numout)
103      IF (lwp) write (numout,*) '------------------------------'
104      IF (lwp) write (numout,*) 'Jpalm - debug'
105      IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK'
106      IF (lwp) write (numout,*) 'continue trc_nam '
107      IF (lwp) write (numout,*) ' '
108      CALL flush(numout)
109# endif
110      !
111
112
113      IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data
114      !
115      IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data
116      !
117      IF( .NOT.ln_trcdta ) THEN
118         ln_trc_ini(:) = .FALSE.
119      ENDIF
120
121     IF(lwp) THEN                   ! control print
122         WRITE(numout,*)
123         WRITE(numout,*) ' Namelist : namtrc'
124         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta
125         WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp
126         WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo
127         WRITE(numout,*) ' '
128         DO jn = 1, jptra
129            WRITE(numout,*) '  tracer nb : ', jn, '    short name : ', ctrcnm(jn)
130         END DO
131         WRITE(numout,*) ' '
132# if defined key_debug_medusa
133      CALL flush(numout)
134# endif
135      ENDIF
136
137      IF(lwp) THEN                   ! control print
138         IF( ln_rsttr ) THEN
139            WRITE(numout,*)
140            WRITE(numout,*) '  Read a restart file for passive tracer : ', TRIM( cn_trcrst_in )
141            WRITE(numout,*)
142         ENDIF
143         IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN
144            WRITE(numout,*)
145            WRITE(numout,*) '  Some of the passive tracers are initialised from climatologies '
146            WRITE(numout,*)
147         ENDIF
148         IF( .NOT.ln_trcdta ) THEN
149            WRITE(numout,*)
150            WRITE(numout,*) '  All the passive tracers are initialised with constant values '
151            WRITE(numout,*)
152         ENDIF
153# if defined key_debug_medusa
154      CALL flush(numout)
155# endif
156      ENDIF
157
158# if defined key_debug_medusa
159       DO jk = 1, jpk
160          WRITE(numout,*) '  level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc
161       END DO
162      CALL flush(numout)
163# endif
164     
165      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step
166 
167      IF(lwp) THEN                   ! control print
168        WRITE(numout,*) 
169        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1)
170        WRITE(numout,*) 
171# if defined key_debug_medusa
172      CALL flush(numout)
173# endif
174      ENDIF
175
176
177#if defined key_trdmxl_trc || defined key_trdtrc
178
179         REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends
180         READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905)
181905      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp )
182
183         REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends
184         READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 )
185906      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp )
186         IF(lwm) WRITE ( numont, namtrc_trd )
187
188         IF(lwp) THEN
189            WRITE(numout,*)
190            WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd                    '
191            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               '
192            WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc
193            WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc
194            WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart
195            WRITE(numout,*) '   * flag to diagnose trends of                                 '
196            WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant
197            WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc
198            DO jn = 1, jptra
199               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn
200            END DO
201         WRITE(numout,*) ' '
202         CALL flush(numout)
203         ENDIF
204#endif
205
206# if defined key_debug_medusa
207      CALL flush(numout)
208      IF (lwp) write (numout,*) '------------------------------'
209      IF (lwp) write (numout,*) 'Jpalm - debug'
210      IF (lwp) write (numout,*) 'just before ice module for tracers call : '
211      IF (lwp) write (numout,*) ' '
212# endif
213      !
214
215      ! Call the ice module for tracers
216      ! -------------------------------
217      CALL trc_nam_ice
218
219# if defined key_debug_medusa
220      CALL flush(numout)
221      IF (lwp) write (numout,*) '------------------------------'
222      IF (lwp) write (numout,*) 'Jpalm - debug'
223      IF (lwp) write (numout,*) 'Will now read SMS namelists : '
224      IF (lwp) write (numout,*) ' '
225# endif
226      !
227
228      ! namelist of SMS
229      ! ---------------     
230      IF( lk_pisces  ) THEN   ;   CALL trc_nam_pisces      ! PISCES  bio-model
231      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
232      ENDIF
233      !
234# if defined key_debug_medusa
235      CALL flush(numout)
236      IF (lwp) write (numout,*) '------------------------------'
237      IF (lwp) write (numout,*) 'Jpalm - debug'
238      IF (lwp) write (numout,*) 'CALL trc_nam_pisces  -- OK'
239      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa'
240      IF (lwp) write (numout,*) ' '
241# endif
242      !
243      IF( lk_medusa  ) THEN   ;   CALL trc_nam_medusa      ! MEDUSA  tracers
244      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MEDUSA not used'
245      ENDIF
246      !
247# if defined key_debug_medusa
248      CALL flush(numout)
249      IF (lwp) write (numout,*) '------------------------------'
250      IF (lwp) write (numout,*) 'Jpalm - debug'
251      IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK'
252      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra'
253      IF (lwp) write (numout,*) ' '
254# endif
255      !
256      IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers
257      ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used'
258      ENDIF
259      !
260# if defined key_debug_medusa
261      CALL flush(numout)
262      IF (lwp) write (numout,*) '------------------------------'
263      IF (lwp) write (numout,*) 'Jpalm - debug'
264      IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK'
265      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc'
266      IF (lwp) write (numout,*) ' '
267# endif
268      !
269      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
270      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
271      ENDIF
272      !
273# if defined key_debug_medusa
274      CALL flush(numout)
275      IF (lwp) write (numout,*) '------------------------------'
276      IF (lwp) write (numout,*) 'Jpalm - debug'
277      IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK'
278      IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam OK'
279      IF (lwp) write (numout,*) ' '
280# endif
281      !
282      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers
283      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
284      ENDIF
285
286      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
287      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
288      ENDIF
289       
290      IF(lwp)   CALL flush(numout)
291   END SUBROUTINE trc_nam
292
293   SUBROUTINE trc_nam_run
294      !!---------------------------------------------------------------------
295      !!                     ***  ROUTINE trc_nam  ***
296      !!
297      !! ** Purpose :   read options for the passive tracer run (namelist)
298      !!
299      !!---------------------------------------------------------------------
300      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, &
301        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
302
303
304      INTEGER  ::   ios                 ! Local integer output status for namelist read
305
306      !!---------------------------------------------------------------------
307
308
309      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
310      IF(lwp) WRITE(numout,*) '~~~~~~~'
311
312      CALL ctl_opn( numnat_ref, 'namelist_top_ref'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
313      CALL ctl_opn( numnat_cfg, 'namelist_top_cfg'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
314      IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 )
315
316      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
317      READ  ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901)
318901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp )
319
320      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
321      READ  ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 )
322902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp )
323      IF(lwm) WRITE ( numont, namtrc_run )
324
325      !  computes the first time step of tracer model
326      nittrc000 = nit000 + nn_dttrc - 1
327
328      IF(lwp) THEN                   ! control print
329         WRITE(numout,*)
330         WRITE(numout,*) ' Namelist : namtrc_run'
331         WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc
332         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr
333         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr
334         WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000
335         WRITE(numout,*) '   frequency of outputs for passive tracers     nn_writetrc   = ', nn_writetrc 
336         WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler
337         WRITE(numout,*) ' '
338        CALL flush(numout)
339      ENDIF
340      !
341    END SUBROUTINE trc_nam_run
342
343   SUBROUTINE trc_nam_ice
344      !!---------------------------------------------------------------------
345      !!                     ***  ROUTINE trc_nam_ice ***
346      !!
347      !! ** Purpose :   Read the namelist for the ice effect on tracers
348      !!
349      !! ** Method  : -
350      !!
351      !!---------------------------------------------------------------------
352      ! --- Variable declarations --- !
353      INTEGER :: jn      ! dummy loop indices
354      INTEGER :: ios     ! Local integer output status for namelist read
355
356      ! --- Namelist declarations --- !
357      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer
358      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
359
360      IF(lwp) THEN
361         WRITE(numout,*)
362         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
363         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
364      ENDIF
365
366      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice')
367
368      !
369      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
370      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
371 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )
372
373      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
374      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
375 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )
376
377      IF( lwp ) THEN
378         WRITE(numout,*) ' '
379         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
380         WRITE(numout,*) ' '
381      ENDIF
382
383      ! Assign namelist stuff
384      DO jn = 1, jptra
385         trc_ice_ratio(jn)  = sn_tri_tracer(jn)%trc_ratio
386         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
387         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o
388      END DO
389
390      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice')
391      !
392   END SUBROUTINE trc_nam_ice
393
394   SUBROUTINE trc_nam_trc
395      !!---------------------------------------------------------------------
396      !!                     ***  ROUTINE trc_nam  ***
397      !!
398      !! ** Purpose :   read options for the passive tracer run (namelist)
399      !!
400      !!---------------------------------------------------------------------
401      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput
402      !!
403      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo
404 
405      INTEGER  ::   ios                 ! Local integer output status for namelist read
406      INTEGER  ::   jn                  ! dummy loop indice
407      !!---------------------------------------------------------------------
408      IF(lwp) WRITE(numout,*)
409      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
410      IF(lwp) WRITE(numout,*) '~~~~~~~'
411
412
413      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
414      READ  ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901)
415901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp )
416
417      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
418      READ  ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 )
419902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp )
420      IF(lwm) WRITE ( numont, namtrc )
421
422      DO jn = 1, jptra
423         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname )
424         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname )
425         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  )
426         ln_trc_ini(jn) =       sn_tracer(jn)%llinit
427         ln_trc_wri(jn) =       sn_tracer(jn)%llsave
428      END DO
429      IF(lwp)  CALL flush(numout)     
430
431    END SUBROUTINE trc_nam_trc
432
433
434   SUBROUTINE trc_nam_dia
435      !!---------------------------------------------------------------------
436      !!                     ***  ROUTINE trc_nam_dia  ***
437      !!
438      !! ** Purpose :   read options for the passive tracer diagnostics
439      !!
440      !! ** Method  : - read passive tracer namelist
441      !!              - read namelist of each defined SMS model
442      !!                ( (PISCES, CFC, MY_TRC )
443      !!---------------------------------------------------------------------
444      INTEGER ::  ierr
445#if defined key_trdmxl_trc  || defined key_trdtrc
446      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
447         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, &
448         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
449#endif
450      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio
451
452      INTEGER  ::   ios                 ! Local integer output status for namelist read
453      !!---------------------------------------------------------------------
454
455      IF(lwp) WRITE(numout,*) 
456      IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options'
457      IF(lwp) WRITE(numout,*) '~~~~~~~'
458
459      IF(lwp) WRITE(numout,*)
460      IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options'
461      IF(lwp) WRITE(numout,*) '~~~~~~~'
462
463      REWIND( numnat_ref )              ! Namelist namtrc_dia in reference namelist : Passive tracer diagnostics
464      READ  ( numnat_ref, namtrc_dia, IOSTAT = ios, ERR = 903)
465903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dia in reference namelist', lwp )
466
467      REWIND( numnat_cfg )              ! Namelist namtrc_dia in configuration namelist : Passive tracer diagnostics
468      READ  ( numnat_cfg, namtrc_dia, IOSTAT = ios, ERR = 904 )
469904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dia in configuration namelist', lwp )
470      IF(lwm) WRITE ( numont, namtrc_dia )
471
472      IF(lwp) THEN
473         WRITE(numout,*)
474         WRITE(numout,*)
475         WRITE(numout,*) ' Namelist : namtrc_dia'
476         WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc
477         WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio
478         WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia
479         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio
480         WRITE(numout,*) ' '
481         CALL flush(numout)
482      ENDIF
483!!
484!! JPALM -- 17-07-2015 --
485!! MEDUSA is not yet up-to-date with the iom server.
486!! we use it for the main tracer, but not fully with diagnostics.
487!! will have to adapt it properly when visiting Christian Ethee
488!! for now, we change
489!! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN
490!! to :
491!!
492      IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN
493         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  &
494           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  & 
495           &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr ) 
496         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' )
497         !
498         trc2d(:,:,:  ) = 0._wp  ;   ctrc2d(:) = ' '   ;   ctrc2l(:) = ' '    ;    ctrc2u(:) = ' ' 
499         trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' ' 
500         !
501      !! ELSE IF  ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN
502      !!    CALL trc_nam_iom_medusa
503      ENDIF
504
505      IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN
506         ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , &
507           &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr ) 
508         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' )
509         !
510         trbio(:,:,:,:) = 0._wp  ;   ctrbio(:) = ' '   ;   ctrbil(:) = ' '    ;    ctrbiu(:) = ' ' 
511         !
512      ENDIF
513      !
514   END SUBROUTINE trc_nam_dia
515
516#else
517   !!----------------------------------------------------------------------
518   !!  Dummy module :                                     No passive tracer
519   !!----------------------------------------------------------------------
520CONTAINS
521   SUBROUTINE trc_nam                      ! Empty routine   
522   END SUBROUTINE trc_nam
523   SUBROUTINE trc_nam_run                      ! Empty routine   
524   END SUBROUTINE trc_nam_run
525#endif
526
527   !!----------------------------------------------------------------------
528   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
529   !! $Id$
530   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
531   !!======================================================================
532END MODULE  trcnam
Note: See TracBrowser for help on using the repository browser.