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.
trcwri_c14.F90 in NEMO/branches/UKMO/dev_r9950_GO6_mixing/src/TOP/C14 – NEMO

source: NEMO/branches/UKMO/dev_r9950_GO6_mixing/src/TOP/C14/trcwri_c14.F90 @ 10327

Last change on this file since 10327 was 10327, checked in by davestorkey, 5 years ago

UKMO/dev_r9950_GO6_mixing branch: clear SVN keywords.

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