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 trunk/NEMOGCM/NEMO/TOP_SRC/CFC – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 @ 7646

Last change on this file since 7646 was 7646, checked in by timgraham, 7 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

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