Context Navigation

p4zsms.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: 27.3 KB

Line
1	MODULE p4zsms
2	!!======================================================================
3	!! * MODULE p4zsms *
4	!! TOP : PISCES Source Minus Sink manager
5	!!======================================================================
6	!! History : 1.0 ! 2004-03 (O. Aumont) Original code
7	!! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
8	!!----------------------------------------------------------------------
9	!! p4z_sms : Time loop of passive tracers sms
10	!!----------------------------------------------------------------------
11	USE oce_trc ! shared variables between ocean and passive tracers
12	USE trc ! passive tracers common variables
13	USE trcdta !
14	USE sms_pisces ! PISCES Source Minus Sink variables
15	USE p4zbio ! Biological model
16	USE p4zche ! Chemical model
17	USE p4zlys ! Calcite saturation
18	USE p4zflx ! Gas exchange
19	USE p4zbc ! External source of nutrients
20	USE p4zsed ! Sedimentation
21	USE p4zint ! time interpolation
22	USE p4zrem ! remineralisation
23	USE iom ! I/O manager
24	USE trd_oce ! Ocean trends variables
25	USE trdtrc ! TOP trends variables
26	USE sedmodel ! Sediment model
27	USE prtctl_trc ! print control for debugging
28
29	IMPLICIT NONE
30	PRIVATE
31
32	PUBLIC p4z_sms_init ! called in p4zsms.F90
33	PUBLIC p4z_sms ! called in p4zsms.F90
34
35	INTEGER :: numco2, numnut, numnit ! logical unit for co2 budget
36	REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
37	REAL(wp) :: xfact, xfact1, xfact2, xfact3
38
39	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr ! Array used to indicate negative tracer values
40
41	!! * Substitutions
42	# include "do_loop_substitute.h90"
43	!!----------------------------------------------------------------------
44	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
45	!! $Id$
46	!! Software governed by the CeCILL license (see ./LICENSE)
47	!!----------------------------------------------------------------------
48	CONTAINS
49
50	SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs )
51	!!---------------------------------------------------------------------
52	!! * ROUTINE p4z_sms *
53	!!
54	!! ** Purpose : Managment of the call to Biological sources and sinks
55	!! routines of PISCES bio-model
56	!!
57	!! ** Method : - at each new day ...
58	!! - several calls of bio and sed ???
59	!! - ...
60	!!---------------------------------------------------------------------
61	!
62	INTEGER, INTENT( in ) :: kt ! ocean time-step index
63	INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index
64	!!
65	INTEGER :: ji, jj, jk, jnt, jn, jl
66	REAL(wp) :: ztra
67	CHARACTER (len=25) :: charout
68	REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
69	REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: zw3d
70	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace
71
72	!!---------------------------------------------------------------------
73	!
74	IF( ln_timing ) CALL timing_start('p4z_sms')
75	!
76	IF( kt == nittrc000 ) THEN
77	!
78	ALLOCATE( xnegtr(jpi,jpj,jpk) )
79	!
80	IF( .NOT. ln_rsttr ) THEN
81	CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants
82	CALL ahini_for_at( hi, Kbb ) ! set PH at kt=nit000
83	t_oce_co2_flx_cum = 0._wp
84	ELSE
85	CALL p4z_rst( nittrc000, Kbb, Kmm, 'READ' ) !* read or initialize all required fields
86	ENDIF
87	!
88	ENDIF
89	!
90	IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt, Kbb, Kmm ) ! Relaxation of some tracers
91	!
92	rfact = r2dttrc
93	!
94	! trends computation initialisation
95	IF( l_trdtrc ) THEN
96	ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) ) !* store now fields before applying the Asselin filter
97	ztrdt(:,:,:,:) = tr(:,:,:,:,Kmm)
98	ENDIF
99	!
100
101	IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN
102	rfactr = 1. / rfact
103	rfact2 = rfact / REAL( nrdttrc, wp )
104	rfact2r = 1. / rfact2
105	xstep = rfact2 / rday ! Time step duration for biology
106	xfact = 1.e+3 * rfact2r
107	IF(lwp) WRITE(numout,*)
108	IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdt
109	IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
110	IF(lwp) WRITE(numout,*)
111	ENDIF
112
113	IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
114	DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
115	tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm)
116	END DO
117	ENDIF
118	!
119	IF( ll_bc ) CALL p4z_bc( kt, Kbb, Kmm, Krhs ) ! external sources of nutrients
120	!
121	#if ! defined key_sed_off
122	CALL p4z_che( Kbb, Kmm ) ! computation of chemical constants
123	CALL p4z_int( kt, Kbb, Kmm ) ! computation of various rates for biogeochemistry
124	!
125	DO jnt = 1, nrdttrc ! Potential time splitting if requested
126	!
127	CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs ) ! Biology
128	CALL p4z_lys( kt, jnt, Kbb, Krhs ) ! Compute CaCO3 saturation
129	CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs ) ! Surface and Bottom boundary conditions
130	CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs ) ! Compute surface fluxes
131	!
132	xnegtr(:,:,:) = 1.e0
133	DO jn = jp_pcs0, jp_pcs1
134	DO_3D_11_11( 1, jpk )
135	IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN
136	ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn )
137	xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
138	ENDIF
139	END_3D
140	END DO
141	! ! where at least 1 tracer concentration becomes negative
142	! !
143	DO jn = jp_pcs0, jp_pcs1
144	tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs)
145	END DO
146	!
147	IF( iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR. &
148	& iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) ) THEN
149	!
150	ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) )
151	zw3d(:,:,jpk) = 0.
152	DO jk = 1, jpkm1
153	zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
154	ENDDO
155	!
156	zw2d(:,:) = 0.
157	DO jk = 1, jpkm1
158	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs)
159	ENDDO
160	CALL iom_put( 'INTdtAlk', zw2d )
161	!
162	zw2d(:,:) = 0.
163	DO jk = 1, jpkm1
164	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs)
165	ENDDO
166	CALL iom_put( 'INTdtDIC', zw2d )
167	!
168	zw2d(:,:) = 0.
169	DO jk = 1, jpkm1
170	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) )
171	ENDDO
172	CALL iom_put( 'INTdtDIN', zw2d )
173	!
174	zw2d(:,:) = 0.
175	DO jk = 1, jpkm1
176	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs)
177	ENDDO
178	CALL iom_put( 'INTdtDIP', zw2d )
179	!
180	zw2d(:,:) = 0.
181	DO jk = 1, jpkm1
182	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs)
183	ENDDO
184	CALL iom_put( 'INTdtFer', zw2d )
185	!
186	zw2d(:,:) = 0.
187	DO jk = 1, jpkm1
188	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs)
189	ENDDO
190	CALL iom_put( 'INTdtSil', zw2d )
191	!
192	DEALLOCATE( zw3d, zw2d )
193	ENDIF
194	!
195	DO jn = jp_pcs0, jp_pcs1
196	tr(:,:,:,jn,Krhs) = 0._wp
197	END DO
198	!
199	IF( ln_top_euler ) THEN
200	DO jn = jp_pcs0, jp_pcs1
201	tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb)
202	END DO
203	ENDIF
204	END DO
205	!
206	IF( l_trdtrc ) THEN
207	DO jn = jp_pcs0, jp_pcs1
208	ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact2r
209	CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends
210	END DO
211	DEALLOCATE( ztrdt )
212	END IF
213	#endif
214	!
215	IF( ln_sediment ) THEN
216	!
217	CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model
218	!
219	IF( ln_top_euler ) THEN
220	DO jn = jp_pcs0, jp_pcs1
221	tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb)
222	END DO
223	ENDIF
224	!
225	ENDIF
226	!
227	IF( lrst_trc ) CALL p4z_rst( kt, Kbb, Kmm, 'WRITE' ) !* Write PISCES informations in restart file
228	!
229
230	IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking
231
232	IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES
233	!
234	IF( ln_timing ) CALL timing_stop('p4z_sms')
235	!
236	END SUBROUTINE p4z_sms
237
238
239	SUBROUTINE p4z_sms_init
240	!!----------------------------------------------------------------------
241	!! * p4z_sms_init *
242	!!
243	!! ** Purpose : read PISCES namelist
244	!!
245	!! ** input : file 'namelist.trc.s' containing the following
246	!! namelist: natext, natbio, natsms
247	!!----------------------------------------------------------------------
248	INTEGER :: ios ! Local integer output status for namelist read
249	!!
250	NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, wsbio2max, wsbio2scale, &
251	& ldocp, ldocz, lthet, no3rat3, po4rat3
252	!
253	NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
254	NAMELIST/nampismass/ ln_check_mass
255	!!----------------------------------------------------------------------
256	!
257	IF(lwp) THEN
258	WRITE(numout,*)
259	WRITE(numout,*) 'p4z_sms_init : PISCES initialization'
260	WRITE(numout,*) '~~~~~~~~~~~~'
261	ENDIF
262
263	READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
264	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist' )
265	READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
266	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist' )
267	IF(lwm) WRITE( numonp, nampisbio )
268	!
269	IF(lwp) THEN ! control print
270	WRITE(numout,*) ' Namelist : nampisbio'
271	WRITE(numout,*) ' frequency for the biology nrdttrc =', nrdttrc
272	WRITE(numout,*) ' POC sinking speed wsbio =', wsbio
273	WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort
274	IF( ln_p5z ) THEN
275	WRITE(numout,*) ' N/C in zooplankton no3rat3 =', no3rat3
276	WRITE(numout,*) ' P/C in zooplankton po4rat3 =', po4rat3
277	ENDIF
278	WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3
279	WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2
280	WRITE(numout,*) ' Big particles maximum sinking speed wsbio2max =', wsbio2max
281	WRITE(numout,*) ' Big particles sinking speed length scale wsbio2scale =', wsbio2scale
282	IF( ln_ligand ) THEN
283	IF( ln_p4z ) THEN
284	WRITE(numout,*) ' Phyto ligand production per unit doc ldocp =', ldocp
285	WRITE(numout,*) ' Zoo ligand production per unit doc ldocz =', ldocz
286	WRITE(numout,*) ' Proportional loss of ligands due to Fe uptake lthet =', lthet
287	ENDIF
288	ENDIF
289	ENDIF
290
291
292	READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
293	905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist' )
294	READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
295	906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' )
296	IF(lwm) WRITE( numonp, nampisdmp )
297	!
298	IF(lwp) THEN ! control print
299	WRITE(numout,*)
300	WRITE(numout,*) ' Namelist : nampisdmp --- relaxation to GLODAP'
301	WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp
302	WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp
303	ENDIF
304
305	READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
306	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist' )
307	READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
308	908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist' )
309	IF(lwm) WRITE( numonp, nampismass )
310
311	IF(lwp) THEN ! control print
312	WRITE(numout,*)
313	WRITE(numout,*) ' Namelist : nampismass --- mass conservation checking'
314	WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
315	ENDIF
316	!
317	END SUBROUTINE p4z_sms_init
318
319
320	SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw )
321	!!---------------------------------------------------------------------
322	!! * ROUTINE p4z_rst *
323	!!
324	!! ** Purpose : Read or write variables in restart file:
325	!!
326	!! WRITE(READ) mode:
327	!! kt : number of time step since the begining of the experiment at the
328	!! end of the current(previous) run
329	!!---------------------------------------------------------------------
330	INTEGER , INTENT(in) :: kt ! ocean time-step
331	INTEGER , INTENT(in) :: Kbb, Kmm ! time level indices
332	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
333	!!---------------------------------------------------------------------
334	!
335	IF( TRIM(cdrw) == 'READ' ) THEN
336	!
337	IF(lwp) WRITE(numout,*)
338	IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
339	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
340	!
341	IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
342	CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) )
343	ELSE
344	CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants
345	CALL ahini_for_at( hi, Kbb )
346	ENDIF
347	CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
348	IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
349	CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) )
350	ELSE
351	xksimax(:,:) = xksi(:,:)
352	ENDIF
353	!
354	IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN ! cumulative total flux of carbon
355	CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum )
356	ELSE
357	t_oce_co2_flx_cum = 0._wp
358	ENDIF
359	!
360	IF( ln_p5z ) THEN
361	IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN
362	CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sizep(:,:,:) )
363	CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sizen(:,:,:) )
364	CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:) )
365	ELSE
366	sizep(:,:,:) = 1.
367	sizen(:,:,:) = 1.
368	sized(:,:,:) = 1.
369	ENDIF
370	ENDIF
371	!
372	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
373	IF( kt == nitrst ) THEN
374	IF(lwp) WRITE(numout,*)
375	IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file kt =', kt
376	IF(lwp) WRITE(numout,*) '~~~~~~~'
377	ENDIF
378	CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
379	CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
380	CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
381	CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
382	IF( ln_p5z ) THEN
383	CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sizep(:,:,:) )
384	CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sizen(:,:,:) )
385	CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) )
386	ENDIF
387	ENDIF
388	!
389	END SUBROUTINE p4z_rst
390
391
392	SUBROUTINE p4z_dmp( kt, Kbb, Kmm )
393	!!----------------------------------------------------------------------
394	!! * p4z_dmp *
395	!!
396	!! ** purpose : Relaxation of some tracers
397	!!----------------------------------------------------------------------
398	!
399	INTEGER, INTENT( in ) :: kt ! time step
400	INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices
401	!
402	REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
403	REAL(wp) :: po4mean = 2.165 ! mean value of phosphates
404	REAL(wp) :: no3mean = 30.90 ! mean value of nitrate
405	REAL(wp) :: silmean = 91.51 ! mean value of silicate
406	!
407	REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
408	REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
409	!!---------------------------------------------------------------------
410
411	IF(lwp) WRITE(numout,*)
412	IF(lwp) WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
413	IF(lwp) WRITE(numout,*)
414
415	IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca") THEN
416	IF( .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) !
417	! ! --------------------------- !
418	! set total alkalinity, phosphate, nitrate & silicate
419	zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6
420
421	zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:) ) * zarea
422	zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:) ) * zarea * po4r
423	zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:) ) * zarea * rno3
424	zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:) ) * zarea
425
426	IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn
427	tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn
428
429	IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn
430	tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn
431
432	IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn
433	tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn
434
435	IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn
436	tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn )
437	!
438	!
439	IF( .NOT. ln_top_euler ) THEN
440	zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:) ) * zarea
441	zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:) ) * zarea * po4r
442	zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:) ) * zarea * rno3
443	zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:) ) * zarea
444
445	IF(lwp) WRITE(numout,*) ' '
446	IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb
447	tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb
448
449	IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb
450	tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb
451
452	IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb
453	tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb
454
455	IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb
456	tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb )
457	ENDIF
458	ENDIF
459	!
460	ENDIF
461	!
462	END SUBROUTINE p4z_dmp
463
464
465	SUBROUTINE p4z_chk_mass( kt, Kmm )
466	!!----------------------------------------------------------------------
467	!! * ROUTINE p4z_chk_mass *
468	!!
469	!! ** Purpose : Mass conservation check
470	!!
471	!!---------------------------------------------------------------------
472	INTEGER, INTENT( in ) :: kt ! ocean time-step index
473	INTEGER, INTENT( in ) :: Kmm ! time level indices
474	REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
475	CHARACTER(LEN=100) :: cltxt
476	INTEGER :: jk
477	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork
478	!!----------------------------------------------------------------------
479	!
480	IF( kt == nittrc000 ) THEN
481	xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr
482	xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr
483	xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s
484	IF( ln_check_mass .AND. lwp) THEN ! Open budget file of NO3, ALK, Si, Fer
485	CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
486	CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
487	CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
488	cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron'
489	IF( lwp ) WRITE(numnut,*) TRIM(cltxt)
490	IF( lwp ) WRITE(numnut,*)
491	ENDIF
492	ENDIF
493
494	IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
495	! Compute the budget of NO3, ALK, Si, Fer
496	IF( ln_p4z ) THEN
497	zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) &
498	& + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
499	& + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
500	& + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
501	ELSE
502	zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm) &
503	& + tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm) &
504	& + tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm) &
505	& + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3
506	ENDIF
507	!
508	no3budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
509	no3budget = no3budget / areatot
510	CALL iom_put( "pno3tot", no3budget )
511	ENDIF
512	!
513	IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
514	IF( ln_p4z ) THEN
515	zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) &
516	& + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
517	& + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
518	& + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
519	ELSE
520	zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm) &
521	& + tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm) &
522	& + tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm) &
523	& + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3
524	ENDIF
525	!
526	po4budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
527	po4budget = po4budget / areatot
528	CALL iom_put( "ppo4tot", po4budget )
529	ENDIF
530	!
531	IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
532	zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)
533	!
534	silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
535	silbudget = silbudget / areatot
536	CALL iom_put( "psiltot", silbudget )
537	ENDIF
538	!
539	IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
540	zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.
541	!
542	alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) !
543	alkbudget = alkbudget / areatot
544	CALL iom_put( "palktot", alkbudget )
545	ENDIF
546	!
547	IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
548	zwork(:,:,:) = tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm) &
549	& + tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm) &
550	& + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * ferat3
551	!
552	ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
553	ferbudget = ferbudget / areatot
554	CALL iom_put( "pfertot", ferbudget )
555	ENDIF
556	!
557	! Global budget of N SMS : denitrification in the water column and in the sediment
558	! nitrogen fixation by the diazotrophs
559	! --------------------------------------------------------------------------------
560	IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
561	znitrpottot = glob_sum ( 'p4zsms', nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
562	CALL iom_put( "tnfix" , znitrpottot * xfact3 ) ! Global nitrogen fixation molC/l to molN/m3
563	ENDIF
564	!
565	IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
566	zrdenittot = glob_sum ( 'p4zsms', denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
567	zsdenittot = glob_sum ( 'p4zsms', sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) )
568	CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 ) ! Total denitrification molC/l to molN/m3
569	ENDIF
570	!
571	IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
572	t_atm_co2_flx = t_atm_co2_flx / glob_sum( 'p4zsms', e1e2t(:,:) )
573	t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 )
574	tpp = tpp * 1000. * xfact1
575	t_oce_co2_exp = t_oce_co2_exp * 1000. * xfact1
576	IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
577	IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget * 1.e+06, &
578	& no3budget * rno3 * 1.e+06, &
579	& po4budget * po4r * 1.e+06, &
580	& silbudget * 1.e+06, &
581	& ferbudget * 1.e+09
582	!
583	IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2 , &
584	& zrdenittot * xfact2 , &
585	& zsdenittot * xfact2
586	ENDIF
587	!
588	9000 FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
589	9100 FORMAT(i8,5e18.10)
590	9200 FORMAT(i8,3f10.5)
591	!
592	END SUBROUTINE p4z_chk_mass
593
594	!!======================================================================
595	END MODULE p4zsms

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/PISCES/P4Z/p4zsms.F90 @ 12377

Download in other formats: