Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
MODULE trcwri_c14
!!======================================================================
!! *** MODULE trcwri ***
!! MY_SRC : Additional outputs for C14 tracers
!!======================================================================
!! History : 1.0 ! 2009-05 (C. Ethe) Original code
!! History : 2.0 ! 2015 (A. Mouchet) adapted code for C14
!!----------------------------------------------------------------------
#if defined key_top && defined key_xios
!!----------------------------------------------------------------------
!! trc_wri_c14 : outputs of ventilation fields
!!----------------------------------------------------------------------
USE oce_trc ! Ocean variables
USE trc ! passive tracers common variables
USE iom ! I/O manager
USE sms_c14
IMPLICIT NONE
PRIVATE
PUBLIC trc_wri_c14
!
! Standard ratio: 1.176E-12 ; Avogadro's nbr = 6.022E+23 at/mol ; bomb C14 traditionally reported as 1.E+26 atoms
REAL(wp), PARAMETER :: atomc14 = 1.176 * 6.022E-15 ! conversion factor
!! * Substitutions
# include "do_loop_substitute.h90"
CONTAINS
SUBROUTINE trc_wri_c14( Kmm )
!!---------------------------------------------------------------------
!! *** ROUTINE trc_wri_c14 ***
!!
!! ** Purpose : output additional C14 tracers fields
!!---------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! time level indices
CHARACTER (len=20) :: cltra ! short title for tracer
INTEGER :: ji,jj,jk,jn ! dummy loop indexes
REAL(wp) :: zage,zarea,ztemp ! temporary
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zres, z2d ! temporary storage 2D
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d , zz3d ! temporary storage 3D
!!---------------------------------------------------------------------
! write the tracer concentrations in the file
! ---------------------------------------
cltra = TRIM( ctrcnm(jp_c14) ) ! short title for tracer
CALL iom_put( cltra, tr(:,:,:,jp_c14,Kmm) )
! compute and write the tracer diagnostic in the file
! ---------------------------------------
IF( iom_use("DeltaC14") .OR. iom_use("C14Age") .OR. iom_use("RAge") ) THEN
!
ALLOCATE( z2d(jpi,jpj), zres(jpi,jpj) )
ALLOCATE( z3d(jpi,jpj,jpk), zz3d(jpi,jpj,jpk) )
!
zage = -1._wp / rlam14 / rsiyea ! factor for radioages in year
z3d(:,:,:) = 1._wp
zz3d(:,:,:) = 0._wp
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
IF( tmask(ji,jj,jk) > 0._wp) THEN
z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm)
zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) )
ENDIF
END_3D
zres(:,:) = z3d(:,:,1)
! Reservoir age [yr]
z2d(:,:) =0._wp
jk = 1
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
ztemp = zres(ji,jj) / c14sbc(ji,jj)
IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
END_2D
!
z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp )
CALL iom_put( "DeltaC14" , z3d(:,:,:) ) ! Delta C14 [permil]
CALL iom_put( "C14Age" , zage * zz3d(:,:,:) ) ! Radiocarbon age [yr]
CALL iom_put( "qtr_c14", rsiyea * qtr_c14(:,:) ) ! Radiocarbon surf flux [./m2/yr]
CALL iom_put( "qint_c14" , qint_c14 ) ! cumulative flux [./m2]
CALL iom_put( "RAge" , zage * z2d(:,:) ) ! Reservoir age [yr]
!
DEALLOCATE( z2d, zres, z3d, zz3d )
!
ENDIF
!
! 0-D fields
!
CALL iom_put( "AtmCO2", co2sbc ) ! global atmospheric CO2 [ppm]
IF( iom_use("AtmC14") ) THEN
zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface
ztemp = glob_sum( 'trcwri_c14', c14sbc(:,:) * e1e2t(:,:) )
ztemp = ( ztemp / zarea - 1._wp ) * 1000._wp
CALL iom_put( "AtmC14" , ztemp ) ! Global atmospheric DeltaC14 [permil]
ENDIF
IF( iom_use("K_C14") ) THEN
ztemp = glob_sum ( 'trcwri_c14', exch_c14(:,:) * e1e2t(:,:) )
ztemp = rsiyea * ztemp / zarea
CALL iom_put( "K_C14" , ztemp ) ! global mean exchange velocity for C14/C ratio [m/yr]
ENDIF
IF( iom_use("K_CO2") ) THEN
zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface
ztemp = glob_sum ( 'trcwri_c14', exch_co2(:,:) * e1e2t(:,:) )
ztemp = 360000._wp * ztemp / zarea ! cm/h units: directly comparable with literature
CALL iom_put( "K_CO2", ztemp ) ! global mean CO2 piston velocity [cm/hr]
ENDIF
IF( iom_use("C14Inv") ) THEN
ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) )
ztemp = atomc14 * xdicsur * ztemp
CALL iom_put( "C14Inv", ztemp ) ! Radiocarbon ocean inventory [10^26 atoms]
END IF
!
END SUBROUTINE trc_wri_c14
#else
!!----------------------------------------------------------------------
!! Dummy module : No C14 tracer
!!----------------------------------------------------------------------
PUBLIC trc_wri_c14
CONTAINS
SUBROUTINE trc_wri_c14 ! Empty routine
END SUBROUTINE trc_wri_c14
#endif
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: trcwri_c14.F90 15090 2021-07-06 14:25:18Z cetlod $
!! Software governed by the CeCILL license (see ./LICENSE)
!!======================================================================
END MODULE trcwri_c14