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_c14.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/C14 – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/C14/trcsms_c14.F90 @ 10975

Last change on this file since 10975 was 10975, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Finish converting all TOP routines and knock-on effects of these conversions. Fully SETTE tested (SETTE tests 1-6 and 9). This completes the first stage conversion of TRA and TOP but need to revisit and pass ts and tr arrays through the argument lists where appropriate.

  • Property svn:keywords set to Id
File size: 7.3 KB
Line 
1MODULE trcsms_c14
2   !!======================================================================
3   !!                      ***  MODULE trcsms_c14  ***
4   !! TOP : Bomb 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   !!   trc_sms_c14 :  compute and add C14 suface forcing to C14 trends
13   !!----------------------------------------------------------------------
14   USE oce_trc       ! Ocean variables
15   USE par_trc       ! TOP parameters
16   USE trc           ! TOP variables
17   USE trd_oce    ! trends
18   USE trdtrc    ! trends
19   USE sms_c14    ! atmospheric forcing
20   USE trcatm_c14    ! atmospheric forcing
21   USE iom
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   trc_sms_c14       ! called in trcsms.F90
27
28   !!----------------------------------------------------------------------
29   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
30   !! $Id$
31   !! Software governed by the CeCILL license (see ./LICENSE)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE trc_sms_c14( kt, Kbb, Kmm, Krhs )
36      !!----------------------------------------------------------------------
37      !!                  ***  ROUTINE trc_sms_c14  ***
38      !!
39      !! ** Purpose :   Compute the surface boundary contition on C14
40      !!      passive tracer associated with air-sea fluxes and add it to
41      !!      the general trend of tracers equations.
42      !
43      !    Method:
44      !          - transport the ratio C14/C as in Toggweiler et al. (JGR,1989)
45      !          - if on-line a passive tracer (jpcref; NO sms) allows compensating for
46      !            freshwater fluxes which should not impact the C14/C ratio
47      !
48      !        =>   Delta-C14= ( tr(...jp_c14,Kmm) -1)*1000.
49      !!
50      !!----------------------------------------------------------------------
51      !
52      INTEGER, INTENT(in) ::   kt               ! ocean time-step index
53      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level
54      !
55      INTEGER  :: ji, jj, jk        ! dummy loop indices
56      REAL(wp) :: zt, ztp, zsk      ! dummy variables
57      REAL(wp) :: zsol              ! solubility
58      REAL(wp) :: zsch              ! schmidt number
59      REAL(wp) :: zv2               ! wind speed ( square)
60      REAL(wp) :: zpv               ! piston velocity
61      !!----------------------------------------------------------------------
62      !
63      IF( ln_timing )   CALL timing_start('trc_sms_c14')
64      !
65      IF( kt ==  nittrc000 ) THEN
66         IF(lwp) WRITE(numout,*)
67         IF(lwp) WRITE(numout,*) ' trc_sms_c14:  C14 model'
68         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
69      ENDIF
70      !
71      ! Get co2sbc & c14sbc(ji,jj): at 1st iter for all, at each time step for transient
72      IF( kc14typ >= 1 .OR.  kt ==  nittrc000 )   CALL trc_atm_c14( kt, co2sbc, c14sbc ) 
73
74      ! -------------------------------------------------------------------
75      !  Gas exchange coefficient (Wanninkhof, 1992, JGR, 97,7373-7382)
76      !  Schmidt number of CO2 in seawater (Wanninkhof, 1992 & 2014)
77      !  CO2 solubility (Weiss, 1974; Wanninkhof, 2014)
78      ! -------------------------------------------------------------------
79
80      DO jj = 1, jpj
81         DO ji = 1, jpi 
82            IF( tmask(ji,jj,1) >  0. ) THEN
83               !
84               zt   = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) )
85               !
86               !  Computation of solubility zsol in [mol/(L * atm)]
87               !   after Wanninkhof (2014) referencing Weiss (1974)
88               ztp  = ( zt + 273.16 ) * 0.01
89               zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)]
90               zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) )
91               ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)]
92               zsol = zsol * 1.e-03
93
94               ! Computes the Schmidt number of CO2 in seawater
95               !               Wanninkhof-2014
96               zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) )
97
98               ! Wanninkhof Piston velocity: zpv in units [m/s]
99               zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points
100               ! chemical enhancement (Wanninkhof & Knox, 1996)
101               IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) )
102               zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s
103               !
104               zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1)
105
106               ! CO2 piston velocity (m/s)
107               exch_co2(ji,jj)= zpv
108               ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity
109               exch_c14(ji,jj)= zpv * zsol
110            ELSE
111               exch_co2(ji,jj) = 0._wp
112               exch_c14(ji,jj) = 0._wp
113            ENDIF
114         END DO
115      END DO
116
117      ! Exchange velocity for 14C/C ratio (m/s)
118      zt = co2sbc / xdicsur
119      exch_c14(:,:) = zt * exch_c14(:,:)
120      !
121      ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s
122      !                               already masked
123      qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) )
124           
125      ! cumulation of air-to-sea flux at each time step
126      qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rdttrc
127      !
128      ! Add the surface flux to the trend of jp_c14
129      DO jj = 1, jpj
130         DO ji = 1, jpi
131            tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm) 
132         END DO
133      END DO
134      !
135      ! Computation of decay effects on jp_c14
136      DO jk = 1, jpk
137         DO jj = 1, jpj
138            DO ji = 1, jpi
139               !
140               tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk) 
141               !
142            END DO
143         END DO
144      END DO
145      !
146      IF( lrst_trc ) THEN
147         IF(lwp) WRITE(numout,*)
148         IF(lwp) WRITE(numout,*) ' trc_rst_wri_c14 : Write specific variables from c14 model '
149         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
150         !
151         CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc )       ! These five need      &
152         CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc )     ! &    to be written   &
153         CALL iom_rstput( kt, nitrst, numrtw, 'exch_co2', exch_co2 ) ! &    for temporal    &
154         CALL iom_rstput( kt, nitrst, numrtw, 'exch_c14', exch_c14 ) ! &    averages        &
155         CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14 )   ! &    to be coherent.
156         CALL iom_rstput( kt, nitrst, numrtw, 'qint_c14', qint_c14 ) ! Cumulative
157         !
158      ENDIF
159
160      IF( l_trdtrc )  CALL trd_trc( tr(:,:,:,jp_c14,Krhs), 1, jptra_sms, kt, Kmm )   ! save trends
161      !
162      IF( ln_timing )   CALL timing_stop('trc_sms_c14')
163      !
164   END SUBROUTINE trc_sms_c14
165
166  !!======================================================================
167END MODULE trcsms_c14
Note: See TracBrowser for help on using the repository browser.