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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90 @ 2690

Last change on this file since 2690 was 2690, checked in by gm, 13 years ago

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

  • Property svn:keywords set to Id
File size: 11.7 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   !!   trc_cfc_cst  :  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 trdmod_oce
21   USE trdmod_trc
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 ::   jpyear = 150   ! temporal parameter
31   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
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   INTEGER , PUBLIC    ::   npyear         ! Number of years read in CFC1112 file
36   
37   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2    )      ::   p_cfc    ! partial hemispheric pressure for CFC
38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux
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 "top_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      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
78      USE wrk_nemo, ONLY:   ztrcfc => wrk_3d_1        ! use for CFC sms trend
79      !
80      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
81      !
82      INTEGER  ::   ji, jj, jn, jl, jm, js
83      INTEGER  ::   iyear_beg, iyear_end
84      INTEGER  ::   im1, im2
85      REAL(wp) ::   ztap, zdtap       
86      REAL(wp) ::   zt1, zt2, zt3, zv2
87      REAL(wp) ::   zsol      ! solubility
88      REAL(wp) ::   zsch      ! schmidt number
89      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
90      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
91      REAL(wp) ::   zak_cfc   ! transfert coefficients
92      REAL(wp), DIMENSION(jphem,jp_cfc) ::   zpatm   ! atmospheric function
93      !!----------------------------------------------------------------------
94      !
95      IF( wrk_in_use(3, 1) ) THEN
96         CALL ctl_stop('trc_sms_cfc: requested workspace array unavailable')   ;   RETURN
97      ENDIF
98
99      IF( kt == nit000 )   CALL trc_cfc_cst
100
101      ! Temporal interpolation
102      ! ----------------------
103      iyear_beg = nyear - 1900
104      IF ( nmonth <= 6 ) THEN
105         iyear_beg = iyear_beg - 1
106         im1       =  6 - nmonth + 1
107         im2       =  6 + nmonth - 1
108      ELSE
109         im1       = 12 - nmonth + 7
110         im2       =      nmonth - 7
111      ENDIF
112      iyear_end = iyear_beg + 1
113
114      !                                                  !------------!
115      DO jl = 1, jp_cfc                                  !  CFC loop  !
116         !                                               !------------!
117         jn = jp_cfc0 + jl - 1
118         ! time interpolation at time kt
119         DO jm = 1, jphem
120            zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  &
121               &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12.
122         END DO
123         
124         !                                                         !------------!
125         DO jj = 1, jpj                                            !  i-j loop  !
126            DO ji = 1, jpi                                         !------------!
127 
128               ! space interpolation
129               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
130                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
131
132               ! Computation of concentration at equilibrium : in picomol/l
133               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
134               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
135                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
136                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
137                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
138                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 
139               ELSE
140                  zsol  = 0.e0
141               ENDIF
142               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv   
143               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 
144               ! concentration at equilibrium
145               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
146 
147               ! Computation of speed transfert
148               !    Schmidt number
149               zt1  = tsn(ji,jj,1,jp_tem)
150               zt2  = zt1 * zt1 
151               zt3  = zt1 * zt2
152               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3
153
154               !    speed transfert : formulae of wanninkhof 1992
155               zv2     = wndm(ji,jj) * wndm(ji,jj)
156               zsch    = zsch / 660.
157               zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
158
159               ! Input function  : speed *( conc. at equil - concen at surface )
160               ! trn in pico-mol/l idem qtr; ak in en m/s
161               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
162#if defined key_degrad
163                  &                         * facvol(ji,jj,1)                           &
164#endif
165                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
166
167               ! Add the surface flux to the trend
168               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1) 
169
170               ! cumulation of surface flux at each time step
171               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
172               !                                               !----------------!
173            END DO                                             !  end i-j loop  !
174         END DO                                                !----------------!
175         !                                                  !----------------!
176      END DO                                                !  end CFC loop  !
177      !                                                     !----------------!
178
179#if defined key_diatrc 
180      ! Save diagnostics , just for CFC11
181# if  defined key_iomput
182      CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
183      CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
184# else
185      trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1)
186      trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1)
187# endif
188#endif
189
190      IF( l_trdtrc ) THEN
191          DO jn = jp_cfc0, jp_cfc1
192            ztrcfc(:,:,:) = tra(:,:,:,jn)
193            CALL trd_mod_trc( ztrcfc, jn, jptra_trd_sms, kt )   ! save trends
194          END DO
195      END IF
196      !
197      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_cfc: failed to release workspace array')
198      !
199   END SUBROUTINE trc_sms_cfc
200
201
202   SUBROUTINE trc_cfc_cst
203      !!---------------------------------------------------------------------
204      !!                     ***  trc_cfc_cst  *** 
205      !!
206      !! ** Purpose : sets constants for CFC model
207      !!---------------------------------------------------------------------
208
209      ! coefficient for CFC11
210      !----------------------
211
212      ! Solubility
213      soa(1,1) = -229.9261 
214      soa(2,1) =  319.6552
215      soa(3,1) =  119.4471
216      soa(4,1) =  -1.39165
217
218      sob(1,1) =  -0.142382
219      sob(2,1) =   0.091459
220      sob(3,1) =  -0.0157274
221
222      ! Schmidt number
223      sca(1,1) = 3501.8
224      sca(2,1) = -210.31
225      sca(3,1) =  6.1851
226      sca(4,1) = -0.07513
227
228      ! coefficient for CFC12
229      !----------------------
230
231      ! Solubility
232      soa(1,2) = -218.0971
233      soa(2,2) =  298.9702
234      soa(3,2) =  113.8049
235      soa(4,2) =  -1.39165
236
237      sob(1,2) =  -0.143566
238      sob(2,2) =   0.091015
239      sob(3,2) =  -0.0153924
240
241      ! schmidt number
242      sca(1,2) =  3845.4 
243      sca(2,2) =  -228.95
244      sca(3,2) =  6.1908 
245      sca(4,2) =  -0.067430
246
247   END SUBROUTINE trc_cfc_cst
248
249
250   INTEGER FUNCTION trc_sms_cfc_alloc()
251      !!----------------------------------------------------------------------
252      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
253      !!----------------------------------------------------------------------
254      ALLOCATE( xphem   (jpi,jpj)        ,     &
255         &      qtr_cfc (jpi,jpj,jp_cfc) ,     &
256         &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc )
257         !
258      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.')
259      !
260   END FUNCTION trc_sms_cfc_alloc
261
262#else
263   !!----------------------------------------------------------------------
264   !!   Dummy module                                         No CFC tracers
265   !!----------------------------------------------------------------------
266CONTAINS
267   SUBROUTINE trc_sms_cfc( kt )       ! Empty routine
268      WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt
269   END SUBROUTINE trc_sms_cfc
270#endif
271
272   !!======================================================================
273END MODULE trcsms_cfc
Note: See TracBrowser for help on using the repository browser.