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.

p4zsms.F90 in NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zsms.F90 @ 14276

Last change on this file since 14276 was 14276, checked in by aumont, 3 years ago
numerous updates to PISCES, PISCES-QUOTA and the sediment module
Property svn:keywords set to `Id`
File size: 28.4 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 p4zsbc ! 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 trcini_pisces.F90
33	PUBLIC p4z_sms ! called in trcsms_pisces.F90
34
35	INTEGER :: numco2, numnut, numnit ! logical unit for co2 budget
36	REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget ! total budget of the different conservative elements
37	REAL(wp) :: xfact1, xfact2, xfact3
38
39	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr ! Array used to indicate negative tracer values
40
41	!!----------------------------------------------------------------------
42	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
43	!! $Id$
44	!! Software governed by the CeCILL license (see ./LICENSE)
45	!!----------------------------------------------------------------------
46	CONTAINS
47
48	SUBROUTINE p4z_sms( kt )
49	!!---------------------------------------------------------------------
50	!! * ROUTINE p4z_sms *
51	!!
52	!! ** Purpose : Managment of the call to Biological sources and sinks
53	!! routines of PISCES bio-model
54	!!
55	!! ** Method : - calls the various SMS subroutines
56	!! - calls the sediment module (if ln_sediment)
57	!! - several calls of bio and sed (possible time-splitting)
58	!! - handles the potential negative concentrations (xnegtr)
59	!!---------------------------------------------------------------------
60	!
61	INTEGER, INTENT( in ) :: kt ! ocean time-step index
62	!!
63	INTEGER :: ji, jj, jk, jnt, jn, jl
64	REAL(wp) :: ztra
65	CHARACTER (len=25) :: charout
66	REAL(wp), DIMENSION(jpi,jpj,jpk,jp_pisces) :: ztrbbio
67	!!---------------------------------------------------------------------
68	!
69	IF( ln_timing ) CALL timing_start('p4z_sms')
70	!
71	IF( kt == nittrc000 ) THEN
72	!
73	ALLOCATE( xnegtr(jpi,jpj,jpk) )
74	!
75	IF( .NOT. ln_rsttr ) THEN
76	CALL p4z_che ! initialize the chemical constants
77	CALL ahini_for_at(hi) ! set PH at kt=nit000
78	t_oce_co2_flx_cum = 0._wp
79	ELSE
80	CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields
81	ENDIF
82	!
83	ENDIF
84	!
85	IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers
86	!
87	rfact = r2dttrc ! time step of PISCES
88	!
89	IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
90	rfactr = 1. / rfact ! inverse of the time step
91	rfact2 = rfact / REAL( nrdttrc, wp ) ! time step of the biological SMS
92	rfact2r = 1. / rfact2 ! Inverse of the biological time step
93	xstep = rfact2 / rday ! Time step duration for biology relative to a day
94	IF(lwp) WRITE(numout,*)
95	IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdt
96	IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
97	IF(lwp) WRITE(numout,*)
98	ENDIF
99
100	IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
101	DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
102	trb(:,:,:,jn) = trn(:,:,:,jn)
103	END DO
104	ENDIF
105
106	DO jn = jp_pcs0, jp_pcs1 ! Store the tracer concentrations before entering PISCES
107	ztrbbio(:,:,:,jn) = trb(:,:,:,jn)
108	END DO
109	!
110	IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients
111	!
112	#if ! defined key_sed_off
113	CALL p4z_che ! computation of chemical constants
114	CALL p4z_int( kt ) ! computation of various rates for biogeochemistry
115	!
116	DO jnt = 1, nrdttrc ! Potential time splitting if requested
117	!
118	CALL p4z_bio( kt, jnt ) ! Biological SMS
119	CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation and dissolution
120	CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions
121	CALL p4z_flx( kt, jnt ) ! Compute surface air-sea fluxes
122	!
123	! Handling of the negative concentrations
124	! The biological SMS may generate negative concentrations
125	! Trends are tested at each grid cell. If a negative concentrations
126	! is created at a grid cell, all the sources and sinks at that grid
127	! cell are scale to avoid that negative concentration. This approach
128	! is quite simplistic but it conserves mass.
129	! ------------------------------------------------------------------
130	xnegtr(:,:,:) = 1.e0
131	DO jn = jp_pcs0, jp_pcs1
132	DO jk = 1, jpk
133	DO jj = 1, jpj
134	DO ji = 1, jpi
135	IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
136	ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
137	xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
138	ENDIF
139	END DO
140	END DO
141	END DO
142	END DO
143	! ! where at least 1 tracer concentration becomes negative
144	! !
145	! Concentrations are updated
146	DO jn = jp_pcs0, jp_pcs1
147	trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
148	END DO
149	!
150	! Trends are are reset to 0
151	DO jn = jp_pcs0, jp_pcs1
152	tra(:,:,:,jn) = 0._wp
153	END DO
154	!
155	END DO
156	!
157	#endif
158	!
159	! If ln_sediment is set to .true. then the sediment module is called
160	IF( ln_sediment ) THEN
161	!
162	CALL sed_model( kt ) ! Main program of Sediment model
163	!
164	ENDIF
165	!
166	!
167	DO jn = jp_pcs0, jp_pcs1
168	tra(:,:,:,jn) = ( trb(:,:,:,jn) - ztrbbio(:,:,:,jn) ) * rfactr
169	trb(:,:,:,jn) = ztrbbio(:,:,:,jn)
170	ztrbbio(:,:,:,jn) = 0._wp
171	END DO
172	!
173	IF( l_trdtrc ) THEN
174	DO jn = jp_pcs0, jp_pcs1
175	CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends
176	END DO
177	END IF
178	!
179	IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' ) !* Write PISCES informations in restart file
180	!
181
182	IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt ) ! Mass conservation checking
183
184	IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES
185	!
186	IF( ln_timing ) CALL timing_stop('p4z_sms')
187	!
188	END SUBROUTINE p4z_sms
189
190
191	SUBROUTINE p4z_sms_init
192	!!----------------------------------------------------------------------
193	!! * p4z_sms_init *
194	!!
195	!! ** Purpose : read the general PISCES namelist
196	!!
197	!! ** input : file 'namelist_pisces' containing the following
198	!! namelist: nampisbio, nampisdmp, nampismass
199	!!----------------------------------------------------------------------
200	INTEGER :: ios ! Local integer output status for namelist read
201	!!
202	NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, feratz, feratm, wsbio2, wsbio2max, &
203	& wsbio2scale, ldocp, ldocz, lthet, no3rat3, po4rat3
204	!
205	NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
206	NAMELIST/nampismass/ ln_check_mass
207	!!----------------------------------------------------------------------
208	!
209	IF(lwp) THEN
210	WRITE(numout,*)
211	WRITE(numout,*) 'p4z_sms_init : PISCES initialization'
212	WRITE(numout,*) '~~~~~~~~~~~~'
213	ENDIF
214
215	REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables
216	READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
217	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist' )
218	REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables
219	READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
220	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist' )
221	IF(lwm) WRITE( numonp, nampisbio )
222	!
223	IF(lwp) THEN ! control print
224	WRITE(numout,*) ' Namelist : nampisbio'
225	WRITE(numout,*) ' frequency for the biology nrdttrc =', nrdttrc
226	WRITE(numout,*) ' POC sinking speed wsbio =', wsbio
227	WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort
228	IF( ln_p5z ) THEN
229	WRITE(numout,*) ' N/C in zooplankton no3rat3 =', no3rat3
230	WRITE(numout,*) ' P/C in zooplankton po4rat3 =', po4rat3
231	ENDIF
232	WRITE(numout,*) ' Fe/C in microzooplankton feratz =', feratz
233	WRITE(numout,*) ' Fe/C in microzooplankton feratz =', feratm
234	WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2
235	WRITE(numout,*) ' Big particles maximum sinking speed wsbio2max =', wsbio2max
236	WRITE(numout,*) ' Big particles sinking speed length scale wsbio2scale =', wsbio2scale
237	IF( ln_ligand ) THEN
238	IF( ln_p4z ) THEN
239	WRITE(numout,*) ' Phyto ligand production per unit doc ldocp =', ldocp
240	WRITE(numout,*) ' Zoo ligand production per unit doc ldocz =', ldocz
241	WRITE(numout,*) ' Proportional loss of ligands due to Fe uptake lthet =', lthet
242	ENDIF
243	ENDIF
244	ENDIF
245
246
247	REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping
248	READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
249	905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist' )
250	REWIND( numnatp_cfg ) ! Namelist nampisdmp in configuration namelist : Pisces damping
251	READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
252	906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' )
253	IF(lwm) WRITE( numonp, nampisdmp )
254	!
255	IF(lwp) THEN ! control print
256	WRITE(numout,*)
257	WRITE(numout,*) ' Namelist : nampisdmp --- relaxation to GLODAP'
258	WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp
259	WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp
260	ENDIF
261
262	REWIND( numnatp_ref ) ! Namelist nampismass in reference namelist : Pisces mass conservation check
263	READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
264	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist' )
265	REWIND( numnatp_cfg ) ! Namelist nampismass in configuration namelist : Pisces mass conservation check
266	READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
267	908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist' )
268	IF(lwm) WRITE( numonp, nampismass )
269
270	IF(lwp) THEN ! control print
271	WRITE(numout,*)
272	WRITE(numout,*) ' Namelist : nampismass --- mass conservation checking'
273	WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
274	ENDIF
275	!
276	END SUBROUTINE p4z_sms_init
277
278
279	SUBROUTINE p4z_rst( kt, cdrw )
280	!!---------------------------------------------------------------------
281	!! * ROUTINE p4z_rst *
282	!!
283	!! ** Purpose : Read or write specific PISCES variables in restart file:
284	!!
285	!! WRITE(READ) mode:
286	!! kt : number of time step since the begining of the experiment at the
287	!! end of the current(previous) run
288	!!---------------------------------------------------------------------
289	INTEGER , INTENT(in) :: kt ! ocean time-step
290	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
291	!!---------------------------------------------------------------------
292	!
293	IF( TRIM(cdrw) == 'READ' ) THEN
294	!
295	! Read the specific variable of PISCES
296	IF(lwp) WRITE(numout,*)
297	IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
298	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
299	!
300	! Read the pH. If not in the restart file, then it is initialized from
301	! the initial conditions
302	IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
303	CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) )
304	ELSE
305	CALL p4z_che ! initialize the chemical constants
306	CALL ahini_for_at(hi)
307	ENDIF
308
309	! Read the Si half saturation constant and the maximum Silica concentration
310	CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
311	IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
312	CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) )
313	ELSE
314	xksimax(:,:) = xksi(:,:)
315	ENDIF
316
317	! Read the Fe3 consumption term by phytoplankton
318	IF( iom_varid( numrtr, 'Consfe3', ldstop = .FALSE. ) > 0 ) THEN
319	CALL iom_get( numrtr, jpdom_autoglo, 'Consfe3' , consfe3(:,:,:) )
320	ELSE
321	consfe3(:,:,:) = 0._wp
322	ENDIF
323
324
325	! Read the cumulative total flux. If not in the restart file, it is set to 0
326	IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN ! cumulative total flux of carbon
327	CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum )
328	ELSE
329	t_oce_co2_flx_cum = 0._wp
330	ENDIF
331	!
332	! PISCES size proxy
333	IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN
334	CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:) )
335	ELSE
336	sized(:,:,:) = 1.
337	ENDIF
338	sized(:,:,:) = MAX( 1.0, sized(:,:,:) )
339	IF( iom_varid( numrtr, 'sizen', ldstop = .FALSE. ) > 0 ) THEN
340	CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sizen(:,:,:) )
341	ELSE
342	sizen(:,:,:) = 1.
343	ENDIF
344	sizen(:,:,:) = MAX( 1.0, sizen(:,:,:) )
345
346	! PISCES-QUOTA specific part
347	IF( ln_p5z ) THEN
348	! Read the size of the different phytoplankton groups
349	! If not in the restart file, they are set to 1
350	IF( iom_varid( numrtr, 'sizep', ldstop = .FALSE. ) > 0 ) THEN
351	CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sizep(:,:,:) )
352	sizep(:,:,:) = MAX( 1.0, sizep(:,:,:) )
353	ELSE
354	sizep(:,:,:) = 1.
355	ENDIF
356	ENDIF
357	!
358	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
359	! write the specific variables of PISCES
360	IF( kt == nitrst ) THEN
361	IF(lwp) WRITE(numout,*)
362	IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file kt =', kt
363	IF(lwp) WRITE(numout,*) '~~~~~~~'
364	ENDIF
365	CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) ! pH
366	CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) ! Si 1/2 saturation constant
367	CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) ! Si max concentration
368	CALL iom_rstput( kt, nitrst, numrtw, 'Consfe3', consfe3(:,:,:) ) ! Si max concentration
369	CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) ! Cumulative CO2 flux
370	CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sizen(:,:,:) ) ! Size of nanophytoplankton
371	CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) ) ! Size of diatoms
372	IF( ln_p5z ) THEN
373	CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sizep(:,:,:) ) ! Size of picophytoplankton
374	ENDIF
375	ENDIF
376	!
377	END SUBROUTINE p4z_rst
378
379
380	SUBROUTINE p4z_dmp( kt )
381	!!----------------------------------------------------------------------
382	!! * p4z_dmp *
383	!!
384	!! ** purpose : Relaxation of the total budget of some elements
385	!! This routine avoids the model to drift far from the
386	!! observed content in various elements
387	!! Elements that may be relaxed : Alk, P, N, Si
388	!!----------------------------------------------------------------------
389	!
390	INTEGER, INTENT( in ) :: kt ! time step
391	!
392	REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
393	REAL(wp) :: po4mean = 2.174 ! mean value of phosphate
394	REAL(wp) :: no3mean = 31.00 ! mean value of nitrate
395	REAL(wp) :: silmean = 90.33 ! mean value of silicate
396	!
397	REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
398	REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
399	!!---------------------------------------------------------------------
400
401	IF(lwp) WRITE(numout,*)
402	IF(lwp) WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
403	IF(lwp) WRITE(numout,*)
404
405	IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca") THEN
406	IF( .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) !
407	! ! --------------------------- !
408	! set total alkalinity, phosphate, nitrate & silicate
409	zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6
410
411	zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea
412	zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
413	zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
414	zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
415
416	! Correct the trn mean content of alkalinity
417	IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn
418	trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
419
420	! Correct the trn mean content of PO4
421	IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn
422	trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
423
424	! Correct the trn mean content of NO3
425	IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn
426	trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
427
428	! Correct the trn mean content of SiO3
429	IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn
430	trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
431	!
432	!
433	IF( .NOT. ln_top_euler ) THEN
434	zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea
435	zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
436	zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
437	zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
438
439	IF(lwp) WRITE(numout,*) ' '
440	! Correct the trb mean content of alkalinity
441	IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb
442	trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
443
444	! Correct the trb mean content of PO4
445	IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb
446	trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
447
448	! Correct the trb mean content of NO3
449	IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb
450	trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
451
452	! Correct the trb mean content of SiO3
453	IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb
454	trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
455	ENDIF
456	ENDIF
457	!
458	ENDIF
459	!
460	END SUBROUTINE p4z_dmp
461
462
463	SUBROUTINE p4z_chk_mass( kt )
464	!!----------------------------------------------------------------------
465	!! * ROUTINE p4z_chk_mass *
466	!!
467	!! ** Purpose : Mass conservation check
468	!!
469	!!---------------------------------------------------------------------
470	INTEGER, INTENT( in ) :: kt ! ocean time-step index
471	REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
472	CHARACTER(LEN=100) :: cltxt
473	INTEGER :: jk
474	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork
475	!!----------------------------------------------------------------------
476	!
477	IF( kt == nittrc000 ) THEN
478	xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr
479	xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr
480	xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s
481	IF( ln_check_mass .AND. lwp) THEN ! Open budget file of NO3, ALK, Si, Fer
482	CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
483	CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
484	CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
485	cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron'
486	IF( lwp ) WRITE(numnut,*) TRIM(cltxt)
487	IF( lwp ) WRITE(numnut,*)
488	ENDIF
489	ENDIF
490
491	! Compute the budget of NO3
492	IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
493	IF( ln_p4z ) THEN
494	zwork(:,:,:) = trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) &
495	& + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
496	& + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &
497	& + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)
498	ELSE
499	zwork(:,:,:) = trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) &
500	& + trn(:,:,:,jpndi) + trn(:,:,:,jpnpi) &
501	& + trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) &
502	& + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3
503	ENDIF
504	!
505	no3budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
506	no3budget = no3budget / areatot
507	CALL iom_put( "pno3tot", no3budget )
508	ENDIF
509	!
510	! Compute the budget of PO4
511	IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
512	IF( ln_p4z ) THEN
513	zwork(:,:,:) = trn(:,:,:,jppo4) &
514	& + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
515	& + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &
516	& + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)
517	ELSE
518	zwork(:,:,:) = trn(:,:,:,jppo4) + trn(:,:,:,jppph) &
519	& + trn(:,:,:,jppdi) + trn(:,:,:,jpppi) &
520	& + trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) &
521	& + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3
522	ENDIF
523	!
524	po4budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
525	po4budget = po4budget / areatot
526	CALL iom_put( "ppo4tot", po4budget )
527	ENDIF
528	!
529	! Compute the budget of SiO3
530	IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
531	zwork(:,:,:) = trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)
532	!
533	silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
534	silbudget = silbudget / areatot
535	CALL iom_put( "psiltot", silbudget )
536	ENDIF
537	!
538	IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
539	zwork(:,:,:) = trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.
540	!
541	alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) !
542	alkbudget = alkbudget / areatot
543	CALL iom_put( "palktot", alkbudget )
544	ENDIF
545	!
546	! Compute the budget of Iron
547	IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
548	zwork(:,:,:) = trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) &
549	& + trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe) &
550	& + trn(:,:,:,jpzoo) * feratz + trn(:,:,:,jpmes) * feratm
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.

Download in other formats: