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

source: NEMO/trunk/src/TOP/CFC/trcsms_cfc.F90 @ 12808

Last change on this file since 12808 was 12489, checked in by davestorkey, 4 years ago

Preparation for new timestepping scheme #2390.
Main changes:

  1. Initial euler timestep now handled in stp and not in TRA/DYN routines.
  2. Renaming of all timestep parameters. In summary, the namelist parameter is now rn_Dt and the current timestep is rDt (and rDt_ice, rDt_trc etc).
  3. Renaming of a few miscellaneous parameters, eg. atfp -> rn_atfp (namelist parameter used everywhere) and rau0 -> rho0.

This version gives bit-comparable results to the previous version of the trunk.

  • Property svn:keywords set to Id
File size: 13.2 KB
RevLine 
[933]1MODULE trcsms_cfc
2   !!======================================================================
3   !!                      ***  MODULE trcsms_cfc  ***
4   !! TOP : CFC main model
5   !!======================================================================
[2715]6   !! History :  OPA  !  1999-10  (JC. Dutay)  original code
7   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity
8   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation
[7646]9   !!            4.0  !  2016-11  (T. Lovato) Add SF6, Update Schmidt number
[933]10   !!----------------------------------------------------------------------
[2715]11   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends
[3680]12   !!   cfc_init     :  sets constants for CFC surface forcing computation
[933]13   !!----------------------------------------------------------------------
[2715]14   USE oce_trc       ! Ocean variables
15   USE par_trc       ! TOP parameters
16   USE trc           ! TOP variables
[4990]17   USE trd_oce
18   USE trdtrc
[2715]19   USE iom           ! I/O library
[933]20
21   IMPLICIT NONE
22   PRIVATE
23
[2715]24   PUBLIC   trc_sms_cfc         ! called in ???   
25   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90
[933]26
27   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
[7646]28   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in input data file (in trcini_cfc)
[3294]29   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
30   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
31   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)
[933]32   
[7646]33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for all CFC
[2715]34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux
[7646]37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   atm_cfc  ! partial hemispheric pressure for used CFC
[3294]38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
[933]39
[7646]40   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   soa      ! coefficient for solubility of CFC [mol/l/atm]
41   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sob      !    "               "
42   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sca      ! coefficients for schmidt number in degrees Celsius
[933]43   !                          ! coefficients for conversion
44   REAL(wp) ::   xconv1 = 1.0          ! conversion from to
45   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:
46   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm
47   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv
48
[12377]49   !! * Substitutions
50#  include "do_loop_substitute.h90"
[933]51   !!----------------------------------------------------------------------
[10067]52   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[1146]53   !! $Id$
[10068]54   !! Software governed by the CeCILL license (see ./LICENSE)
[933]55   !!----------------------------------------------------------------------
56CONTAINS
57
[12377]58   SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs )
[933]59      !!----------------------------------------------------------------------
60      !!                     ***  ROUTINE trc_sms_cfc  ***
61      !!
62      !! ** Purpose :   Compute the surface boundary contition on CFC 11
63      !!             passive tracer associated with air-mer fluxes and add it
64      !!             to the general trend of tracers equations.
65      !!
66      !! ** Method  : - get the atmospheric partial pressure - given in pico -
67      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
68      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
69      !!              - the input function is given by :
70      !!                speed * ( concentration at equilibrium - concentration at surface )
71      !!              - the input function is in pico-mol/m3/s and the
72      !!                CFC concentration in pico-mol/m3
73      !!----------------------------------------------------------------------
[12377]74      INTEGER, INTENT(in) ::   kt               ! ocean time-step index
75      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level
[2715]76      !
[9456]77      INTEGER  ::   ji, jj, jn, jl, jm
[2715]78      INTEGER  ::   iyear_beg, iyear_end
[3294]79      INTEGER  ::   im1, im2, ierr
[933]80      REAL(wp) ::   ztap, zdtap       
[7646]81      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2
[933]82      REAL(wp) ::   zsol      ! solubility
83      REAL(wp) ::   zsch      ! schmidt number
84      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
85      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
86      REAL(wp) ::   zak_cfc   ! transfert coefficients
[3294]87      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function
[933]88      !!----------------------------------------------------------------------
[2715]89      !
[9124]90      IF( ln_timing )   CALL timing_start('trc_sms_cfc')
[3294]91      !
92      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr )
93      IF( ierr > 0 ) THEN
94         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN
[2715]95      ENDIF
[933]96
[3680]97      IF( kt == nittrc000 )   CALL cfc_init
[933]98
99      ! Temporal interpolation
100      ! ----------------------
[2047]101      iyear_beg = nyear - 1900
[933]102      IF ( nmonth <= 6 ) THEN
[2047]103         iyear_beg = iyear_beg - 1
[933]104         im1       =  6 - nmonth + 1
105         im2       =  6 + nmonth - 1
106      ELSE
107         im1       = 12 - nmonth + 7
108         im2       =      nmonth - 7
109      ENDIF
[12300]110      ! Avoid bad interpolation if starting date is =< 1900
111      IF( iyear_beg .LE. 0      )  iyear_beg = 1
112      IF( iyear_beg .GE. jpyear )  iyear_beg = jpyear - 1
113      !
[933]114      iyear_end = iyear_beg + 1
115
[1255]116      !                                                  !------------!
117      DO jl = 1, jp_cfc                                  !  CFC loop  !
118         !                                               !------------!
119         jn = jp_cfc0 + jl - 1
[933]120         ! time interpolation at time kt
121         DO jm = 1, jphem
[7646]122            zpatm(jm,jl) = (  atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp)  &
123               &           +  atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12.
[933]124         END DO
125         
126         !                                                         !------------!
[12377]127         DO_2D_11_11
[933]128 
[12377]129            ! space interpolation
130            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
131               &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
[933]132
[12377]133            ! Computation of concentration at equilibrium : in picomol/l
134            ! coefficient for solubility for CFC-11/12 in  mol/l/atm
135            IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
136               ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01
137               zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
138               zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
139                  &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap ) 
140            ELSE
141               zsol  = 0.e0
142            ENDIF
143            ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv   
144            zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 
145            ! concentration at equilibrium
146            zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
147            ! Computation of speed transfert
148            !    Schmidt number revised in Wanninkhof (2014)
149            zt1  = ts(ji,jj,1,jp_tem,Kmm)
150            zt2  = zt1 * zt1 
151            zt3  = zt1 * zt2
152            zt4  = zt2 * zt2
153            zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4
[933]154
[12377]155            !    speed transfert : formulae revised in Wanninkhof (2014)
156            zv2     = wndm(ji,jj) * wndm(ji,jj)
157            zsch    = zsch / 660.
158            zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
[933]159
[12377]160            ! Input function  : speed *( conc. at equil - concen at surface )
161            ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a
162            qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   &
163               &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
164            ! Add the surface flux to the trend
165            tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm) 
[933]166
[12377]167            ! cumulation of surface flux at each time step
[12489]168            qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rn_Dt
[12377]169            !                                               !----------------!
170         END_2D
[933]171         !                                                  !----------------!
172      END DO                                                !  end CFC loop  !
[3680]173      !
174      IF( lrst_trc ) THEN
175         IF(lwp) WRITE(numout,*)
176         IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
177            &                    'at it= ', kt,' date= ', ndastp
178         IF(lwp) WRITE(numout,*) '~~~~'
[9456]179         jl = 0
[3680]180         DO jn = jp_cfc0, jp_cfc1
[9456]181             jl = jl + 1
182            CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
[3680]183         END DO
[4996]184      ENDIF                                           
185      !
186      IF( lk_iomput ) THEN
[8397]187         jl = 0
[7646]188         DO jn = jp_cfc0, jp_cfc1
[8397]189            jl = jl + 1
190            CALL iom_put( 'qtr_'//TRIM(ctrcnm(jn)) , qtr_cfc (:,:,jl) )
191            CALL iom_put( 'qint_'//TRIM(ctrcnm(jn)), qint_cfc(:,:,jl) )
[7646]192         ENDDO
[3294]193      END IF
[4996]194      !
[1255]195      IF( l_trdtrc ) THEN
196          DO jn = jp_cfc0, jp_cfc1
[12377]197            CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends
[1255]198          END DO
199      END IF
[2715]200      !
[9124]201      IF( ln_timing )   CALL timing_stop('trc_sms_cfc')
[2715]202      !
[933]203   END SUBROUTINE trc_sms_cfc
204
[2715]205
[3680]206   SUBROUTINE cfc_init
[933]207      !!---------------------------------------------------------------------
[3680]208      !!                     ***  cfc_init  *** 
[933]209      !!
210      !! ** Purpose : sets constants for CFC model
211      !!---------------------------------------------------------------------
[9456]212      INTEGER ::   jn, jl   !
[7646]213      !!----------------------------------------------------------------------
214      !
215      jn = 0 
[2715]216      ! coefficient for CFC11
217      !----------------------
[7646]218      if ( ln_cfc11 ) then
219         jn = jn + 1
220         ! Solubility
221         soa(1,jn) = -229.9261 
222         soa(2,jn) =  319.6552
223         soa(3,jn) =  119.4471
224         soa(4,jn) =  -1.39165
[933]225
[7646]226         sob(1,jn) =  -0.142382
227         sob(2,jn) =   0.091459
228         sob(3,jn) =  -0.0157274
[933]229
[7646]230         ! Schmidt number
231         sca(1,jn) = 3579.2
232         sca(2,jn) = -222.63
233         sca(3,jn) = 7.5749
234         sca(4,jn) = -0.14595
235         sca(5,jn) = 0.0011874
[933]236
[7646]237         ! atm. concentration
238         atm_cfc(:,:,jn) = p_cfc(:,:,1)
239      endif
[1004]240
[2715]241      ! coefficient for CFC12
242      !----------------------
[7646]243      if ( ln_cfc12 ) then
244         jn = jn + 1
245         ! Solubility
246         soa(1,jn) = -218.0971
247         soa(2,jn) =  298.9702
248         soa(3,jn) =  113.8049
249         soa(4,jn) =  -1.39165
[1004]250
[7646]251         sob(1,jn) =  -0.143566
252         sob(2,jn) =   0.091015
253         sob(3,jn) =  -0.0153924
[1255]254
[7646]255         ! schmidt number
256         sca(1,jn) = 3828.1
257         sca(2,jn) = -249.86
258         sca(3,jn) = 8.7603
259         sca(4,jn) = -0.1716
260         sca(5,jn) = 0.001408
[1255]261
[7646]262         ! atm. concentration
263         atm_cfc(:,:,jn) = p_cfc(:,:,2)
264      endif
[1255]265
[7646]266      ! coefficient for SF6
267      !----------------------
268      if ( ln_sf6 ) then
269         jn = jn + 1
270         ! Solubility
271         soa(1,jn) = -80.0343
272         soa(2,jn) = 117.232
273         soa(3,jn) =  29.5817
274         soa(4,jn) =   0.0
275
276         sob(1,jn) =  0.0335183 
277         sob(2,jn) = -0.0373942 
278         sob(3,jn) =  0.00774862
279
280         ! schmidt number
281         sca(1,jn) = 3177.5
282         sca(2,jn) = -200.57
283         sca(3,jn) = 6.8865
284         sca(4,jn) = -0.13335
285         sca(5,jn) = 0.0010877
286 
287         ! atm. concentration
288         atm_cfc(:,:,jn) = p_cfc(:,:,3)
289       endif
290
[3680]291      IF( ln_rsttr ) THEN
292         IF(lwp) WRITE(numout,*)
293         IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model '
294         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
295         !
[9456]296         jl = 0
[3680]297         DO jn = jp_cfc0, jp_cfc1
[9456]298            jl = jl + 1
299            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
[3680]300         END DO
301      ENDIF
302      IF(lwp) WRITE(numout,*)
303      !
304   END SUBROUTINE cfc_init
[1255]305
[2715]306
307   INTEGER FUNCTION trc_sms_cfc_alloc()
308      !!----------------------------------------------------------------------
309      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
310      !!----------------------------------------------------------------------
[7646]311      ALLOCATE( xphem   (jpi,jpj)        , atm_cfc(jpyear,jphem,jp_cfc)  ,    &
312         &      qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc)      ,    &
313         &      soa(4,jp_cfc)    ,  sob(3,jp_cfc)   ,  sca(5,jp_cfc)     ,    &
314         &      STAT=trc_sms_cfc_alloc )
[2715]315         !
[10425]316      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_sms_cfc_alloc : failed to allocate arrays.' )
[2715]317      !
318   END FUNCTION trc_sms_cfc_alloc
319
[933]320   !!======================================================================
321END MODULE trcsms_cfc
Note: See TracBrowser for help on using the repository browser.