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

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90 @ 4319

Last change on this file since 4319 was 4319, checked in by clevy, 10 years ago

change ctl_opn status of output.namelist files for compatibility with some compilers
  • Property svn:keywords set to Id
File size: 6.5 KB
RevLine 
[2038]1MODULE trcnam_c14b
2   !!======================================================================
3   !!                         ***  MODULE trcnam_c14b  ***
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   !!----------------------------------------------------------------------
8#if defined key_c14b
9   !!----------------------------------------------------------------------
10   !!   'key_c14b'                                         C14 bomb tracer
11   !!----------------------------------------------------------------------
12   !! trc_nam_c14b      : C14 model initialisation
13   !!----------------------------------------------------------------------
14   USE oce_trc         ! Ocean variables
15   USE par_trc         ! TOP parameters
16   USE trc             ! TOP variables
17   USE trcsms_c14b     ! C14b specific variable
[3294]18   USE iom             ! I/O manager
[2038]19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   trc_nam_c14b   ! called by trcnam.F90 module
24
25   !!----------------------------------------------------------------------
[2287]26   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
[2281]27   !! $Id$
[2287]28   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[2038]29   !!----------------------------------------------------------------------
30
31CONTAINS
32
33   SUBROUTINE trc_nam_c14b
34      !!-------------------------------------------------------------------
35      !!                  ***  ROUTINE trc_nam_c14b  ***
36      !!                 
37      !! ** Purpose :   Definition some run parameter for C14 model
38      !!
39      !! ** Method  :   Read the namc14 namelist and check the parameter
[3294]40      !!       values called at the first timestep (nittrc000)
[2038]41      !!
42      !! ** input   :   Namelist namelist_c14b
43      !!----------------------------------------------------------------------
[4147]44      INTEGER ::  numnatb_ref = -1   ! Logical unit for reference c14b namelist
45      INTEGER ::  numnatb_cfg = -1   ! Logical unit for configuration c14b namelist
46      INTEGER ::  numonb      = -1   ! Logical unit for output namelist
47      INTEGER :: ios                 ! Local integer output status for namelist read
[2038]48
49      ! definition of additional diagnostic as a structure
[3294]50      INTEGER :: jl, jn
51      TYPE(DIAG), DIMENSION(jp_c14b_2d) :: c14dia2d
52      TYPE(DIAG), DIMENSION(jp_c14b_3d) :: c14dia3d
[2038]53      !!
54      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b
[3294]55      NAMELIST/namc14dia/  c14dia2d, c14dia3d     ! additional diagnostics
[2038]56      !!-------------------------------------------------------------------
57      !                             ! Open namelist file
[4147]58      CALL ctl_opn( numnatb_ref, 'namelist_c14b_ref'  ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
59      CALL ctl_opn( numnatb_cfg, 'namelist_c14b_cfg'  ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )   
[4319]60      CALL ctl_opn( numonb     , 'output.namelist.c14', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )     
[4147]61      REWIND( numnatb_ref )              ! Namelist namc14date in reference namelist : c14b parameters
62      READ  ( numnatb_ref, namc14date, IOSTAT = ios, ERR = 901)
63901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14date in reference namelist', lwp )
[2038]64
[4147]65      REWIND( numnatb_cfg )              ! Namelist namc14date in configuration namelist : c14b parameters
66      READ  ( numnatb_cfg, namc14date, IOSTAT = ios, ERR = 902 )
67902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14date in configuration namelist', lwp )
68      WRITE ( numonb, namc14date )
[2038]69      IF(lwp) THEN                  ! control print
70         WRITE(numout,*)
71         WRITE(numout,*) ' trc_nam: Read namdates, namelist for C14 chemical model'
72         WRITE(numout,*) ' ~~~~~~~'
73         WRITE(numout,*) '    initial calendar date (aammjj) for C14  ndate_beg_b = ', ndate_beg_b
74         WRITE(numout,*) '    restoring time constant (year)          nyear_res_b = ', nyear_res_b
75      ENDIF
76      nyear_beg_b = ndate_beg_b / 10000
77      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b
78      !
[3294]79      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN
80         !
81         ! Namelist namc14dia
82         ! -------------------
[4147]83         REWIND( numnatb_ref )              ! Namelist namc14dia in reference namelist : c14b diagnostics
84         READ  ( numnatb_ref, namc14dia, IOSTAT = ios, ERR = 903)
85903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in reference namelist', lwp )
[2038]86
[4147]87         REWIND( numnatb_cfg )              ! Namelist namc14dia in configuration namelist : c14b diagnostics
88         READ  ( numnatb_cfg, namc14dia, IOSTAT = ios, ERR = 904 )
89904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in configuration namelist', lwp )
90         WRITE ( numonb, namc14dia )
[2038]91
[3294]92         DO jl = 1, jp_c14b_2d
93            jn = jp_c14b0_2d + jl - 1
94            ctrc2d(jn) = c14dia2d(jl)%sname
95            ctrc2l(jn) = c14dia2d(jl)%lname
96            ctrc2u(jn) = c14dia2d(jl)%units
97         END DO
[2038]98
99         DO jl = 1, jp_c14b_3d
100            jn = jp_c14b0_3d + jl - 1
[3294]101            ctrc3d(jn) = c14dia3d(jl)%sname
102            ctrc3l(jn) = c14dia3d(jl)%lname
103            ctrc3u(jn) = c14dia3d(jl)%units
[2038]104         END DO
105
[3294]106         IF(lwp) THEN                   ! control print
107            WRITE(numout,*)
108            WRITE(numout,*) ' Namelist : natadd'
109            DO jl = 1, jp_c14b_3d
110               jn = jp_c14b0_3d + jl - 1
111               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), &
112                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn)
113            END DO
[2038]114            WRITE(numout,*) ' '
[3294]115
116            DO jl = 1, jp_c14b_2d
117               jn = jp_c14b0_2d + jl - 1
118               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
119                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
120            END DO
121            WRITE(numout,*) ' '
122         ENDIF
123         !
[2038]124      ENDIF
125
[4147]126   CALL FLUSH ( numonb )     ! flush output namelist C14b
127
[2038]128   END SUBROUTINE trc_nam_c14b
129   
130#else
131   !!----------------------------------------------------------------------
132   !!  Dummy module :                                                No 14C
133   !!----------------------------------------------------------------------
134CONTAINS
135   SUBROUTINE trc_nam_c14b                      ! Empty routine
136   END  SUBROUTINE  trc_nam_c14b
137#endif 
138
139   !!======================================================================
140END MODULE trcnam_c14b
Note: See TracBrowser for help on using the repository browser.