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_cfc.F90 in NEMO/trunk/src/TOP/CFC – NEMO

source: NEMO/trunk/src/TOP/CFC/trcnam_cfc.F90

Last change on this file was 14871, checked in by rlod, 3 years ago

Bug fix of initialisation of ln_trc_ais in C14 and CFC modules, see ticket #2672

  • Property svn:keywords set to Id
File size: 4.1 KB
Line 
1MODULE trcnam_cfc
2   !!======================================================================
3   !!                         ***  MODULE trcnam_cfc  ***
4   !! TOP :   initialisation of some run parameters for CFC chemical model
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90
7   !!----------------------------------------------------------------------
8   !! trc_nam_cfc      : CFC model initialisation
9   !!----------------------------------------------------------------------
10   USE oce_trc         ! Ocean variables
11   USE trc             ! TOP variables
12   USE trcsms_cfc      ! CFC specific variable
13
14   IMPLICIT NONE
15   PRIVATE
16
17   CHARACTER(len=34), PUBLIC ::   clname ! Input filename of CFCs atm. concentrations
18
19   PUBLIC   trc_nam_cfc   ! called by trcnam.F90 module
20
21   !!----------------------------------------------------------------------
22   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
23   !! $Id$
24   !! Software governed by the CeCILL license (see ./LICENSE)
25   !!----------------------------------------------------------------------
26CONTAINS
27
28   SUBROUTINE trc_nam_cfc
29      !!-------------------------------------------------------------------
30      !!                  ***  ROUTINE trc_nam_cfc  ***
31      !!                 
32      !! ** Purpose :   Definition some run parameter for CFC model
33      !!
34      !! ** Method  :   Read the namcfc namelist and check the parameter
35      !!       values called at the first timestep (nittrc000)
36      !!
37      !! ** input   :   Namelist namcfc
38      !!----------------------------------------------------------------------
39      INTEGER ::   ios   ! Local integer
40      INTEGER ::   jl, jn
41      !!
42      NAMELIST/namcfc/ ndate_beg, nyear_res, clname
43      !!----------------------------------------------------------------------
44      !
45      IF(lwp) THEN
46         WRITE(numout,*) ' '
47         WRITE(numout,*) ' CFCs'
48         WRITE(numout,*) ' '
49         WRITE(numout,*) ' trc_nam_cfc : Read namcfc namelist for CFC chemical model'
50         WRITE(numout,*) ' ~~~~~~~~~~~'
51      ENDIF
52      !
53      READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901)
54901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfc in reference namelist' )
55      READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 )
56902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfc in configuration namelist' )
57      IF(lwm) WRITE( numonr, namcfc )
58      IF(lwm) CALL FLUSH ( numonr )     ! flush output namelist CFC
59
60      IF(lwp) THEN                  ! control print
61         WRITE(numout,*) '   Namelist : namcfc'
62         WRITE(numout,*) '      initial calendar date (aammjj) for CFC     ndate_beg = ', ndate_beg, '[yymmdd]'
63         WRITE(numout,*) '      restoring time constant (year)             nyear_res = ', nyear_res
64      ENDIF
65      nyear_beg = ndate_beg / 10000
66      IF(lwp) WRITE(numout,*) '      associated initial year (aa)               nyear_beg = ', nyear_beg, '[yy]'
67      !
68      jn = jp_cfc0 - 1
69      ! Variables setting
70      IF( ln_cfc11 ) THEN
71         jn = jn + 1
72         ctrcnm    (jn) = 'CFC11'
73         ctrcln    (jn) = 'Chlorofluoro carbon 11 Concentration'
74         ctrcun    (jn) = 'umolC/L'
75         ln_trc_ini(jn) = .false.
76         ln_trc_sbc(jn) = .false.
77         ln_trc_cbc(jn) = .false.
78         ln_trc_obc(jn) = .false.
79         ln_trc_ais(jn) = .false.
80      ENDIF
81      !
82      IF( ln_cfc12 ) THEN
83         jn = jn + 1
84         ctrcnm    (jn) = 'CFC12'
85         ctrcln    (jn) = 'Chlorofluoro carbon 12 Concentration'
86         ctrcun    (jn) = 'umolC/L'
87         ln_trc_ini(jn) = .false.
88         ln_trc_sbc(jn) = .false.
89         ln_trc_cbc(jn) = .false.
90         ln_trc_obc(jn) = .false.
91      ENDIF
92      !
93      IF( ln_sf6 ) THEN
94         jn = jn + 1
95         ctrcnm    (jn) = 'SF6'
96         ctrcln    (jn) = 'Sulfur hexafluoride Concentration'
97         ctrcun    (jn) = 'umol/L'
98         ln_trc_ini(jn) = .false.
99         ln_trc_sbc(jn) = .false.
100         ln_trc_cbc(jn) = .false.
101         ln_trc_obc(jn) = .false.
102      ENDIF
103      !
104   END SUBROUTINE trc_nam_cfc
105   
106   !!======================================================================
107END MODULE trcnam_cfc
Note: See TracBrowser for help on using the repository browser.