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 trunk/NEMO/TOP_SRC/C14b – NEMO

source: trunk/NEMO/TOP_SRC/C14b/trcsms_c14b.F90 @ 1329

Last change on this file since 1329 was 1329, checked in by cetlod, 15 years ago

update modules to take into account the mask land points in NetCDF outputs, see ticket:322

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