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 branches/NERC/dev_r5518_GO6_CFC_CDIAC/NEMOGCM/NEMO/TOP_SRC/CFC – NEMO

source: branches/NERC/dev_r5518_GO6_CFC_CDIAC/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 @ 9422

Last change on this file since 9422 was 9422, checked in by jpalmier, 6 years ago

JPALM -- last modif after tests

File size: 18.9 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   !!                 !  2016-06  (J. Palmieri)  update for UKESM1
10   !!                 !  2017-04  (A. Yool)  update to add SF6, fix coefficients
11   !!----------------------------------------------------------------------
12#if defined key_cfc
13   !!----------------------------------------------------------------------
14   !!   'key_cfc'                                               CFC tracers
15   !!----------------------------------------------------------------------
16   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends
17   !!   cfc_init     :  sets constants for CFC surface forcing computation
18   !!----------------------------------------------------------------------
19   USE dom_oce       ! ocean space and time domain
20   USE oce_trc       ! Ocean variables
21   USE par_trc       ! TOP parameters
22   USE trc           ! TOP variables
23   USE trd_oce
24   USE trdtrc
25   USE iom           ! I/O library
26   USE wrk_nemo
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   trc_sms_cfc         ! called in ???   
32   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90
33
34   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
35   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file
36   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
37   INTEGER , PUBLIC            ::   simu_type      ! Kind of simulation: 1- Spin-up
38                                                   !                     2- Hindcast/projection
39   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
40   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)
41   
42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC
43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux
46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
47
48   REAL(wp), DIMENSION(4,3) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
49   REAL(wp), DIMENSION(3,3) ::   sob   !    "               "
50   REAL(wp), DIMENSION(5,3) ::   sca   ! coefficients for schmidt number in degre Celcius
51     
52   !                          ! coefficients for conversion
53   REAL(wp) ::   xconv1 = 1.0          ! conversion from to
54   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:
55   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm
56   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv
57
58   !! trend temporary array:
59   REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcfc
60
61   !! * Substitutions
62#  include "top_substitute.h90"
63   !!----------------------------------------------------------------------
64   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
65   !! $Id$
66   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
67   !!----------------------------------------------------------------------
68CONTAINS
69
70   SUBROUTINE trc_sms_cfc( kt )
71      !!----------------------------------------------------------------------
72      !!                     ***  ROUTINE trc_sms_cfc  ***
73      !!
74      !! ** Purpose :   Compute the surface boundary contition on CFC 11
75      !!             passive tracer associated with air-mer fluxes and add it
76      !!             to the general trend of tracers equations.
77      !!
78      !! ** Method  : - get the atmospheric partial pressure - given in pico -
79      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
80      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
81      !!              - the input function is given by :
82      !!                speed * ( concentration at equilibrium - concentration at surface )
83      !!              - the input function is in pico-mol/m3/s and the
84      !!                CFC concentration in pico-mol/m3
85      !!----------------------------------------------------------------------
86      !
87      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
88      !
89      INTEGER  ::   ji, jj, jn, jl, jm, js
90      INTEGER  ::   iyear_beg, iyear_end, iyear_tmp
91      INTEGER  ::   im1, im2, ierr
92      REAL(wp) ::   ztap, zdtap       
93      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2
94      REAL(wp) ::   zsol      ! solubility
95      REAL(wp) ::   zsch      ! schmidt number
96      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
97      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
98      REAL(wp) ::   zak_cfc   ! transfert coefficients
99      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function
100      !!----------------------------------------------------------------------
101      !
102      !
103      IF( nn_timing == 1 )  CALL timing_start('trc_sms_cfc')
104      !
105      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr )
106      IF( ierr > 0 ) THEN
107         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN
108      ENDIF
109
110      IF( kt == nittrc000 )   CALL cfc_init
111
112      ! Temporal interpolation
113      ! ----------------------
114      !! JPALM -- 15-06-2016 -- define 2 kinds of CFC run:
115      !!                     1- the SPIN-UP and 2- Hindcast/Projections
116      !!                     -- main difference is the way to define the year of
117      !!                     simulation, that determine the atm pCFC.
118      !!                     1-- Spin-up: our atm forcing is of 30y we cycle on.
119      !!                     So we do 90y CFC cycles to be in good
120      !!                     correspondence with the atmosphere
121      !!                     2-- Hindcast/proj, instead of nyear-1900 we keep
122      !!                     the 2 last digit, and enable 3 cycle from 1800 to 2100. 
123      !!----------------------------------------------------------------------
124      IF (simu_type==1) THEN
125         !! 1 -- SPIN-UP
126         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000
127         iyear_beg = MOD( iyear_tmp , 90 )
128         !! JPALM -- the pCFC file only got 78 years.
129         !!       So if iyear_beg > 78 then we set pCFC to 0
130         !!             iyear_beg = 0 as well -- must try to avoid obvious problems
131         !!             as Pcfc is set to 0.00 up to year 32, let set iyear_beg to year 10
132         !!          else, must add 30 to iyear_beg to match with P_cfc indices
133         !!---------------------------------------
134         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN
135            iyear_beg = 10
136         ELSE
137            iyear_beg = iyear_beg + 30
138         ENDIF
139      ELSEIF (simu_type==2) THEN
140         !! 2 -- Hindcast/proj
141         iyear_beg = MOD(nyear, 100)
142         IF (iyear_beg < 15)  iyear_beg = iyear_beg + 100
143         !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range,
144         !!       we want to set p_CFC to 0.00 --> set iyear_beg = 10
145         IF ( nyear < 1930)  iyear_beg = 10             
146         IF ( nyear >= 2015) iyear_beg = 115             
147      ENDIF
148      !!
149      IF ( nmonth <= 6 ) THEN
150         iyear_beg = iyear_beg - 1
151         im1       =  6 - nmonth + 1
152         im2       =  6 + nmonth - 1
153      ELSE
154         im1       = 12 - nmonth + 7
155         im2       =      nmonth - 7
156      ENDIF
157      iyear_end = iyear_beg + 1
158
159      !                                                  !------------!
160      DO jl = 1, jp_cfc                                  !  CFC loop  !
161         !                                               !------------!
162         jn = jp_cfc0 + jl - 1
163         ! time interpolation at time kt
164         DO jm = 1, jphem
165            zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  &
166               &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12.
167         END DO
168         
169         !                                                         !------------!
170         DO jj = 1, jpj                                            !  i-j loop  !
171            DO ji = 1, jpi                                         !------------!
172 
173               ! space interpolation
174               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
175                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
176
177               ! Computation of concentration at equilibrium : in picomol/l
178               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
179               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
180                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
181                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
182                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
183                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 
184               ELSE
185                  zsol  = 0.e0
186               ENDIF
187               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv   
188               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 
189               ! concentration at equilibrium
190               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
191 
192               ! Computation of speed transfert
193               !    Schmidt number
194               zt1  = tsn(ji,jj,1,jp_tem)
195               zt2  = zt1 * zt1 
196               zt3  = zt1 * zt2
197               zt4  = zt1 * zt3
198               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4
199
200               !    speed transfert : formulae of wanninkhof 1992
201               zv2     = wndm(ji,jj) * wndm(ji,jj)
202               zsch    = zsch / 660.
203               ! AXY (25/04/17): OMIP protocol specifies lower Wanninkhof (2014) value
204               ! zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
205               zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
206
207               ! Input function  : speed *( conc. at equil - concen at surface )
208               ! trn in pico-mol/l idem qtr; ak in en m/a
209               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
210#if defined key_degrad
211                  &                         * facvol(ji,jj,1)                           &
212#endif
213                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
214               ! Add the surface flux to the trend
215               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 
216
217               ! cumulation of surface flux at each time step
218               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
219               !                                               !----------------!
220            END DO                                             !  end i-j loop  !
221         END DO                                                !----------------!
222         !                                                  !----------------!
223      END DO                                                !  end CFC loop  !
224         !
225      IF( kt == nittrc000 ) THEN
226         DO jl = 1, jp_cfc   
227             WRITE(NUMOUT,*) ' '
228             WRITE(NUMOUT,*) 'CFC interpolation verification '  !! Jpalm 
229             WRITE(NUMOUT,*) '################################## '
230             WRITE(NUMOUT,*) ' '
231               if (jl.EQ.1) then
232                   WRITE(NUMOUT,*) 'Traceur = CFC11: '
233               elseif (jl.EQ.2) then
234                   WRITE(NUMOUT,*) 'Traceur = CFC12: '
235               elseif (jl.EQ.3) then
236                   WRITE(NUMOUT,*) 'Traceur = SF6: '
237               endif
238             WRITE(NUMOUT,*) 'nyear    = ', nyear
239             WRITE(NUMOUT,*) 'nmonth   = ', nmonth
240             WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg
241             WRITE(NUMOUT,*) 'iyear_end= ', iyear_end
242             WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl)
243             WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl)
244             WRITE(NUMOUT,*) 'Im1= ',im1
245             WRITE(NUMOUT,*) 'Im2= ',im2
246             WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc
247             WRITE(NUMOUT,*) ' '
248         END DO 
249# if defined key_debug_medusa
250         CALL flush(numout)
251# endif
252      ENDIF
253        !
254      !IF( lrst_trc ) THEN
255      !   IF(lwp) WRITE(numout,*)
256      !   IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
257      !      &                    'at it= ', kt,' date= ', ndastp
258      !   IF(lwp) WRITE(numout,*) '~~~~'
259      !   DO jn = jp_cfc0, jp_cfc1
260      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
261      !   END DO
262      !ENDIF                                           
263      !
264      IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
265      IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
266      IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) )
267      IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) )
268      IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) )
269      IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) )
270      !
271      IF( l_trdtrc ) THEN
272          CALL wrk_alloc( jpi, jpj, jpk, ztrcfc )
273          DO jn = jp_cfc0, jp_cfc1
274             ztrcfc(:,:,:) = tra(:,:,:,jn)
275            CALL trd_trc( ztrcfc, jn, jptra_sms, kt )   ! save trends
276          END DO
277          CALL wrk_dealloc( jpi, jpj, jpk, ztrcfc )
278      END IF
279      !
280# if defined key_debug_medusa
281      IF(lwp) WRITE(numout,*) '   CFC - Check: nn_timing = ', nn_timing
282      CALL flush(numout)
283# endif
284      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc')
285      !
286   END SUBROUTINE trc_sms_cfc
287
288
289   SUBROUTINE cfc_init
290      !!---------------------------------------------------------------------
291      !!                     ***  cfc_init  *** 
292      !!
293      !! ** Purpose : sets constants for CFC model
294      !!---------------------------------------------------------------------
295      INTEGER :: jl, jn, iyear_beg, iyear_tmp
296
297      ! coefficient for CFC11
298      !----------------------
299
300      ! Solubility
301      soa(1,1) = -229.9261 
302      soa(2,1) =  319.6552
303      soa(3,1) =  119.4471
304      soa(4,1) =   -1.39165
305
306      sob(1,1) = -0.142382
307      sob(2,1) =  0.091459
308      sob(3,1) = -0.0157274
309
310      ! Schmidt number          AXY (25/04/17)
311      sca(1,1) = 3579.2       ! = 3501.8
312      sca(2,1) = -222.63      ! = -210.31
313      sca(3,1) =    7.5749    ! =    6.1851
314      sca(4,1) =   -0.14595   ! =   -0.07513
315      sca(5,1) =    0.0011874 ! = absent
316
317      ! coefficient for CFC12
318      !----------------------
319
320      ! Solubility
321      soa(1,2) = -218.0971
322      soa(2,2) =  298.9702
323      soa(3,2) =  113.8049
324      soa(4,2) =   -1.39165
325
326      sob(1,2) = -0.143566
327      sob(2,2) =  0.091015
328      sob(3,2) = -0.0153924
329
330      ! schmidt number         AXY (25/04/17)
331      sca(1,2) = 3828.1      ! = 3845.4
332      sca(2,2) = -249.86     ! = -228.95
333      sca(3,2) =    8.7603   ! =    6.1908
334      sca(4,2) =   -0.1716   ! =   -0.067430
335      sca(5,2) =    0.001408 ! = absent
336
337      ! coefficients for SF6   AXY (25/04/17)
338      !---------------------
339     
340      ! Solubility
341      soa(1,3) =  -80.0343
342      soa(2,3) =  117.232
343      soa(3,3) =   29.5817
344      soa(4,3) =    0.0
345
346      sob(1,3) =  0.0335183
347      sob(2,3) = -0.0373942
348      sob(3,3) =  0.00774862
349
350      ! Schmidt number
351      sca(1,3) = 3177.5
352      sca(2,3) = -200.57
353      sca(3,3) =    6.8865
354      sca(4,3) =   -0.13335
355      sca(5,3) =    0.0010877
356
357      !!---------------------------------------------
358      !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle,
359      !!       Or if out of P_cfc range
360      IF (simu_type==1) THEN
361         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000
362         iyear_beg = MOD( iyear_tmp , 90 )
363         !!---------------------------------------
364         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN
365            qtr_cfc(:,:,:) = 0._wp
366            IF(lwp) THEN
367               WRITE(numout,*) 
368               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --'
369               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --'
370               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --'
371               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --'
372            ENDIF
373            qtr_cfc(:,:,:) = 0._wp
374            qint_cfc(:,:,:) = 0._wp
375            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
376            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
377         ENDIF
378      !!
379      !! 2 -- Hindcast/proj
380      ELSEIF (simu_type==2) THEN
381         iyear_beg = MOD(nyear, 100)
382         IF (iyear_beg < 20)  iyear_beg = iyear_beg + 100
383         IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) THEN
384            qtr_cfc(:,:,:) = 0._wp
385            IF(lwp) THEN
386               WRITE(numout,*)
387               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --'
388               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --'
389               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --'
390               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --'
391            ENDIF
392            qtr_cfc(:,:,:) = 0._wp
393            qint_cfc(:,:,:) = 0._wp
394            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
395            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp
396         ENDIF
397      ENDIF
398
399      IF(lwp) WRITE(numout,*)
400      !
401   END SUBROUTINE cfc_init
402
403
404   INTEGER FUNCTION trc_sms_cfc_alloc()
405      !!----------------------------------------------------------------------
406      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
407      !!----------------------------------------------------------------------
408      ALLOCATE( xphem   (jpi,jpj)        ,     &
409         &      qtr_cfc (jpi,jpj,jp_cfc) ,     &
410         &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc )
411         !
412      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.')
413      !
414   END FUNCTION trc_sms_cfc_alloc
415
416#else
417   !!----------------------------------------------------------------------
418   !!   Dummy module                                         No CFC tracers
419   !!----------------------------------------------------------------------
420CONTAINS
421   SUBROUTINE trc_sms_cfc( kt )       ! Empty routine
422      WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt
423   END SUBROUTINE trc_sms_cfc
424#endif
425
426   !!======================================================================
427END MODULE trcsms_cfc
Note: See TracBrowser for help on using the repository browser.