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_c14.F90 in NEMO/branches/UKMO/NEMO_4.0_mirror/src/TOP/C14 – NEMO

source: NEMO/branches/UKMO/NEMO_4.0_mirror/src/TOP/C14/trcnam_c14.F90 @ 10888

Last change on this file since 10888 was 10888, checked in by davestorkey, 5 years ago

branches/UKMO/NEMO_4.0_mirror : clear SVN keywords

File size: 6.0 KB
Line 
1MODULE trcnam_c14
2   !!======================================================================
3   !!                         ***  MODULE trcnam_c14  ***
4   !! TOP :   initialisation of some run parameters for C14 chemical model
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90
7   !! History :        !  2015 (A.Mouchet) equilibrium + transient C14
8   !!----------------------------------------------------------------------
9   !! trc_nam_c14      : C14 model initialisation
10   !!----------------------------------------------------------------------
11   USE oce_trc         ! Ocean variables
12   USE trc             ! TOP variables
13   USE sms_c14
14
15   IMPLICIT NONE
16   PRIVATE
17   !!
18   PUBLIC   trc_nam_c14   ! called by trcnam.F90 module
19   !!
20   !!----------------------------------------------------------------------
21   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
22   !! $Id$
23   !! Software governed by the CeCILL license (see ./LICENSE)
24   !!----------------------------------------------------------------------
25
26CONTAINS
27
28   SUBROUTINE trc_nam_c14
29      !!-------------------------------------------------------------------
30      !!                  ***  ROUTINE trc_nam_c14  ***
31      !!                 
32      !! ** Purpose :   Definition some run parameter for C14 model
33      !!
34      !! ** Method  :   Read the namc14 namelist and check the parameter
35      !!       values called at the first timestep (nittrc000)
36      !!
37      !! ** input   :   Namelist namelist_c14
38      !!----------------------------------------------------------------------
39      INTEGER ::   ios   ! Local integer
40      !!
41      NAMELIST/namc14_typ/ kc14typ,rc14at, pco2at, rc14init   ! type of C14 tracer, default values of C14/C, pco2, & ocean r14
42      NAMELIST/namc14_sbc/ ln_chemh, xkwind, xdicsur          ! chem enh, wind coeff, ref DIC
43      NAMELIST/namc14_fcg/ cfileco2, cfilec14, tyrc14_beg     ! for transient exps; atm forcing
44      !!-------------------------------------------------------------------
45      !
46      IF(lwp) THEN
47         WRITE(numout,*) ' '
48         WRITE(numout,*) ' Radiocarbon C14'
49         WRITE(numout,*) ' '
50         WRITE(numout,*) ' trc_nam_c14 : Read C14 namelists'
51         WRITE(numout,*) ' ~~~~~~~~~~~'
52      ENDIF
53      !
54      ! Variable setting
55      ctrcnm    (jp_c14) = 'RC14'
56      ctrcln    (jp_c14) = 'Radiocarbon ratio'
57      ctrcun    (jp_c14) = '-'
58      ln_trc_ini(jp_c14) = .false.
59      ln_trc_sbc(jp_c14) = .false.
60      ln_trc_cbc(jp_c14) = .false.
61      ln_trc_obc(jp_c14) = .false.
62      !
63      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
64      READ  ( numtrc_ref, namc14_typ, IOSTAT = ios, ERR = 901)
65901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_typ in reference namelist', lwp )
66      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist
67      READ  ( numtrc_cfg, namc14_typ, IOSTAT = ios, ERR = 902)
68902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_typ in configuration namelist', lwp )
69      IF(lwm) WRITE ( numonr, namc14_typ )
70      !
71      IF(lwp) THEN                  ! control print
72         WRITE(numout,*) '   Namelist : namc14_typ'
73         WRITE(numout,*) '      Type of C14 tracer (0=equilibrium; 1=bomb transient; 2=past transient) kc14typ = ', kc14typ
74         WRITE(numout,*) '      Default value for atmospheric C14/C (used for equil run)               rc14at  = ', rc14at
75         WRITE(numout,*) '      Default value for atmospheric pcO2 [atm] (used for equil run)          pco2at  = ', pco2at
76         WRITE(numout,*) '      Default value for initial C14/C in the ocean (used for equil run)      rc14init= ', rc14init
77         WRITE(numout,*)
78      ENDIF
79
80      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
81      READ  ( numtrc_ref, namc14_sbc, IOSTAT = ios, ERR = 903)
82903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_sbc in reference namelist', lwp )
83      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist
84      READ  ( numtrc_cfg, namc14_sbc, IOSTAT = ios, ERR = 904)
85904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist', lwp )
86      IF(lwm) WRITE( numonr, namc14_sbc )
87      !
88      IF(lwp) THEN                  ! control print
89         WRITE(numout,*) '   Namelist namc14_sbc'
90         WRITE(numout,*) '      Chemical enhancement in piston velocity   ln_chemh = ', ln_chemh
91         WRITE(numout,*) '      Coefficient for gas exchange velocity     xkwind   = ', xkwind
92         WRITE(numout,*) '      Reference DIC concentration (mol/m3)      xdicsur  = ', xdicsur
93         WRITE(numout,*)
94      ENDIF
95
96      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
97      READ  ( numtrc_ref, namc14_fcg, IOSTAT = ios, ERR = 905)
98905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_fcg in reference namelist', lwp )
99      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist
100      READ  ( numtrc_cfg, namc14_fcg, IOSTAT = ios, ERR = 906)
101906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist', lwp )
102      IF(lwm) WRITE ( numonr, namc14_fcg )
103      !
104      IF(lwp) THEN                  ! control print
105         WRITE(numout,*) '   Namelist namc14_fcg'
106         WRITE(numout,*) '      Atmospheric co2 file ( bomb )           cfileco2   = ', TRIM( cfileco2 )
107         WRITE(numout,*) '      Atmospheric c14 file ( bomb )           cfilec14   = ', TRIM( cfilec14 )
108         WRITE(numout,*) '      Starting year of experiment             tyrc14_beg = ', tyrc14_beg
109      ENDIF
110
111      !
112      IF( kc14typ == 2 )    tyrc14_beg = 1950._wp - tyrc14_beg   ! BP to AD dates
113      ! set units
114      rlam14 = LOG(2._wp) / 5730._wp / rsiyea    ! C14 decay  rate: yr^-1 --> s^-1
115      !                                          ! radiocarbon half-life is 5730 yr
116   END SUBROUTINE trc_nam_c14
117   
118   !!======================================================================
119END MODULE trcnam_c14
Note: See TracBrowser for help on using the repository browser.