Context Navigation

trcsms_cfc.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

File size: 13.2 KB

Line
1	MODULE 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	!! * Substitutions
50	# include "do_loop_substitute.h90"
51	!!----------------------------------------------------------------------
52	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
53	!! $Id$
54	!! Software governed by the CeCILL license (see ./LICENSE)
55	!!----------------------------------------------------------------------
56	CONTAINS
57
58	SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs )
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	!!----------------------------------------------------------------------
74	INTEGER, INTENT(in) :: kt ! ocean time-step index
75	INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level
76	!
77	INTEGER :: ji, jj, jn, jl, jm
78	INTEGER :: iyear_beg, iyear_end
79	INTEGER :: im1, im2, ierr
80	REAL(wp) :: ztap, zdtap
81	REAL(wp) :: zt1, zt2, zt3, zt4, zv2
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
87	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpatm ! atmospheric function
88	!!----------------------------------------------------------------------
89	!
90	IF( ln_timing ) CALL timing_start('trc_sms_cfc')
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
95	ENDIF
96
97	IF( kt == nittrc000 ) CALL cfc_init
98
99	! Temporal interpolation
100	! ----------------------
101	iyear_beg = nyear - 1900
102	IF ( nmonth <= 6 ) THEN
103	iyear_beg = iyear_beg - 1
104	im1 = 6 - nmonth + 1
105	im2 = 6 + nmonth - 1
106	ELSE
107	im1 = 12 - nmonth + 7
108	im2 = nmonth - 7
109	ENDIF
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	!
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) = ( atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp) &
123	& + atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12.
124	END DO
125
126	! !------------!
127	DO_2D_11_11
128
129	! space interpolation
130	zpp_cfc = xphem(ji,jj) * zpatm(1,jl) &
131	& + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
132
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
154
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)
159
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)
166
167	! cumulation of surface flux at each time step
168	qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
169	! !----------------!
170	END_2D
171	! !----------------!
172	END DO ! end CFC loop !
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,*) '~~~~'
179	jl = 0
180	DO jn = jp_cfc0, jp_cfc1
181	jl = jl + 1
182	CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
183	END DO
184	ENDIF
185	!
186	IF( lk_iomput ) THEN
187	jl = 0
188	DO jn = jp_cfc0, jp_cfc1
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) )
192	ENDDO
193	END IF
194	!
195	IF( l_trdtrc ) THEN
196	DO jn = jp_cfc0, jp_cfc1
197	CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends
198	END DO
199	END IF
200	!
201	IF( ln_timing ) CALL timing_stop('trc_sms_cfc')
202	!
203	END SUBROUTINE trc_sms_cfc
204
205
206	SUBROUTINE cfc_init
207	!!---------------------------------------------------------------------
208	!! * cfc_init *
209	!!
210	!! ** Purpose : sets constants for CFC model
211	!!---------------------------------------------------------------------
212	INTEGER :: jn, jl !
213	!!----------------------------------------------------------------------
214	!
215	jn = 0
216	! coefficient for CFC11
217	!----------------------
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
225
226	sob(1,jn) = -0.142382
227	sob(2,jn) = 0.091459
228	sob(3,jn) = -0.0157274
229
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
236
237	! atm. concentration
238	atm_cfc(:,:,jn) = p_cfc(:,:,1)
239	endif
240
241	! coefficient for CFC12
242	!----------------------
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
250
251	sob(1,jn) = -0.143566
252	sob(2,jn) = 0.091015
253	sob(3,jn) = -0.0153924
254
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
261
262	! atm. concentration
263	atm_cfc(:,:,jn) = p_cfc(:,:,2)
264	endif
265
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
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	!
296	jl = 0
297	DO jn = jp_cfc0, jp_cfc1
298	jl = jl + 1
299	CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
300	END DO
301	ENDIF
302	IF(lwp) WRITE(numout,*)
303	!
304	END SUBROUTINE cfc_init
305
306
307	INTEGER FUNCTION trc_sms_cfc_alloc()
308	!!----------------------------------------------------------------------
309	!! * ROUTINE trc_sms_cfc_alloc *
310	!!----------------------------------------------------------------------
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 )
315	!
316	IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_sms_cfc_alloc : failed to allocate arrays.' )
317	!
318	END FUNCTION trc_sms_cfc_alloc
319
320	!!======================================================================
321	END MODULE trcsms_cfc

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

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

Download in other formats: