Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

p4zsms.F90 @ 15548

Last change on this file since 15548 was 15548, checked in by gsamson, 3 years ago
update branch to the head of the trunk (r15547); ticket #2632
Property svn:keywords set to `Id`
File size: 30.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 sms_pisces ! PISCES Source Minus Sink variables
14	USE p4zbio ! Biological model
15	USE p4zche ! Chemical model
16	USE p4zlys ! Calcite saturation
17	USE p4zflx ! Gas exchange
18	USE p4zbc ! External source of nutrients
19	USE p4zsed ! Sedimentation
20	USE p4zint ! time interpolation
21	USE p4zrem ! remineralisation
22	USE iom ! I/O manager
23	USE trd_oce ! Ocean trends variables
24	USE trdtrc ! TOP trends variables
25	USE sedmodel ! Sediment model
26	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
27	USE prtctl ! 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) :: 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	# include "domzgr_substitute.h90"
44	!!----------------------------------------------------------------------
45	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
46	!! $Id$
47	!! Software governed by the CeCILL license (see ./LICENSE)
48	!!----------------------------------------------------------------------
49	CONTAINS
50
51	SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs )
52	!!---------------------------------------------------------------------
53	!! * ROUTINE p4z_sms *
54	!!
55	!! ** Purpose : Managment of the call to Biological sources and sinks
56	!! routines of PISCES bio-model
57	!!
58	!! ** Method : - calls the various SMS subroutines
59	!! - calls the sediment module (if ln_sediment)
60	!! - several calls of bio and sed (possible time-splitting)
61	!! - handles the potential negative concentrations (xnegtr)
62	!!---------------------------------------------------------------------
63	!
64	INTEGER, INTENT( in ) :: kt ! ocean time-step index
65	INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index
66	!!
67	INTEGER :: ji, jj, jk, jnt, jn, jl
68	REAL(wp) :: ztra
69	CHARACTER (len=25) :: charout
70	REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
71	REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: zw3d
72	REAL(wp), DIMENSION(jpi,jpj,jpk,jp_pisces) :: ztrbbio
73
74	!!---------------------------------------------------------------------
75	!
76	IF( ln_timing ) CALL timing_start('p4z_sms')
77	!
78	IF( kt == nittrc000 ) THEN
79	!
80	ALLOCATE( xnegtr(jpi,jpj,jpk) )
81	!
82	IF( .NOT. ln_rsttr ) THEN
83	CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants
84	CALL ahini_for_at( hi, Kbb ) ! set PH at kt=nit000
85	t_oce_co2_flx_cum = 0._wp
86	ELSE
87	CALL p4z_rst( nittrc000, Kbb, Kmm, 'READ' ) !* read or initialize all required fields
88	ENDIF
89	!
90	ENDIF
91	!
92	IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt, Kbb, Kmm ) ! Relaxation of some tracers
93	!
94	rfact = rDt_trc ! time step of PISCES
95	!
96	IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN
97	rfactr = 1. / rfact ! inverse of the time step
98	rfact2 = rfact / REAL( nrdttrc, wp ) ! time step of the biological SMS
99	rfact2r = 1. / rfact2 ! Inverse of the biological time step
100	xstep = rfact2 / rday ! Time step duration for biology relative to a day
101	xfact = 1.e+3 * rfact2r
102	IF(lwp) WRITE(numout,*)
103	IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rn_Dt = ', rn_Dt
104	IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
105	IF(lwp) WRITE(numout,*)
106	ENDIF
107
108	IF( l_1st_euler .OR. ln_top_euler ) THEN
109	DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
110	tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm)
111	END DO
112	ENDIF
113
114	DO jn = jp_pcs0, jp_pcs1 ! Store the tracer concentrations before entering PISCES
115	ztrbbio(:,:,:,jn) = tr(:,:,:,jn,Kbb)
116	END DO
117
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	IF( nn_hls > 1 ) CALL lbc_lnk( 'p4zsms', hmld(:,:), 'T', 1._wp ) ! hmld defined only on first halo in zdfmxl
126	!
127	DO jnt = 1, nrdttrc ! Potential time splitting if requested
128	!
129	CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs ) ! Biology
130	CALL p4z_lys( kt, jnt, Kbb, Krhs ) ! Compute CaCO3 saturation
131	CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs ) ! Surface and Bottom boundary conditions
132	CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs ) ! Compute surface fluxes
133	!
134	! Handling of the negative concentrations
135	! The biological SMS may generate negative concentrations
136	! Trends are tested at each grid cell. If a negative concentrations
137	! is created at a grid cell, all the sources and sinks at that grid
138	! cell are scale to avoid that negative concentration. This approach
139	! is quite simplistic but it conserves mass.
140	! ------------------------------------------------------------------
141	xnegtr(:,:,:) = 1.e0
142	DO jn = jp_pcs0, jp_pcs1
143	DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk)
144	IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN
145	ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn )
146	xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
147	ENDIF
148	END_3D
149	END DO
150	! ! where at least 1 tracer concentration becomes negative
151	! !
152	! Concentrations are updated
153	DO jn = jp_pcs0, jp_pcs1
154	tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs)
155	END DO
156	!
157	IF( iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR. &
158	& iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) ) THEN
159	!
160	ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) )
161	zw3d(:,:,jpk) = 0.
162	DO jk = 1, jpkm1
163	zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
164	ENDDO
165	!
166	zw2d(:,:) = 0.
167	DO jk = 1, jpkm1
168	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs)
169	ENDDO
170	CALL iom_put( 'INTdtAlk', zw2d )
171	!
172	zw2d(:,:) = 0.
173	DO jk = 1, jpkm1
174	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs)
175	ENDDO
176	CALL iom_put( 'INTdtDIC', zw2d )
177	!
178	zw2d(:,:) = 0.
179	DO jk = 1, jpkm1
180	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) )
181	ENDDO
182	CALL iom_put( 'INTdtDIN', zw2d )
183	!
184	zw2d(:,:) = 0.
185	DO jk = 1, jpkm1
186	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs)
187	ENDDO
188	CALL iom_put( 'INTdtDIP', zw2d )
189	!
190	zw2d(:,:) = 0.
191	DO jk = 1, jpkm1
192	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs)
193	ENDDO
194	CALL iom_put( 'INTdtFer', zw2d )
195	!
196	zw2d(:,:) = 0.
197	DO jk = 1, jpkm1
198	zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs)
199	ENDDO
200	CALL iom_put( 'INTdtSil', zw2d )
201	!
202	DEALLOCATE( zw3d, zw2d )
203	ENDIF
204	!
205	! Trends are are reset to 0
206	DO jn = jp_pcs0, jp_pcs1
207	tr(:,:,:,jn,Krhs) = 0._wp
208	END DO
209	!
210	END DO
211	!
212	#endif
213	!
214	! If ln_sediment is set to .true. then the sediment module is called
215	IF( ln_sediment ) THEN
216	!
217	CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model
218	!
219	ENDIF
220	!
221	DO jn = jp_pcs0, jp_pcs1
222	tr(:,:,:,jn,Krhs) = ( tr(:,:,:,jn,Kbb) - ztrbbio(:,:,:,jn) ) * rfactr
223	tr(:,:,:,jn,Kbb ) = ztrbbio(:,:,:,jn)
224	ztrbbio(:,:,:,jn) = 0._wp
225	END DO
226	!
227	!
228	IF( l_trdtrc ) THEN
229	DO jn = jp_pcs0, jp_pcs1
230	CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends
231	END DO
232	END IF
233	!
234	IF( lrst_trc ) CALL p4z_rst( kt, Kbb, Kmm, 'WRITE' ) !* Write PISCES informations in restart file
235	!
236
237	IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking
238
239	IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES
240	!
241	IF( ln_timing ) CALL timing_stop('p4z_sms')
242	!
243	END SUBROUTINE p4z_sms
244
245
246	SUBROUTINE p4z_sms_init
247	!!----------------------------------------------------------------------
248	!! * p4z_sms_init *
249	!!
250	!! ** Purpose : read the general PISCES namelist
251	!!
252	!! ** input : file 'namelist_pisces' containing the following
253	!! namelist: nampisbio, nampisdmp, nampismass
254	!!----------------------------------------------------------------------
255	INTEGER :: ios ! Local integer output status for namelist read
256	!!
257	NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, feratz, feratm, wsbio2, wsbio2max, &
258	& wsbio2scale, ldocp, ldocz, lthet, no3rat3, po4rat3
259	!
260	NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
261	NAMELIST/nampismass/ ln_check_mass
262	!!----------------------------------------------------------------------
263	!
264	IF(lwp) THEN
265	WRITE(numout,*)
266	WRITE(numout,*) 'p4z_sms_init : PISCES initialization'
267	WRITE(numout,*) '~~~~~~~~~~~~'
268	ENDIF
269
270	READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
271	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist' )
272	READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
273	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist' )
274	IF(lwm) WRITE( numonp, nampisbio )
275	!
276	IF(lwp) THEN ! control print
277	WRITE(numout,*) ' Namelist : nampisbio'
278	WRITE(numout,*) ' frequency for the biology nrdttrc =', nrdttrc
279	WRITE(numout,*) ' POC sinking speed wsbio =', wsbio
280	WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort
281	IF( ln_p5z ) THEN
282	WRITE(numout,*) ' N/C in zooplankton no3rat3 =', no3rat3
283	WRITE(numout,*) ' P/C in zooplankton po4rat3 =', po4rat3
284	ENDIF
285	WRITE(numout,*) ' Fe/C in microzooplankton feratz =', feratz
286	WRITE(numout,*) ' Fe/C in microzooplankton feratz =', feratm
287	WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2
288	WRITE(numout,*) ' Big particles maximum sinking speed wsbio2max =', wsbio2max
289	WRITE(numout,*) ' Big particles sinking speed length scale wsbio2scale =', wsbio2scale
290	IF( ln_ligand ) THEN
291	IF( ln_p4z ) THEN
292	WRITE(numout,*) ' Phyto ligand production per unit doc ldocp =', ldocp
293	WRITE(numout,*) ' Zoo ligand production per unit doc ldocz =', ldocz
294	WRITE(numout,*) ' Proportional loss of ligands due to Fe uptake lthet =', lthet
295	ENDIF
296	ENDIF
297	ENDIF
298
299
300	READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
301	905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist' )
302	READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
303	906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' )
304	IF(lwm) WRITE( numonp, nampisdmp )
305	!
306	IF(lwp) THEN ! control print
307	WRITE(numout,*)
308	WRITE(numout,*) ' Namelist : nampisdmp --- relaxation to GLODAP'
309	WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp
310	WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp
311	ENDIF
312
313	READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
314	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist' )
315	READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
316	908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist' )
317	IF(lwm) WRITE( numonp, nampismass )
318
319	IF(lwp) THEN ! control print
320	WRITE(numout,*)
321	WRITE(numout,*) ' Namelist : nampismass --- mass conservation checking'
322	WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
323	ENDIF
324	!
325	END SUBROUTINE p4z_sms_init
326
327
328	SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw )
329	!!---------------------------------------------------------------------
330	!! * ROUTINE p4z_rst *
331	!!
332	!! ** Purpose : Read or write specific PISCES variables in restart file:
333	!!
334	!! WRITE(READ) mode:
335	!! kt : number of time step since the begining of the experiment at the
336	!! end of the current(previous) run
337	!!---------------------------------------------------------------------
338	INTEGER , INTENT(in) :: kt ! ocean time-step
339	INTEGER , INTENT(in) :: Kbb, Kmm ! time level indices
340	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
341	!!---------------------------------------------------------------------
342	!
343	IF( TRIM(cdrw) == 'READ' ) THEN
344	!
345	! Read the specific variable of PISCES
346	IF(lwp) WRITE(numout,*)
347	IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
348	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
349	!
350	! Read the pH. If not in the restart file, then it is initialized from
351	! the initial conditions
352	IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
353	CALL iom_get( numrtr, jpdom_auto, 'PH' , hi(:,:,:) )
354	ELSE
355	CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants
356	CALL ahini_for_at( hi, Kbb )
357	ENDIF
358	CALL iom_get( numrtr, jpdom_auto, 'Silicalim', xksi(:,:) )
359
360	! Read the Si half saturation constant and the maximum Silica concentration
361	IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
362	CALL iom_get( numrtr, jpdom_auto, 'Silicamax' , xksimax(:,:) )
363	ELSE
364	xksimax(:,:) = xksi(:,:)
365	ENDIF
366
367	! Read the Fe3 consumption term by phytoplankton
368	IF( iom_varid( numrtr, 'Consfe3', ldstop = .FALSE. ) > 0 ) THEN
369	CALL iom_get( numrtr, jpdom_auto, 'Consfe3' , consfe3(:,:,:) )
370	ELSE
371	consfe3(:,:,:) = 0._wp
372	ENDIF
373
374
375	! Read the cumulative total flux. If not in the restart file, it is set to 0
376	IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN ! cumulative total flux of carbon
377	CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum )
378	ELSE
379	t_oce_co2_flx_cum = 0._wp
380	ENDIF
381	!
382	! PISCES size proxy
383	IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN
384	CALL iom_get( numrtr, jpdom_auto, 'sized' , sized(:,:,:) )
385	sized(:,:,:) = MAX( 1.0, sized(:,:,:) )
386	ELSE
387	sized(:,:,:) = 1.
388	ENDIF
389	!
390	IF( iom_varid( numrtr, 'sizen', ldstop = .FALSE. ) > 0 ) THEN
391	CALL iom_get( numrtr, jpdom_auto, 'sizen' , sizen(:,:,:) )
392	sizen(:,:,:) = MAX( 1.0, sizen(:,:,:) )
393	ELSE
394	sizen(:,:,:) = 1.
395	ENDIF
396
397	! PISCES-QUOTA specific part
398	IF( ln_p5z ) THEN
399	! Read the size of the different phytoplankton groups
400	! If not in the restart file, they are set to 1
401	IF( iom_varid( numrtr, 'sizep', ldstop = .FALSE. ) > 0 ) THEN
402	CALL iom_get( numrtr, jpdom_auto, 'sizep' , sizep(:,:,:) )
403	sizep(:,:,:) = MAX( 1.0, sizep(:,:,:) )
404	ELSE
405	sizep(:,:,:) = 1.
406	ENDIF
407	ENDIF
408	!
409	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
410	! write the specific variables of PISCES
411	IF( kt == nitrst ) THEN
412	IF(lwp) WRITE(numout,*)
413	IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file kt =', kt
414	IF(lwp) WRITE(numout,*) '~~~~~~~'
415	ENDIF
416	CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
417	CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
418	CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
419	CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
420	CALL iom_rstput( kt, nitrst, numrtw, 'Consfe3', consfe3(:,:,:) ) ! Si max concentration
421	CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) ! Cumulative CO2 flux
422	CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sizen(:,:,:) ) ! Size of nanophytoplankton
423	CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) ) ! Size of diatoms
424	IF( ln_p5z ) CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sizep(:,:,:) ) ! Size of picophytoplankton
425	ENDIF
426	!
427	END SUBROUTINE p4z_rst
428
429
430	SUBROUTINE p4z_dmp( kt, Kbb, Kmm )
431	!!----------------------------------------------------------------------
432	!! * p4z_dmp *
433	!!
434	!! ** purpose : Relaxation of the total budget of some elements
435	!! This routine avoids the model to drift far from the
436	!! observed content in various elements
437	!! Elements that may be relaxed : Alk, P, N, Si
438	!!----------------------------------------------------------------------
439	!
440	INTEGER, INTENT( in ) :: kt ! time step
441	INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices
442	!
443	REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
444	REAL(wp) :: po4mean = 2.174 ! mean value of phosphate
445	REAL(wp) :: no3mean = 31.00 ! mean value of nitrate
446	REAL(wp) :: silmean = 90.33 ! mean value of silicate
447	!
448	REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
449	REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
450	!!---------------------------------------------------------------------
451
452	IF(lwp) WRITE(numout,*)
453	IF(lwp) WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
454	IF(lwp) WRITE(numout,*)
455
456	IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca") THEN
457	IF( .NOT. ln_c1d ) THEN ! ORCA configuration (not 1D) !
458	! ! --------------------------- !
459	! set total alkalinity, phosphate, nitrate & silicate
460	zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6
461
462	zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:) ) * zarea
463	zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:) ) * zarea * po4r
464	zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:) ) * zarea * rno3
465	zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:) ) * zarea
466
467	! Correct the trn mean content of alkalinity
468	IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn
469	tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn
470
471	! Correct the trn mean content of PO4
472	IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn
473	tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn
474
475	! Correct the trn mean content of NO3
476	IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn
477	tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn
478
479	! Correct the trn mean content of SiO3
480	IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn
481	tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn )
482	!
483	!
484	IF( .NOT. ln_top_euler ) THEN
485	zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:) ) * zarea
486	zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:) ) * zarea * po4r
487	zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:) ) * zarea * rno3
488	zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:) ) * zarea
489
490	IF(lwp) WRITE(numout,*) ' '
491	! Correct the trb mean content of alkalinity
492	IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb
493	tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb
494
495	! Correct the trb mean content of PO4
496	IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb
497	tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb
498
499	! Correct the trb mean content of NO3
500	IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb
501	tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb
502
503	! Correct the trb mean content of SiO3
504	IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb
505	tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb )
506	ENDIF
507	ENDIF
508	!
509	ENDIF
510	!
511	END SUBROUTINE p4z_dmp
512
513
514	SUBROUTINE p4z_chk_mass( kt, Kmm )
515	!!----------------------------------------------------------------------
516	!! * ROUTINE p4z_chk_mass *
517	!!
518	!! ** Purpose : Mass conservation check
519	!!
520	!!---------------------------------------------------------------------
521	INTEGER, INTENT( in ) :: kt ! ocean time-step index
522	INTEGER, INTENT( in ) :: Kmm ! time level indices
523	REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
524	CHARACTER(LEN=100) :: cltxt
525	INTEGER :: jk
526	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork
527	!!----------------------------------------------------------------------
528	!
529	IF( kt == nittrc000 ) THEN
530	xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr
531	xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr
532	xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s
533	IF( ln_check_mass .AND. lwp) THEN ! Open budget file of NO3, ALK, Si, Fer
534	CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
535	CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
536	CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
537	cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron'
538	IF( lwp ) WRITE(numnut,*) TRIM(cltxt)
539	IF( lwp ) WRITE(numnut,*)
540	ENDIF
541	ENDIF
542
543	! Compute the budget of NO3
544	IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
545	IF( ln_p4z ) THEN
546	zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) &
547	& + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
548	& + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
549	& + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
550	ELSE
551	zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm) &
552	& + tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm) &
553	& + tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm) &
554	& + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3
555	ENDIF
556	!
557	no3budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
558	no3budget = no3budget / areatot
559	CALL iom_put( "pno3tot", no3budget )
560	ENDIF
561	!
562	! Compute the budget of PO4
563	IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
564	IF( ln_p4z ) THEN
565	zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) &
566	& + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
567	& + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
568	& + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
569	ELSE
570	zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm) &
571	& + tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm) &
572	& + tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm) &
573	& + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3
574	ENDIF
575	!
576	po4budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
577	po4budget = po4budget / areatot
578	CALL iom_put( "ppo4tot", po4budget )
579	ENDIF
580	!
581	! Compute the budget of SiO3
582	IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
583	zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)
584	!
585	silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
586	silbudget = silbudget / areatot
587	CALL iom_put( "psiltot", silbudget )
588	ENDIF
589	!
590	IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
591	zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.
592	!
593	alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) !
594	alkbudget = alkbudget / areatot
595	CALL iom_put( "palktot", alkbudget )
596	ENDIF
597	!
598	! Compute the budget of Iron
599	IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
600	zwork(:,:,:) = tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm) &
601	& + tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm) &
602	& + ( tr(:,:,:,jpzoo,Kmm) * feratz + tr(:,:,:,jpmes,Kmm) ) * feratm
603	!
604	ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
605	ferbudget = ferbudget / areatot
606	CALL iom_put( "pfertot", ferbudget )
607	ENDIF
608	!
609	! Global budget of N SMS : denitrification in the water column and in the sediment
610	! nitrogen fixation by the diazotrophs
611	! --------------------------------------------------------------------------------
612	IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
613	znitrpottot = glob_sum ( 'p4zsms', nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
614	CALL iom_put( "tnfix" , znitrpottot * xfact3 ) ! Global nitrogen fixation molC/l to molN/m3
615	ENDIF
616	!
617	IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
618	zrdenittot = glob_sum ( 'p4zsms', denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
619	zsdenittot = glob_sum ( 'p4zsms', sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) )
620	CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 ) ! Total denitrification molC/l to molN/m3
621	ENDIF
622	!
623	IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
624	t_atm_co2_flx = t_atm_co2_flx / glob_sum( 'p4zsms', e1e2t(:,:) )
625	t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 )
626	tpp = tpp * 1000. * xfact1
627	t_oce_co2_exp = t_oce_co2_exp * 1000. * xfact1
628	IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
629	IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget * 1.e+06, &
630	& no3budget * rno3 * 1.e+06, &
631	& po4budget * po4r * 1.e+06, &
632	& silbudget * 1.e+06, &
633	& ferbudget * 1.e+09
634	!
635	IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2 , &
636	& zrdenittot * xfact2 , &
637	& zsdenittot * xfact2
638	ENDIF
639	!
640	9000 FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
641	9100 FORMAT(i8,5e18.10)
642	9200 FORMAT(i8,3f10.5)
643	!
644	END SUBROUTINE p4z_chk_mass
645
646	!!======================================================================
647	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/branches/2021/ticket2632_r14588_theta_sbcblk/src/TOP/PISCES/P4Z/p4zsms.F90 @ 15548

Download in other formats: