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.
trcsms_c14b.F90 in branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b – NEMO

source: branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcsms_c14b.F90 @ 2038

Last change on this file since 2038 was 2038, checked in by cetlod, 14 years ago

Apply the merge to passive tracers, see ticket:693

File size: 13.3 KB
Line 
1MODULE trcsms_c14b
2   !!======================================================================
3   !!                      ***  MODULE trcsms_c14b  ***
4   !! TOP : Bomb C14 main module
5   !!======================================================================
6   !! History     -   ! 1994-05 ( J. Orr ) origial code
7   !!            1.0  ! 2006-02 ( J.M. Molines )  Free form + modularity
8   !!            2.0  ! 2008-12 ( C. Ethe ) reorganisation
9   !!----------------------------------------------------------------------
10#if defined key_c14b
11   !!----------------------------------------------------------------------
12   !!   'key_c14b'                                         Bomb C14 tracer
13   !!----------------------------------------------------------------------
14   !!   trc_sms_c14b  :  compute and add C14 suface forcing to C14 trends
15   !!----------------------------------------------------------------------
16   USE oce_trc      ! Ocean variables
17   USE par_trc      ! TOP parameters
18   USE trc          ! TOP variables
19   USE trdmod_oce
20   USE trdmod_trc
21   USE iom
22
23   IMPLICIT NONE
24   PRIVATE
25
26   !! * Routine accessibility
27   PUBLIC   trc_sms_c14b       ! called in ???   
28
29   !! * Module variables
30   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec  = 240           ! temporal parameter
31   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec2 = 2 * jpmaxrec  !
32   INTEGER , PUBLIC, PARAMETER ::   jpzon     = 3             ! number of zones
33
34   INTEGER , PUBLIC    ::   ndate_beg_b      ! initial calendar date (aammjj) for C14
35   INTEGER , PUBLIC    ::   nyear_beg_b      ! initial year for C14
36   INTEGER , PUBLIC    ::   nyear_res_b      ! restoring time constant (year)
37   INTEGER , PUBLIC    ::   nyear_beg        ! initial year (aa)
38
39   REAL(wp), PUBLIC, DIMENSION(jpmaxrec,jpzon) ::  bomb   !: C14 atm data (3 zones)
40   REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jpzon) ::  fareaz !: Spatial Interpolation Factors
41   REAL(wp), PUBLIC, DIMENSION(jpmaxrec2)      ::  spco2  !: Atmospheric CO2
42 
43   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   qtr_c14      !: flux at surface
44   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   qint_c14     !: cumulative flux
45
46   REAL(wp) :: xlambda, xdecay, xaccum       ! C14 decay coef. 
47
48   REAL(wp) ::   xconv1 = 1.0          ! conversion from to
49   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:
50   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm
51
52  !! * Substitutions
53#  include "top_substitute.h90"
54
55  !!----------------------------------------------------------------------
56  !!  TOP 1.0 , LOCEAN-IPSL (2005)
57  !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $
58  !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
59  !!----------------------------------------------------------------------
60
61CONTAINS
62
63  SUBROUTINE trc_sms_c14b( kt )
64     !!----------------------------------------------------------------------
65     !!                  ***  ROUTINE trc_sms_c14b  ***
66     !!
67     !! ** Purpose :   Compute the surface boundary contition on C14bomb
68     !!      passive tracer associated with air-mer fluxes and add it to
69     !!      the general trend of tracers equations.
70     !!
71     !! ** Original comments from J. Orr :
72     !!
73     !!      Calculates the input of Bomb C-14 to the surface layer of OPA
74     !!
75     !!      James Orr, LMCE, 28 October 1992
76     !!
77     !!      Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989)
78     !!      (hereafter referred to as TDB) with constant gas exchange,
79     !!      although in this case, a perturbation approach is used for
80     !!      bomb-C14 so that both the ocean and atmosphere begin at zero.
81     !!      This saves tremendous amounts of computer time since no
82     !!      equilibrum run is first required (i.e., for natural C-14).
83     !!      Note: Many sensitivity tests can be run with this approach and
84     !!            one never has to make a run for natural C-14; otherwise,
85     !!            a run for natural C-14 must be run each time that one
86     !!            changes a model parameter!
87     !!
88     !!
89     !!      19 August 1993: Modified to consider Atmospheric C-14 fom IPCC.
90     !!      That is, the IPCC has provided a C-14 atmospheric record (courtesy
91     !!      of Martin Heimann) for model calibration.  This model spans from
92     !!      preindustrial times to present, in a format different than that
93     !!      given by TDB.  It must be converted to the ORR C-14 units used
94     !!      here, although in this case, the perturbation includes not only
95     !!      bomb C-14 but changes due to the Suess effect.
96     !!
97     !!----------------------------------------------------------------------
98     !! * Arguments
99     INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
100
101     !! * Local declarations
102     INTEGER ::  &
103       ji, jj, jk, jz
104
105     INTEGER ::   &
106       iyear_beg,              &
107       iyear_beg1, iyear_end1, &
108       imonth1, im1, im2,      &
109       iyear_beg2, iyear_end2, &
110       imonth2, in1, in2
111         
112     REAL(wp), DIMENSION(jpi,jpj) ::  & 
113       zatmbc14
114
115     REAL(wp), DIMENSION(jpzon)   ::  &
116       zonbc14              !: time interp atm C14
117
118     REAL(wp) ::     &
119       zpco2at              !: time interp atm C02
120
121     REAL(wp) ::     &      !: dummy variables
122       zt, ztp, zsk, &
123       zsol ,        &      !: solubility
124       zsch ,        &      !: schmidt number
125       zv2  ,        &      !: wind speed ( square)
126       zpv  ,        &      !: piston velocity
127       zdemi, ztra
128#if defined key_diatrc  && defined key_iomput
129      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d
130#endif
131      !!----------------------------------------------------------------------
132
133      IF( kt == nittrc000 )  THEN
134         ! Computation of decay coeffcient
135         zdemi   = 5730.
136         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday )
137         xdecay  = EXP( - xlambda * rdt )
138         xaccum  = 1.0 -  xdecay
139      ENDIF
140
141      ! Temporal interpolation
142      ! ----------------------
143      iyear_beg = nyear - 1954 + ( nyear_res_b - 1700 - nyear_beg_b  ) ! JMM Very dangerous
144                                                                       ! nyear=0001 for 1955
145      ! For Atmospheric C14 concentrations:
146      iyear_beg1 = iyear_beg
147      imonth1    = nmonth
148      IF ( imonth1 <= 6 ) THEN
149         iyear_beg1 = iyear_beg1 - 1
150         im1       =  6 - imonth1 + 1
151         im2       =  6 + imonth1 - 1
152      ELSE
153         im1       = 12 - imonth1 + 7
154         im2       =      imonth1 - 7
155      ENDIF
156      iyear_end1 = iyear_beg1 + 1
157
158      iyear_beg1 = MAX( iyear_beg1, 1   )
159      iyear_end1 = MIN( iyear_end1, 241 )
160
161
162      ! For Atmospheric CO2 concentrations:
163      iyear_beg2 = 2 * iyear_beg - 1
164      imonth2    = INT( nmonth / 2. )
165
166      IF ( imonth2 <= 3 ) THEN
167         iyear_beg2 = iyear_beg2 - 1 
168         in1       = 3 - imonth2 + 1
169         in2       = 3 + imonth2 - 1
170      ELSE
171         in1       = 6 - imonth2 + 4
172         in2       =     imonth2 - 4
173      ENDIF
174     
175      iyear_end2 = iyear_beg2 + 1
176     
177      iyear_beg2 = MAX( iyear_beg2, 1   )
178      iyear_end2 = MIN( iyear_end2, 482 )
179
180
181      !  ----------------------------------------------------------------
182      !  As explained by the TDB 89 papers, C-14/C-12 is the same
183      !  as C-14 concentration in this special case (no fractionation
184      !  effects in this model, which thus allow direct comparison
185      !  to del-C-14, after unit change from above).
186      ! -----------------------------------------------------------------------
187      !  Calc C-14 in atmosphere based on interp of IPCC (M. Heimann) data
188      !        - Compare input to calculated C-14 for each time in record
189      !-------------------------------------------------------------------------
190     
191     
192      !  Temporal and spatial interpolation at time k
193      ! --------------------------------------------------
194     
195      ! Compute atmospheric C-14 for each zone (90-20S, 20S-20N, 20-90N)
196      DO jz = 1, jpzon
197         zonbc14(jz) = (  bomb(iyear_beg1,jz) * FLOAT( im1 )  &
198              &         + bomb(iyear_end1,jz) * FLOAT( im2 ) ) / 12.
199         ! C-14 exactly starts at zero :
200         ! JMM +Zouhair : Slightly negative values are set to 0 (when perturbation approaches)
201         zonbc14(jz) = MAX( zonbc14(jz), 0. )
202      END DO
203     
204     
205      !  For each (i,j)-box, with information from the fractional area
206      !  (zonmean), computes area-weighted mean to give the atmospheric C-14
207      !  ----------------------------------------------------------------
208      DO jj = 1, jpj
209         DO ji = 1, jpi
210            zatmbc14(ji,jj) =   zonbc14(1) * fareaz(ji,jj,1)  &
211                 &           +  zonbc14(2) * fareaz(ji,jj,2)  &
212                 &           +  zonbc14(3) * fareaz(ji,jj,3)
213         END DO
214      END DO
215     
216      ! time interpolation of CO2 concentrations to it time step 
217      zpco2at = (  spco2(iyear_beg2) * FLOAT( in1 )              &
218           &     + spco2(iyear_end2) * FLOAT( in2 ) ) / 6.
219
220      IF (lwp) THEN
221          WRITE(numout, *) 'time : ', kt, ' CO2 year begin/end :',iyear_beg2,'/',iyear_end2,   &
222          &                ' CO2 concen : ',zpco2at 
223          WRITE(numout, *) 'time : ', kt, ' C14 year begin/end :',iyear_beg1,'/',iyear_end1,   &
224          &                ' C14B concen (Z1/Z2/Z3) : ',zonbc14(1),'/',zonbc14(2),'/',zonbc14(3)
225      ENDIF
226
227      !  Determine seasonally variable gas exchange coefficient
228      !----------------------------------------------------------
229      !  Computes the Schmidt number of CO2 in seawater using the formulation
230      !  presented by Wanninkhof (1992, J. Geophys. Res., 97,7373-7382). 
231      ! -------------------------------------------------------------------
232      DO jj = 1, jpj
233         DO ji = 1, jpi 
234            !  Computation of solubility 
235            IF (tmask(ji,jj,1) >  0.) THEN
236               ztp  = ( tn(ji,jj,1) + 273.16 ) * 0.01
237               zsk  = 0.023517 + ztp * ( -0.023656 + 0.0047036 * ztp )
238               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * sn(ji,jj,1) )
239               ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)]
240               zsol = zsol * 1.0e-03
241            ELSE
242               zsol = 0.
243            ENDIF
244
245            ! speed transfert : Formulation of Wanninkhof (1992, JGR, 97,7373-7382)
246            ! JMM/Zouhair : coef of 0.25 rather than 0.3332 for CORe wind speed
247
248            ! Computes the Schmidt number of CO2 in seawater
249            zt   = tn(ji,jj,1)
250            zsch = 2073.1 + zt * ( -125.62 + zt * (3.6276 - 0.043219 * zt ) )
251
252            ! Wanninkhof Piston velocity and convert from units [cm/hr] -> [m/s]
253            zv2  = wndm(ji,jj) * wndm(ji,jj)
254            zsch = zsch / 660.
255            zpv  = ( 0.25  * zv2 / SQRT(zsch) ) * xconv2 * tmask(ji,jj,1)
256
257            ! Flux of Bomb C-14 from air-sea : speed*(conc. at equil-conc. at surf)
258            ! in C-14 (orr-model-units) / m**2 * s
259            qtr_c14(ji,jj) = -zpv * zsol * zpco2at                                   &
260                 &                       * ( trb(ji,jj,1,jpc14) - zatmbc14(ji,jj) )  &
261#if defined key_degrad
262                 &                       * facvol(ji,jj,1)                           &
263#endif
264                  &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2.
265
266            ! Add the surface flux to the trend
267            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1) 
268           
269            ! cumulation of surface flux at each time step
270            qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt
271
272# if defined key_diatrc && ! defined key_iomput
273            ! Save 2D diagnostics
274            trc2d(ji,jj,jp_c14b0_2d    ) = qtr_c14 (ji,jj)
275            trc2d(ji,jj,jp_c14b0_2d + 1) = qint_c14(ji,jj)
276# endif
277         END DO
278      END DO
279
280      ! Computation of decay effects on tracer concentration
281      DO jk = 1, jpk
282         DO jj = 1, jpj
283            DO ji = 1, jpi
284#if ! defined key_degrad
285               ztra = trn(ji,jj,jk,jpc14) * xaccum
286#else
287               ztra = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) )
288#endif
289               tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - ztra / rdt
290#if defined key_diatrc
291               ! Save 3D diagnostics
292# if ! defined key_iomput
293               trc3d(ji,jj,jk,jp_c14b0_3d ) = ztra    !  radioactive decay
294# else
295               zw3d(ji,jj,jk) = ztra    !  radioactive decay
296# endif
297#endif
298            END DO
299         END DO
300      END DO
301
302#if defined key_diatrc  && defined key_iomput
303      CALL iom_put( "qtrC14b"  , qtr_c14  )
304      CALL iom_put( "qintC14b" , qint_c14 )
305#endif
306#if defined key_diatrc  && defined key_iomput
307      CALL iom_put( "fdecay" , zw3d )
308#endif
309      IF( l_trdtrc ) THEN
310         CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends
311      END IF
312
313    END SUBROUTINE trc_sms_c14b
314
315#else
316    !!----------------------------------------------------------------------
317    !!   Default option                                         Dummy module
318    !!----------------------------------------------------------------------
319CONTAINS
320  SUBROUTINE trc_sms_c14b( kt )       ! Empty routine
321    WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt
322  END SUBROUTINE trc_sms_c14b
323#endif
324
325  !!======================================================================
326END MODULE trcsms_c14b
Note: See TracBrowser for help on using the repository browser.