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

source: NEMO/trunk/src/TOP/C14/trcini_c14.F90

Last change on this file was 13286, checked in by smasson, 4 years ago

trunk: merge extra halos branch in trunk, see #2366

  • Property svn:keywords set to Id
File size: 3.5 KB
Line 
1MODULE trcini_c14
2   !!======================================================================
3   !!                         ***  MODULE trcini_c14  ***
4   !! TOP :   initialisation of the C14 tracers
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
7   !! History :   3.0  !  2015 (A. Mouchet) C14 Code
8   !!----------------------------------------------------------------------
9   !! trc_ini_c14   : C14 model initialisation
10   !!----------------------------------------------------------------------
11   USE par_trc         ! TOP parameters
12   USE oce_trc
13   USE trc
14   USE sms_c14
15   USE trcatm_c14
16   USE trcnam_c14
17   USE iom
18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC   trc_ini_c14   ! called by trcini.F90 module
23   
24   !
25
26   !!----------------------------------------------------------------------
27   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
28   !! $Id$
29   !! Software governed by the CeCILL license (see ./LICENSE)
30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE trc_ini_c14( Kmm )
34      !!----------------------------------------------------------------------
35      !!                     ***  trc_ini_c14  *** 
36      !!
37      !! ** Purpose :   initialization for C14 model
38      !!
39      !! ** Method  :
40      !!----------------------------------------------------------------------
41      !
42      INTEGER, INTENT(in)  ::  Kmm  ! time level indices
43      REAL(wp) :: ztrai
44      INTEGER  :: jn
45      CHARACTER(len = 20)  ::  cltra
46      !!----------------------------------------------------------------------
47      !
48      CALL trc_nam_c14
49      !                       ! Allocate c14 arrays
50      IF( sms_c14_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_c14: unable to allocate C14 arrays' )
51
52      IF(lwp) WRITE(numout,*)
53      IF(lwp) WRITE(numout,*) ' trc_ini_c14: initialisation of C14 model'
54      !
55      IF( .NOT. ln_rsttr )  THEN
56         !
57         IF(lwp) WRITE(numout,*) '                      ==>    PRESCRIBED initial VALUES'
58         IF(lwp) WRITE(numout,*) '                      ==>    Ocean C14/C :', rc14init 
59         !
60         tr(:,:,:,jp_c14,Kmm) = rc14init * tmask(:,:,:)
61         !
62         qtr_c14(:,:) = 0._wp           ! Init of air-sea BC
63         !
64      ELSE
65
66        IF(lwp) WRITE(numout,*)
67        IF(lwp) WRITE(numout,*) ' trc_rst_read_c14 : Read specific variables for c14 model '
68        IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
69        !
70        CALL iom_get( numrtr, 'co2sbc', co2sbc ) 
71        CALL iom_get( numrtr, jpdom_auto, 'c14sbc', c14sbc ) 
72        CALL iom_get( numrtr, jpdom_auto, 'exch_co2', exch_co2 ) 
73        CALL iom_get( numrtr, jpdom_auto, 'exch_c14', exch_c14 ) 
74        CALL iom_get( numrtr, jpdom_auto, 'qtr_c14', qtr_c14 )
75        !
76      END IF
77      !
78      IF( ( nn_rsttr == 0 ) .OR. ( .NOT. ln_rsttr ) ) THEN
79      !
80      !                         !  qint set to zero <=== Initial of transient
81      !                         !                   <=== Restart=false
82         IF(lwp) WRITE(numout,*) '                    ==>    qint reset to ZERO '
83         qint_c14(:,:) = 0._wp
84      !
85      ELSE
86        !
87        CALL iom_get( numrtr, jpdom_auto, 'qint_c14', qint_c14 ) 
88        !
89      ENDIF
90      !
91      CALL trc_atm_c14_ini   ! Init atm values
92      !
93      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
94      !
95   END SUBROUTINE trc_ini_c14
96
97   !!======================================================================
98END MODULE trcini_c14
Note: See TracBrowser for help on using the repository browser.