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

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 12.4 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   !!----------------------------------------------------------------------
10#if defined key_cfc
11   !!----------------------------------------------------------------------
12   !!   'key_cfc'                                               CFC tracers
13   !!----------------------------------------------------------------------
14   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends
15   !!   cfc_init     :  sets constants for CFC surface forcing computation
16   !!----------------------------------------------------------------------
17   USE oce_trc       ! Ocean variables
18   USE par_trc       ! TOP parameters
19   USE trc           ! TOP variables
20   USE trd_oce
21   USE trdtrc
22   USE iom           ! I/O library
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   trc_sms_cfc         ! called in ???   
28   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90
29
30   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
31   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file
32   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
33   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
34   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)
35   
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux
40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
41
42   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
43   REAL(wp), DIMENSION(3,2) ::   sob   !    "               "
44   REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius
45     
46   !                          ! coefficients for conversion
47   REAL(wp) ::   xconv1 = 1.0          ! conversion from to
48   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:
49   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm
50   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv
51
52   !! * Substitutions
53#  include "domzgr_substitute.h90"
54   !!----------------------------------------------------------------------
55   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
56   !! $Id$
57   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
58   !!----------------------------------------------------------------------
59CONTAINS
60
61   SUBROUTINE trc_sms_cfc( kt )
62      !!----------------------------------------------------------------------
63      !!                     ***  ROUTINE trc_sms_cfc  ***
64      !!
65      !! ** Purpose :   Compute the surface boundary contition on CFC 11
66      !!             passive tracer associated with air-mer fluxes and add it
67      !!             to the general trend of tracers equations.
68      !!
69      !! ** Method  : - get the atmospheric partial pressure - given in pico -
70      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
71      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
72      !!              - the input function is given by :
73      !!                speed * ( concentration at equilibrium - concentration at surface )
74      !!              - the input function is in pico-mol/m3/s and the
75      !!                CFC concentration in pico-mol/m3
76      !!----------------------------------------------------------------------
77      !
78      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
79      !
80      INTEGER  ::   ji, jj, jn, jl, jm, js
81      INTEGER  ::   iyear_beg, iyear_end
82      INTEGER  ::   im1, im2, ierr
83      REAL(wp) ::   ztap, zdtap       
84      REAL(wp) ::   zt1, zt2, zt3, zv2
85      REAL(wp) ::   zsol      ! solubility
86      REAL(wp) ::   zsch      ! schmidt number
87      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
88      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
89      REAL(wp) ::   zak_cfc   ! transfert coefficients
90      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function
91      !!----------------------------------------------------------------------
92      !
93      !
94      IF( nn_timing == 1 )  CALL timing_start('trc_sms_cfc')
95      !
96      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr )
97      IF( ierr > 0 ) THEN
98         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN
99      ENDIF
100
101      IF( kt == nittrc000 )   CALL cfc_init
102
103      ! Temporal interpolation
104      ! ----------------------
105      iyear_beg = nyear - 1900
106      IF ( nmonth <= 6 ) THEN
107         iyear_beg = iyear_beg - 1
108         im1       =  6 - nmonth + 1
109         im2       =  6 + nmonth - 1
110      ELSE
111         im1       = 12 - nmonth + 7
112         im2       =      nmonth - 7
113      ENDIF
114      iyear_end = iyear_beg + 1
115
116      !                                                  !------------!
117      DO jl = 1, jp_cfc                                  !  CFC loop  !
118         !                                               !------------!
119         jn = jp_cfc0 + jl - 1
120         ! time interpolation at time kt
121         DO jm = 1, jphem
122            zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  &
123               &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12.
124         END DO
125         
126         !                                                         !------------!
127         DO jj = 1, jpj                                            !  i-j loop  !
128            DO ji = 1, jpi                                         !------------!
129 
130               ! space interpolation
131               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
132                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
133
134               ! Computation of concentration at equilibrium : in picomol/l
135               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
136               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
137                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
138                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
139                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
140                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 
141               ELSE
142                  zsol  = 0.e0
143               ENDIF
144               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv   
145               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 
146               ! concentration at equilibrium
147               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
148 
149               ! Computation of speed transfert
150               !    Schmidt number
151               zt1  = tsn(ji,jj,1,jp_tem)
152               zt2  = zt1 * zt1 
153               zt3  = zt1 * zt2
154               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3
155
156               !    speed transfert : formulae of wanninkhof 1992
157               zv2     = wndm(ji,jj) * wndm(ji,jj)
158               zsch    = zsch / 660.
159               zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
160
161               ! Input function  : speed *( conc. at equil - concen at surface )
162               ! trn in pico-mol/l idem qtr; ak in en m/a
163               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
164#if defined key_degrad
165                  &                         * facvol(ji,jj,1)                           &
166#endif
167                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
168               ! Add the surface flux to the trend
169               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 
170
171               ! cumulation of surface flux at each time step
172               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
173               !                                               !----------------!
174            END DO                                             !  end i-j loop  !
175         END DO                                                !----------------!
176         !                                                  !----------------!
177      END DO                                                !  end CFC loop  !
178      !
179      IF( lrst_trc ) THEN
180         IF(lwp) WRITE(numout,*)
181         IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
182            &                    'at it= ', kt,' date= ', ndastp
183         IF(lwp) WRITE(numout,*) '~~~~'
184         DO jn = jp_cfc0, jp_cfc1
185            CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
186         END DO
187      ENDIF                                           
188      !
189      IF( lk_iomput ) THEN
190         CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
191         CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
192      ELSE
193         IF( ln_diatrc ) THEN
194            trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1)
195            trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1)
196         END IF
197      END IF
198      !
199      IF( l_trdtrc ) THEN
200          DO jn = jp_cfc0, jp_cfc1
201            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
202          END DO
203      END IF
204      !
205      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc')
206      !
207   END SUBROUTINE trc_sms_cfc
208
209
210   SUBROUTINE cfc_init
211      !!---------------------------------------------------------------------
212      !!                     ***  cfc_init  *** 
213      !!
214      !! ** Purpose : sets constants for CFC model
215      !!---------------------------------------------------------------------
216      INTEGER :: jn
217
218      ! coefficient for CFC11
219      !----------------------
220
221      ! Solubility
222      soa(1,1) = -229.9261 
223      soa(2,1) =  319.6552
224      soa(3,1) =  119.4471
225      soa(4,1) =  -1.39165
226
227      sob(1,1) =  -0.142382
228      sob(2,1) =   0.091459
229      sob(3,1) =  -0.0157274
230
231      ! Schmidt number
232      sca(1,1) = 3501.8
233      sca(2,1) = -210.31
234      sca(3,1) =  6.1851
235      sca(4,1) = -0.07513
236
237      ! coefficient for CFC12
238      !----------------------
239
240      ! Solubility
241      soa(1,2) = -218.0971
242      soa(2,2) =  298.9702
243      soa(3,2) =  113.8049
244      soa(4,2) =  -1.39165
245
246      sob(1,2) =  -0.143566
247      sob(2,2) =   0.091015
248      sob(3,2) =  -0.0153924
249
250      ! schmidt number
251      sca(1,2) =  3845.4 
252      sca(2,2) =  -228.95
253      sca(3,2) =  6.1908 
254      sca(4,2) =  -0.067430
255
256      IF( ln_rsttr ) THEN
257         IF(lwp) WRITE(numout,*)
258         IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model '
259         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
260         !
261         DO jn = jp_cfc0, jp_cfc1
262            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
263         END DO
264      ENDIF
265      IF(lwp) WRITE(numout,*)
266      !
267   END SUBROUTINE cfc_init
268
269
270   INTEGER FUNCTION trc_sms_cfc_alloc()
271      !!----------------------------------------------------------------------
272      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
273      !!----------------------------------------------------------------------
274      ALLOCATE( xphem   (jpi,jpj)        ,     &
275         &      qtr_cfc (jpi,jpj,jp_cfc) ,     &
276         &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc )
277         !
278      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.')
279      !
280   END FUNCTION trc_sms_cfc_alloc
281
282#else
283   !!----------------------------------------------------------------------
284   !!   Dummy module                                         No CFC tracers
285   !!----------------------------------------------------------------------
286CONTAINS
287   SUBROUTINE trc_sms_cfc( kt )       ! Empty routine
288      WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt
289   END SUBROUTINE trc_sms_cfc
290#endif
291
292   !!======================================================================
293END MODULE trcsms_cfc
Note: See TracBrowser for help on using the repository browser.