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.
sms_c14.F90 in NEMO/trunk/src/TOP/C14 – NEMO

source: NEMO/trunk/src/TOP/C14/sms_c14.F90 @ 10372

Last change on this file since 10372 was 10071, checked in by nicolasmartin, 6 years ago

Hopefully the final fix for the header standardisation

  • Property svn:keywords set to Id
File size: 4.1 KB
RevLine 
[7041]1MODULE sms_c14
2   !!======================================================================
3   !!                      ***  MODULE trcsms_c14  ***
4   !! TOP :  C14 main module
5   !!======================================================================
6   !! History     -   ! 1994-05 ( J. Orr ) original code
7   !!            1.0  ! 2006-02 ( J.M. Molines )  Free form + modularity
8   !!            2.0  ! 2008-12 ( C. Ethe ) reorganisation
9   !!            4.0  ! 2011-02 ( A.R. Porter, STFC Daresbury ) Dynamic memory
10   !!                 ! 2015    (A. Mouchet) general C14 + update formulas
11   !!----------------------------------------------------------------------
12   !!   sms_c14 :  compute and add C14 suface forcing to C14 trends
13   !!----------------------------------------------------------------------
14   USE par_oce
15   USE par_trc
16
17
18   IMPLICIT NONE
19   PUBLIC 
20
21
22   LOGICAL  :: ln_chemh                             ! Chemical enhancement (yes/no)
23   INTEGER  :: kc14typ                              ! C14 tracer type
24   REAL(wp) :: tyrc14_beg                           ! year start atmospheric scenario !! See below
25   REAL(wp) :: pco2at, rc14at                       ! atm co2, atm 14C ratio (global, reference)
26   REAL(wp) :: rc14init                             ! ocean 14C ratio for initialization
27   REAL(wp) :: xkwind, xdicsur                      ! wind coeff, ref DIC
28   REAL(wp) :: rlam14                               ! C14 decay  rate
29
30   !
31   CHARACTER (len=20)                           :: cfileco2, cfilec14  ! Name of atmospheric forcing files
32   !
33   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   c14sbc   ! atmospheric c14 ratio
34   REAL(wp)                                     ::   co2sbc   ! atmospheric co2 pressure
35 
36   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   exch_c14   ! exch. vel. for C14/C
37   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   exch_co2   ! CO2 invasion rate
38   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qtr_c14    ! flux at surface
39   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qint_c14   ! cumulative flux
40
41   INTEGER , PARAMETER                          ::   nc14zon     = 3  ! number of zones for bomb c14
42   !
43   INTEGER                                       ::   nrecco2, nrecc14  ! nb record atm co2 & cc14
44   REAL(wp)                                      ::   tyrc14_now ! current yr for transient experiment relative to tyrc14_beg
45   INTEGER                                       ::   m1_co2, m1_c14  ! index of first co2 and c14 records to consider
46   INTEGER                                       ::   m2_co2, m2_c14  ! index of second co2 and c14 records to consider
47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   bomb       ! C14 atm data (bomb - 3 zones)
48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   atmc14     ! C14 atm data (paleo - 1 zone)
49   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   tyrc14     ! Time (yr) atmospheric C14 data
50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fareaz     ! Spatial Interpolation Factors
51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   spco2      ! Atmospheric CO2
52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   tyrco2     ! Time (yr) atmospheric CO2 data
53
54   !!----------------------------------------------------------------------
[10067]55   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[10071]56   !! $Id$
[10068]57   !! Software governed by the CeCILL license (see ./LICENSE)
[7041]58   !!----------------------------------------------------------------------
59CONTAINS
60
61
62   INTEGER FUNCTION sms_c14_alloc()
63      !!----------------------------------------------------------------------
64      !!                  ***  ROUTINE trc_sms_c14_alloc  ***
65      !!----------------------------------------------------------------------
66      sms_c14_alloc = 0
67      ALLOCATE( exch_c14(jpi,jpj)        ,  exch_co2(jpi,jpj)        ,   &
68         &      qtr_c14(jpi,jpj)         ,  qint_c14(jpi,jpj)        ,   &
69         &      c14sbc(jpi,jpj)          ,  STAT = sms_c14_alloc )
70         !
71      !
72   END FUNCTION sms_c14_alloc
73
74  !!======================================================================
75END MODULE sms_c14
Note: See TracBrowser for help on using the repository browser.