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/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90 @ 7068

Last change on this file since 7068 was 7068, checked in by cetlod, 8 years ago

ROBUST5_CNRS : implementation of part I of new TOP interface - 1st step -, see ticket #1782

  • Property svn:keywords set to Id
File size: 19.0 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   !!----------------------------------------------------------------------
14#if defined key_top
15   !!----------------------------------------------------------------------
16   !!   'key_top'                                                TOP models
17   !!----------------------------------------------------------------------
18   !!   trc_nam    :  Read and print options for the passive tracer run (namelist)
19   !!----------------------------------------------------------------------
20   USE oce_trc           ! shared variables between ocean and passive tracers
21   USE trc               ! passive tracers common variables
22   USE trcnam_pisces     ! PISCES namelist
23   USE trcnam_cfc        ! CFC SMS namelist
24   USE trcnam_c14        ! C14 SMS namelist
25   USE trcnam_age        ! AGE SMS namelist
26   USE trcnam_my_trc     ! MY_TRC SMS namelist
27   USE trd_oce       
28   USE trdtrc_oce
29   USE iom               ! I/O manager
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC trc_nam_run  ! called in trcini
35   PUBLIC trc_nam      ! called in trcini
36
37   !!----------------------------------------------------------------------
38   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
39   !! $Id$
40   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE trc_nam
45      !!---------------------------------------------------------------------
46      !!                     ***  ROUTINE trc_nam  ***
47      !!
48      !! ** Purpose :   READ and PRINT options for the passive tracer run (namelist)
49      !!
50      !! ** Method  : - read passive tracer namelist
51      !!              - read namelist of each defined SMS model
52      !!                ( (PISCES, CFC, MY_TRC )
53      !!---------------------------------------------------------------------
54      INTEGER  ::   jn                  ! dummy loop indice
55      !
56      IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run                                 
57      !               
58      CALL trc_nam_trc     ! passive tracer informations
59      !                                       
60      !
61      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data
62      !
63      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data
64      !
65      IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE.
66
67      IF(lwp) THEN                   ! control print
68         IF( ln_rsttr ) THEN
69            WRITE(numout,*)
70            WRITE(numout,*) '  Read a restart file for passive tracer : ', TRIM( cn_trcrst_in )
71            WRITE(numout,*)
72         ENDIF
73         IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN
74            WRITE(numout,*)
75            WRITE(numout,*) '  Some of the passive tracers are initialised from climatologies '
76            WRITE(numout,*)
77         ENDIF
78         IF( .NOT.ln_trcdta ) THEN
79            WRITE(numout,*)
80            WRITE(numout,*) '  All the passive tracers are initialised with constant values '
81            WRITE(numout,*)
82         ENDIF
83      ENDIF
84
85     
86      rdttrc = rdt * FLOAT( nn_dttrc )   ! passive tracer time-step
87 
88      IF(lwp) THEN                   ! control print
89        WRITE(numout,*) 
90        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc
91        WRITE(numout,*) 
92      ENDIF
93
94
95      IF( l_trdtrc )        CALL trc_nam_trd    ! Passive tracer trends
96
97                             
98                            CALL trc_nam_ice  ! ice module for tracerd
99
100      ! namelist of SMS
101      ! ---------------     
102      IF( ln_age     ) THEN   ;   CALL trc_nam_age         ! AGE     tracer
103      ELSE                    ;   IF(lwp) WRITE(numout,*) '          AGE not used'
104      ENDIF
105
106      IF( ll_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
107      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
108      ENDIF
109
110      IF( ln_c14     ) THEN   ;   CALL trc_nam_c14         ! C14     tracers
111      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
112      ENDIF
113
114      IF( ln_pisces  ) THEN   ;   CALL trc_nam_pisces      ! PISCES  bio-model
115      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
116      ENDIF
117
118
119      IF( ln_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
120      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
121      ENDIF
122      !
123   END SUBROUTINE trc_nam
124
125
126   SUBROUTINE trc_nam_run
127      !!---------------------------------------------------------------------
128      !!                     ***  ROUTINE trc_nam  ***
129      !!
130      !! ** Purpose :   read options for the passive tracer run (namelist)
131      !!
132      !!---------------------------------------------------------------------
133      NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, &
134        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
135      !
136      INTEGER  ::   ios                 ! Local integer output status for namelist read
137      !!---------------------------------------------------------------------
138      !
139      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists'
140      IF(lwp) WRITE(numout,*) '~~~~~~~'
141
142      CALL ctl_opn( numnat_ref, 'namelist_top_ref'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
143      CALL ctl_opn( numnat_cfg, 'namelist_top_cfg'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
144      IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 )
145
146      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
147      READ  ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901)
148901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp )
149
150      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
151      READ  ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 )
152902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp )
153      IF(lwm) WRITE ( numont, namtrc_run )
154
155      !  computes the first time step of tracer model
156      nittrc000 = nit000 + nn_dttrc - 1
157
158      IF(lwp) THEN                   ! control print
159         WRITE(numout,*)
160         WRITE(numout,*) ' Namelist : namtrc_run'
161         WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc
162         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr
163         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr
164         WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000
165         WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler
166         WRITE(numout,*) ' '
167      ENDIF
168      !
169    END SUBROUTINE trc_nam_run
170
171   SUBROUTINE trc_nam_trc
172      !!---------------------------------------------------------------------
173      !!                     ***  ROUTINE trc_nam  ***
174      !!
175      !! ** Purpose :   read options for the passive tracer run (namelist)
176      !!
177      !!---------------------------------------------------------------------
178      INTEGER  ::   ios, ierr, ioptio, icfc     ! Local integer output status for namelist read
179      INTEGER  ::   jn                    ! dummy loop indice
180      !
181      TYPE(PTRACER), DIMENSION(jpmaxtrc) :: sn_tracer  ! type of tracer for saving if not key_iomput
182      TYPE(STRACER), DIMENSION(jpmaxtrc) :: bc_tracer  ! type of tracer for saving if not key_iomput
183      !!
184      NAMELIST/namtrc/jptra, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_c14, &
185         &            sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo
186      !!---------------------------------------------------------------------
187      IF(lwp) WRITE(numout,*)
188      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists'
189      IF(lwp) WRITE(numout,*) '~~~~~~~'
190
191
192      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
193      READ  ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901)
194901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp )
195
196      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
197      READ  ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 )
198902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp )
199      IF(lwm) WRITE ( numont, namtrc )
200
201      ioptio = 0
202      IF( ln_pisces )    ioptio = ioptio + 1
203      IF( ln_my_trc )    ioptio = ioptio + 1
204      !
205      IF( ioptio == 2 )   CALL ctl_stop( 'Choose only ONE BGC model - PISCES or MY_TRC' )
206      IF( ioptio == 0 )   jptra = 0
207
208      ll_cfc = ln_cfc11 .OR. ln_cfc12
209 
210      !
211      jp_pisces   =  0    ;   jp_pcs0  =  0    ;   jp_pcs1  = 0
212      jp_my_trc   =  0    ;   jp_myt0  =  0    ;   jp_myt1  = 0
213      jp_cfc      =  0    ;   jp_cfc0  =  0    ;   jp_cfc1  = 0
214      jp_age      =  0    ;   jp_c14   = 0
215      IF( ln_pisces )  THEN
216         jp_pisces = jptra
217         jp_pcs0   = 1
218         jp_pcs1   = jp_pisces
219      ENDIF
220      IF( ln_my_trc )  THEN
221          jp_my_trc = jptra
222          jp_myt0   = 1
223          jp_myt1   = jp_my_trc
224      ENDIF
225      !
226      jp_bgc  =   jptra
227      !
228      IF( ln_age )    THEN
229         jptra     = jptra + 1
230         jp_age    = jptra
231      ENDIF
232      IF( ln_cfc11 )  jp_cfc = jp_cfc + 1
233      IF( ln_cfc12 )  jp_cfc = jp_cfc + 1
234      IF( ll_cfc )    THEN
235          jptra     = jptra + jp_cfc
236          jp_cfc0   = jptra - jp_cfc + 1
237          jp_cfc1   = jptra
238      ENDIF
239      IF( ln_c14 )    THEN
240           jptra     = jptra + 1
241           jp_c14    = jptra
242      ENDIF
243
244      IF(lwp) THEN                   ! control print
245         WRITE(numout,*)
246         WRITE(numout,*) ' Namelist : namtrc'
247         WRITE(numout,*) '   Total number of passive tracers              jptra         = ', jptra
248         WRITE(numout,*) '   Simulating PISCES model                      ln_pisces     = ', ln_pisces
249         WRITE(numout,*) '   Simulating water mass age                    ln_age        = ', ln_age
250         WRITE(numout,*) '   Simulating CFC11 passive tracer              ln_cfc11      = ', ln_cfc11
251         WRITE(numout,*) '   Simulating CFC12 passive tracer              ln_cfc12      = ', ln_cfc12
252         WRITE(numout,*) '   Simulating C14   passive tracer              ln_c14        = ', ln_c14
253         WRITE(numout,*) '   Simulating MY_TRC  model                     ln_my_trc     = ', ln_my_trc
254         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta
255         WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp
256         WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo
257         WRITE(numout,*) ' '
258         WRITE(numout,*) ' '
259      ENDIF
260      !
261      ALLOCATE( ctrcnm(jptra)      , ctrcln(jptra) , ctrcun(jptra)       , ln_trc_ini(jptra),          &
262#if defined key_bdy
263         &      cn_trc_dflt(nb_bdy), cn_trc(nb_bdy), nn_trcdmp_bdy(nb_bdy), trcdta_bdy(jptra,nb_bdy),  &
264#endif
265         &      ln_trc_sbc(jptra), ln_trc_cbc(jptra), ln_trc_obc(jptra), STAT = ierr  )
266      !
267      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'trc_nam_ice: unable to allocate arrays' )
268      !
269      DO jn = 1, jp_bgc
270         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname )
271         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname )
272         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  )
273         ln_trc_ini(jn) =       sn_tracer(jn)%llinit
274      END DO
275      !
276      IF( ln_my_trc ) THEN
277         DO jn = 1, jp_bgc
278           ln_trc_sbc(jn) =  bc_tracer(jn)%llsbc
279           ln_trc_cbc(jn) =  bc_tracer(jn)%llcbc
280           ln_trc_obc(jn) =  bc_tracer(jn)%llobc
281         END DO
282      ENDIF
283      !
284      IF(lwp) THEN                   ! control print
285         DO jn = 1, jp_bgc
286            WRITE(numout,*) '  tracer nb : ', jn, '    short name : ', ctrcnm(jn)
287         END DO
288         WRITE(numout,*) ' '
289      ENDIF
290      !
291      !
292      IF( ln_age .OR. ll_cfc .OR. ln_c14 ) THEN
293        !                             ! Open namelist files
294        CALL ctl_opn( numtrc_ref, 'namelist_trc_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
295        CALL ctl_opn( numtrc_cfg, 'namelist_trc_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
296        IF(lwm) CALL ctl_opn( numonr, 'output.namelist.trc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
297        !
298      ENDIF
299
300   END SUBROUTINE trc_nam_trc
301
302
303   SUBROUTINE trc_nam_ice
304      !!---------------------------------------------------------------------
305      !!                     ***  ROUTINE trc_nam_ice ***
306      !!
307      !! ** Purpose :   Read the namelist for the ice effect on tracers
308      !!
309      !! ** Method  : -
310      !!
311      !!---------------------------------------------------------------------
312      INTEGER :: jn      ! dummy loop indices
313      INTEGER :: ios, ierr     ! Local integer output status for namelist read
314      !
315      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer  ! type of tracer for saving if not key_iomput
316      !!
317      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
318      !!---------------------------------------------------------------------
319      !
320      IF(lwp) THEN
321         WRITE(numout,*)
322         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
323         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
324      ENDIF
325
326      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice')
327
328      !
329      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
330      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
331 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )
332
333      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
334      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
335 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )
336
337      IF( lwp ) THEN
338         WRITE(numout,*) ' '
339         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
340         WRITE(numout,*) ' '
341      ENDIF
342
343      ALLOCATE( trc_ice_ratio(jptra), trc_ice_prescr(jptra), cn_trc_o(jptra), STAT = ierr  )
344      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'trc_nam_ice: unable to allocate arrays' )
345      !
346      ! Assign namelist stuff
347      DO jn = 1, jptra
348         trc_ice_ratio (jn) = sn_tri_tracer(jn)%trc_ratio
349         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
350         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o
351      END DO
352
353      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice')
354      !
355   END SUBROUTINE trc_nam_ice
356
357
358
359   SUBROUTINE trc_nam_trd
360      !!---------------------------------------------------------------------
361      !!                     ***  ROUTINE trc_nam_dia  ***
362      !!
363      !! ** Purpose :   read options for the passive tracer diagnostics
364      !!
365      !! ** Method  : - read passive tracer namelist
366      !!              - read namelist of each defined SMS model
367      !!                ( (PISCES, CFC, MY_TRC )
368      !!---------------------------------------------------------------------
369
370#if defined key_trdmxl_trc  || defined key_trdtrc
371      INTEGER  ::   ios                 ! Local integer output status for namelist read
372      INTEGER ::  ierr
373      !!
374      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
375         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, &
376         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
377      !!---------------------------------------------------------------------
378
379      IF(lwp) WRITE(numout,*)
380      IF(lwp) WRITE(numout,*) 'trc_nam_trd : read the passive tracer diagnostics options'
381      IF(lwp) WRITE(numout,*) '~~~~~~~'
382
383      !
384      ALLOCATE( ln_trdtrc(jptra) ) 
385      !
386      REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends
387      READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905)
388905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp )
389
390      REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends
391      READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 )
392906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp )
393      IF(lwm) WRITE ( numont, namtrc_trd )
394
395      IF(lwp) THEN
396         WRITE(numout,*)
397         WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd                    '
398         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               '
399         WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc
400         WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc
401         WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart
402         WRITE(numout,*) '   * flag to diagnose trends of                                 '
403         WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant
404         WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc
405         DO jn = 1, jptra
406            IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn
407         END DO
408      ENDIF
409#endif
410      !
411   END SUBROUTINE trc_nam_trd
412
413#else
414   !!----------------------------------------------------------------------
415   !!  Dummy module :                                     No passive tracer
416   !!----------------------------------------------------------------------
417CONTAINS
418   SUBROUTINE trc_nam                      ! Empty routine   
419   END SUBROUTINE trc_nam
420   SUBROUTINE trc_nam_run                      ! Empty routine   
421   END SUBROUTINE trc_nam_run
422#endif
423
424   !!----------------------------------------------------------------------
425   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
426   !! $Id$
427   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
428   !!======================================================================
429END MODULE trcnam
Note: See TracBrowser for help on using the repository browser.