1 | MODULE trclsm_c14b |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE trclsm_c14b *** |
---|
4 | !! TOP : initialisation of some run parameters for C14 chemical model |
---|
5 | !!====================================================================== |
---|
6 | !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) from trclsm.cfc.h90 |
---|
7 | !!---------------------------------------------------------------------- |
---|
8 | #if defined key_c14b |
---|
9 | !!---------------------------------------------------------------------- |
---|
10 | !! 'key_c14b' C14 bomb tracer |
---|
11 | !!---------------------------------------------------------------------- |
---|
12 | !! trc_lsm_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 |
---|
18 | USE in_out_manager ! I/O manager |
---|
19 | |
---|
20 | IMPLICIT NONE |
---|
21 | PRIVATE |
---|
22 | |
---|
23 | PUBLIC trc_lsm_c14b ! called by trclsm.F90 module |
---|
24 | |
---|
25 | !!---------------------------------------------------------------------- |
---|
26 | !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) |
---|
27 | !! $Id: trclsm_cfc.F90 1146 2008-06-25 11:42:56Z rblod $ |
---|
28 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
---|
29 | !!---------------------------------------------------------------------- |
---|
30 | |
---|
31 | CONTAINS |
---|
32 | |
---|
33 | SUBROUTINE trc_lsm_c14b |
---|
34 | !!------------------------------------------------------------------- |
---|
35 | !! *** ROUTINE trc_lsm_c14b *** |
---|
36 | !! |
---|
37 | !! ** Purpose : Definition some run parameter for C14 model |
---|
38 | !! |
---|
39 | !! ** Method : Read the namc14 namelist and check the parameter |
---|
40 | !! values called at the first timestep (nit000) |
---|
41 | !! |
---|
42 | !! ** input : Namelist namelist_c14b |
---|
43 | !!---------------------------------------------------------------------- |
---|
44 | INTEGER :: numnatb |
---|
45 | |
---|
46 | #if defined key_trc_diaadd && ! defined key_iomput |
---|
47 | ! definition of additional diagnostic as a structure |
---|
48 | INTEGER :: jl, jn |
---|
49 | TYPE DIAG |
---|
50 | CHARACTER(len = 20) :: snamedia !: short name |
---|
51 | CHARACTER(len = 80 ) :: lnamedia !: long name |
---|
52 | CHARACTER(len = 20 ) :: unitdia !: unit |
---|
53 | END TYPE DIAG |
---|
54 | |
---|
55 | TYPE(DIAG) , DIMENSION(jp_c14b_2d) :: c14dia2d |
---|
56 | TYPE(DIAG) , DIMENSION(jp_c14b_3d) :: c14dia3d |
---|
57 | #endif |
---|
58 | !! |
---|
59 | NAMELIST/namc14date/ ndate_beg_b, nyear_res_b |
---|
60 | #if defined key_trc_diaadd && ! defined key_iomput |
---|
61 | NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d ! additional diagnostics |
---|
62 | #endif |
---|
63 | !!------------------------------------------------------------------- |
---|
64 | |
---|
65 | ndate_beg_b = 650101 ! default namelist value |
---|
66 | nyear_res_b = 1955 |
---|
67 | |
---|
68 | ! ! Open namelist file |
---|
69 | CALL ctl_opn( numnatb, 'namelist_c14b', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) |
---|
70 | |
---|
71 | READ( numnatb , namc14date ) ! read namelist |
---|
72 | |
---|
73 | IF(lwp) THEN ! control print |
---|
74 | WRITE(numout,*) |
---|
75 | WRITE(numout,*) ' trc_lsm: Read namdates, namelist for C14 chemical model' |
---|
76 | WRITE(numout,*) ' ~~~~~~~' |
---|
77 | WRITE(numout,*) ' initial calendar date (aammjj) for C14 ndate_beg_b = ', ndate_beg_b |
---|
78 | WRITE(numout,*) ' restoring time constant (year) nyear_res_b = ', nyear_res_b |
---|
79 | ENDIF |
---|
80 | nyear_beg_b = ndate_beg_b / 10000 |
---|
81 | IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg_b = ', nyear_beg_b |
---|
82 | ! |
---|
83 | #if defined key_trc_diaadd && ! defined key_iomput |
---|
84 | |
---|
85 | ! Namelist namc14dia |
---|
86 | ! ------------------- |
---|
87 | nwritedia = 10 ! default values |
---|
88 | |
---|
89 | DO jl = 1, jp_c14b_2d |
---|
90 | jn = jp_c14b0_2d + jl - 1 |
---|
91 | WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name |
---|
92 | WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name |
---|
93 | ctrc2u(jn) = ' ' ! units |
---|
94 | END DO |
---|
95 | ! ! 3D output arrays |
---|
96 | DO jl = 1, jp_c14b_3d |
---|
97 | jn = jp_c14b0_3d + jl - 1 |
---|
98 | WRITE(ctrc3d(jn),'("3D_",I1)') jn ! short name |
---|
99 | WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn ! long name |
---|
100 | ctrc3u(jn) = ' ' ! units |
---|
101 | END DO |
---|
102 | |
---|
103 | REWIND( numnatb ) ! read natrtd |
---|
104 | READ ( numnatb, namc14dia ) |
---|
105 | |
---|
106 | DO jl = 1, jp_c14b_2d |
---|
107 | jn = jp_c14b0_2d + jl - 1 |
---|
108 | ctrc2d(jn) = c14dia2d(jl)%snamedia |
---|
109 | ctrc2l(jn) = c14dia2d(jl)%lnamedia |
---|
110 | ctrc2u(jn) = c14dia2d(jl)%unitdia |
---|
111 | END DO |
---|
112 | |
---|
113 | DO jl = 1, jp_c14b_3d |
---|
114 | jn = jp_c14b0_3d + jl - 1 |
---|
115 | ctrc3d(jn) = c14dia3d(jl)%snamedia |
---|
116 | ctrc3l(jn) = c14dia3d(jl)%lnamedia |
---|
117 | ctrc3u(jn) = c14dia3d(jl)%unitdia |
---|
118 | END DO |
---|
119 | |
---|
120 | IF(lwp) THEN ! control print |
---|
121 | WRITE(numout,*) |
---|
122 | WRITE(numout,*) ' Namelist : natadd' |
---|
123 | WRITE(numout,*) ' frequency of outputs for additional arrays nwritedia = ', nwritedia |
---|
124 | DO jl = 1, jp_c14b_3d |
---|
125 | jn = jp_c14b0_3d + jl - 1 |
---|
126 | WRITE(numout,*) ' 3d output field No : ',jn |
---|
127 | WRITE(numout,*) ' short name : ', TRIM(ctrc3d(jn)) |
---|
128 | WRITE(numout,*) ' long name : ', TRIM(ctrc3l(jn)) |
---|
129 | WRITE(numout,*) ' unit : ', TRIM(ctrc3u(jn)) |
---|
130 | WRITE(numout,*) ' ' |
---|
131 | END DO |
---|
132 | |
---|
133 | DO jl = 1, jp_c14b_2d |
---|
134 | jn = jp_c14b0_2d + jl - 1 |
---|
135 | WRITE(numout,*) ' 2d output field No : ',jn |
---|
136 | WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) |
---|
137 | WRITE(numout,*) ' long name : ', TRIM(ctrc2l(jn)) |
---|
138 | WRITE(numout,*) ' unit : ', TRIM(ctrc2u(jn)) |
---|
139 | WRITE(numout,*) ' ' |
---|
140 | END DO |
---|
141 | ENDIF |
---|
142 | |
---|
143 | #endif |
---|
144 | |
---|
145 | END SUBROUTINE trc_lsm_c14b |
---|
146 | |
---|
147 | #else |
---|
148 | !!---------------------------------------------------------------------- |
---|
149 | !! Dummy module : No 14C |
---|
150 | !!---------------------------------------------------------------------- |
---|
151 | CONTAINS |
---|
152 | SUBROUTINE trc_lsm_c14b ! Empty routine |
---|
153 | END SUBROUTINE trc_lsm_c14b |
---|
154 | #endif |
---|
155 | |
---|
156 | !!====================================================================== |
---|
157 | END MODULE trclsm_c14b |
---|