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.

p4zsed.F90 in trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90 @ 4641

Last change on this file since 4641 was 4641, checked in by cetlod, 10 years ago
trunk : bugfix to avoid division by zero in 1D PISCES, see ticket #1322
File size: 20.9 KB

Rev	Line
[3443]	1	MODULE p4zsed
	2	!!======================================================================
	3	!! * MODULE p4sed *
	4	!! TOP : PISCES Compute loss of organic matter in the sediments
	5	!!======================================================================
	6	!! History : 1.0 ! 2004-03 (O. Aumont) Original code
	7	!! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
	8	!! 3.4 ! 2011-06 (C. Ethe) USE of fldread
	9	!! 3.5 ! 2012-07 (O. Aumont) improvment of river input of nutrients
	10	!!----------------------------------------------------------------------
	11	#if defined key_pisces
	12	!!----------------------------------------------------------------------
	13	!! 'key_pisces' PISCES bio-model
	14	!!----------------------------------------------------------------------
	15	!! p4z_sed : Compute loss of organic matter in the sediments
	16	!!----------------------------------------------------------------------
	17	USE oce_trc ! shared variables between ocean and passive tracers
	18	USE trc ! passive tracers common variables
	19	USE sms_pisces ! PISCES Source Minus Sink variables
	20	USE p4zsink ! vertical flux of particulate matter due to sinking
	21	USE p4zopt ! optical model
	22	USE p4zlim ! Co-limitations of differents nutrients
	23	USE p4zrem ! Remineralisation of organic matter
	24	USE p4zsbc ! External source of nutrients
	25	USE p4zint ! interpolation and computation of various fields
	26	USE iom ! I/O manager
	27	USE prtctl_trc ! print control for debugging
	28
	29	IMPLICIT NONE
	30	PRIVATE
	31
	32	PUBLIC p4z_sed
	33
	34	!! * Module variables
	35	REAL(wp) :: ryyss !: number of seconds per year
	36	REAL(wp) :: r1_ryyss !: inverse of ryyss
	37	REAL(wp) :: rmtss !: number of seconds per month
	38	REAL(wp) :: r1_rday !: inverse of rday
	39
[3496]	40	INTEGER :: numnit
[3443]	41
[3496]	42
[3443]	43	!!* Substitution
	44	# include "top_substitute.h90"
	45	!!----------------------------------------------------------------------
	46	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
	47	!! $Header:$
	48	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	49	!!----------------------------------------------------------------------
	50	CONTAINS
	51
	52	SUBROUTINE p4z_sed( kt, jnt )
	53	!!---------------------------------------------------------------------
	54	!! * ROUTINE p4z_sed *
	55	!!
	56	!! ** Purpose : Compute loss of organic matter in the sediments. This
	57	!! is by no way a sediment model. The loss is simply
	58	!! computed to balance the inout from rivers and dust
	59	!!
	60	!! ** Method : - ???
	61	!!---------------------------------------------------------------------
	62	!
	63	INTEGER, INTENT(in) :: kt, jnt ! ocean time step
	64	INTEGER :: ji, jj, jk, ikt
	65	#if ! defined key_sed
	66	REAL(wp) :: zsumsedsi, zsumsedpo4, zsumsedcal
	67	REAL(wp) :: zrivalk, zrivsil, zrivno3
	68	#endif
	69	REAL(wp) :: zwflux, zfminus, zfplus
	70	REAL(wp) :: zlim, zfact, zfactcal
[4148]	71	REAL(wp) :: zo2, zno3, zflx, zpdenit, z1pdenit, zdenitt, zolimit
[4521]	72	REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc
[4529]	73	REAL(wp) :: ztrfer, ztrpo4, zwdust, zlight
[3531]	74	REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
	75	!
[3443]	76	CHARACTER (len=25) :: charout
	77	REAL(wp), POINTER, DIMENSION(:,: ) :: zpdep, zsidep, zwork1, zwork2, zwork3, zwork4
[4529]	78	REAL(wp), POINTER, DIMENSION(:,: ) :: zdenit2d, zironice, zbureff
[4521]	79	REAL(wp), POINTER, DIMENSION(:,: ) :: zwsbio3, zwsbio4, zwscal
[4529]	80	REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep, zsoufer
[3443]	81	!!---------------------------------------------------------------------
	82	!
	83	IF( nn_timing == 1 ) CALL timing_start('p4z_sed')
	84	!
[4162]	85	IF( kt == nittrc000 .AND. jnt == 1 ) THEN
[3443]	86	ryyss = nyear_len(1) * rday ! number of seconds per year and per month
	87	rmtss = ryyss / raamo
	88	r1_rday = 1. / rday
	89	r1_ryyss = 1. / ryyss
[3531]	90	IF( ln_check_mass .AND. lwp) &
	91	& CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
[3443]	92	ENDIF
	93	!
	94	! Allocate temporary workspace
[4529]	95	CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
[4521]	96	CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
[4529]	97	CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zsoufer )
[4521]	98
[3443]	99	zdenit2d(:,:) = 0.e0
[4529]	100	zbureff (:,:) = 0.e0
[3443]	101
	102	! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
	103	! ----------------------------------------------------
	104	IF( ln_ironice ) THEN
	105	!
	106	CALL wrk_alloc( jpi, jpj, zironice )
	107	!
	108	DO jj = 1, jpj
	109	DO ji = 1, jpi
	110	zdep = rfact2 / fse3t(ji,jj,1)
[4148]	111	zwflux = fmmflx(ji,jj) / 1000._wp
	112	zfminus = MIN( 0._wp, -zwflux ) * trn(ji,jj,1,jpfer) * zdep
	113	zfplus = MAX( 0._wp, -zwflux ) * icefeinput * zdep
[3443]	114	zironice(ji,jj) = zfplus + zfminus
	115	END DO
	116	END DO
	117	!
	118	trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + zironice(:,:)
	119	!
	120	IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) &
	121	& CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
	122	CALL wrk_dealloc( jpi, jpj, zironice )
	123	!
	124	ENDIF
	125
	126	! Add the external input of nutrients from dust deposition
	127	! ----------------------------------------------------------
	128	IF( ln_dust ) THEN
	129	!
	130	CALL wrk_alloc( jpi, jpj, zpdep, zsidep )
	131	CALL wrk_alloc( jpi, jpj, jpk, zirondep )
	132	! ! Iron and Si deposition at the surface
	133	IF( ln_solub ) THEN
[4529]	134	zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss
[3443]	135	ELSE
[4529]	136	zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss
[3443]	137	ENDIF
[4529]	138	zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 28.1 * rmtss )
	139	zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 31. * rmtss ) / po4r
[3443]	140	! ! Iron solubilization of particles in the water column
[4529]	141	! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j
	142	zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday )
[3443]	143	DO jk = 2, jpkm1
[4529]	144	zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -fsdept(:,:,jk) / 540. )
[3443]	145	END DO
	146	! ! Iron solubilization of particles in the water column
	147	trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + zpdep (:,:)
	148	trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:)
	149	trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + zirondep(:,:,:)
	150	!
	151	IF( ln_diatrc ) THEN
	152	zfact = 1.e+3 * rfact2r
[3751]	153	IF( lk_iomput ) THEN
	154	IF( jnt == nrdttrc ) THEN
	155	CALL iom_put( "Irondep", zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
[4529]	156	CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface
[3751]	157	ENDIF
[3443]	158	ELSE
	159	trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1)
	160	ENDIF
	161	ENDIF
	162	CALL wrk_dealloc( jpi, jpj, zpdep, zsidep )
	163	CALL wrk_dealloc( jpi, jpj, jpk, zirondep )
	164	!
	165	ENDIF
	166
	167	! Add the external input of nutrients from river
	168	! ----------------------------------------------------------
	169	IF( ln_river ) THEN
	170	trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivdip(:,:) * rfact2
	171	trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + rivdin(:,:) * rfact2
	172	trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivdic(:,:) * 5.e-5 * rfact2
	173	trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + rivdsi(:,:) * rfact2
	174	trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivdic(:,:) * rfact2
	175	trn(:,:,1,jptal) = trn(:,:,1,jptal) + ( rivalk(:,:) - rno3 * rivdin(:,:) ) * rfact2
	176	ENDIF
	177
	178	! Add the external input of nutrients from nitrogen deposition
	179	! ----------------------------------------------------------
	180	IF( ln_ndepo ) THEN
	181	trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + nitdep(:,:) * rfact2
	182	trn(:,:,1,jptal) = trn(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
	183	ENDIF
	184
	185	! Add the external input of iron from sediment mobilization
	186	! ------------------------------------------------------
	187	IF( ln_ironsed ) THEN
	188	trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
	189	!
	190	IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) &
[3446]	191	& CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
[3443]	192	ENDIF
	193
	194	! Add the external input of iron from hydrothermal vents
	195	! ------------------------------------------------------
	196	IF( ln_hydrofe ) THEN
	197	trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
	198	!
	199	IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) &
[3446]	200	& CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
[3443]	201	ENDIF
	202
[4521]	203
	204	! OA: Warning, the following part is necessary, especially with Kriest
	205	! to avoid CFL problems above the sediments
	206	! --------------------------------------------------------------------
	207	DO jj = 1, jpj
	208	DO ji = 1, jpi
	209	ikt = mbkt(ji,jj)
	210	zdep = fse3t(ji,jj,ikt) / xstep
	211	zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
	212	zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) )
	213	zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) )
	214	END DO
	215	END DO
	216
[3443]	217	#if ! defined key_sed
[3475]	218	! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
[4529]	219	! Computation of the fraction of organic matter that is permanently buried from Dunne's model
[3443]	220	! -------------------------------------------------------
	221	DO jj = 1, jpj
	222	DO ji = 1, jpi
	223	IF( tmask(ji,jj,1) == 1 ) THEN
	224	ikt = mbkt(ji,jj)
	225	# if defined key_kriest
[4521]	226	zflx = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4
[3443]	227	# else
[4521]	228	zflx = ( trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
	229	& + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4
[3443]	230	#endif
	231	zflx = LOG10( MAX( 1E-3, zflx ) )
	232	zo2 = LOG10( MAX( 10. , trn(ji,jj,ikt,jpoxy) * 1E6 ) )
	233	zno3 = LOG10( MAX( 1. , trn(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
	234	zdep = LOG10( fsdepw(ji,jj,ikt+1) )
	235	zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx*2 - 0.3995 zno3 * zo2 + 1.25 * zno3 &
	236	& + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
	237	zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
[4529]	238	!
	239	zflx = ( trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
	240	& + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
	241	zbureff(ji,jj) = 0.013 + 0.53 * zflx2 / ( 7.0 + zflx )2
[3443]	242	ENDIF
	243	END DO
	244	END DO
[4529]	245
[3443]	246	! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
	247	! First, the total loss is computed.
	248	! The factor for calcite comes from the alkalinity effect
	249	! -------------------------------------------------------------
	250	DO jj = 1, jpj
	251	DO ji = 1, jpi
	252	ikt = mbkt(ji,jj)
	253	# if defined key_kriest
[4521]	254	zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
	255	zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
[3443]	256	# else
[4521]	257	zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
	258	zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
[3443]	259	# endif
	260	! For calcite, burial efficiency is made a function of saturation
	261	zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
	262	zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
[4521]	263	zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
[3443]	264	END DO
	265	END DO
	266	zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday
	267	zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday
	268	zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday
	269	#endif
	270
[4148]	271	! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean.
	272	! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers)
[3443]	273	! ------------------------------------------------------
	274	#if ! defined key_sed
[4641]	275	zrivsil = 1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn )
[3443]	276	#endif
	277
	278	DO jj = 1, jpj
	279	DO ji = 1, jpi
	280	ikt = mbkt(ji,jj)
	281	zdep = xstep / fse3t(ji,jj,ikt)
[4521]	282	zws4 = zwsbio4(ji,jj) * zdep
	283	zwsc = zwscal (ji,jj) * zdep
[3443]	284	# if defined key_kriest
[4521]	285	zsiloss = trn(ji,jj,ikt,jpgsi) * zws4
[3443]	286	# else
[4521]	287	zsiloss = trn(ji,jj,ikt,jpgsi) * zwsc
[3443]	288	# endif
[4521]	289	zcaloss = trn(ji,jj,ikt,jpcal) * zwsc
[3443]	290	!
	291	trn(ji,jj,ikt,jpgsi) = trn(ji,jj,ikt,jpgsi) - zsiloss
	292	trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss
	293	#if ! defined key_sed
	294	trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil
	295	zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
	296	zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
[4641]	297	zrivalk = 1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
[3443]	298	trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
	299	trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk
	300	#endif
	301	END DO
	302	END DO
	303
	304	DO jj = 1, jpj
	305	DO ji = 1, jpi
	306	ikt = mbkt(ji,jj)
	307	zdep = xstep / fse3t(ji,jj,ikt)
[4521]	308	zws4 = zwsbio4(ji,jj) * zdep
	309	zws3 = zwsbio3(ji,jj) * zdep
[4529]	310	zrivno3 = 1. - zbureff(ji,jj)
[3443]	311	# if ! defined key_kriest
[4521]	312	trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zws4
	313	trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
	314	trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zws4
	315	trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
	316	zwstpoc = trn(ji,jj,ikt,jpgoc) * zws4 + trn(ji,jj,ikt,jppoc) * zws3
[3443]	317	# else
[4521]	318	trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zws4
	319	trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
	320	trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
	321	zwstpoc = trn(ji,jj,ikt,jppoc) * zws3
[3443]	322	# endif
	323
	324	#if ! defined key_sed
[4148]	325	! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
	326	! in the sediments and just above the sediments. Not very clever, but simpliest option.
	327	zpdenit = MIN( 0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
[3443]	328	z1pdenit = zwstpoc * zrivno3 - zpdenit
[4148]	329	zolimit = MIN( ( trn(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
	330	zdenitt = MIN( 0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
	331	trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
	332	trn(ji,jj,ikt,jppo4) = trn(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
	333	trn(ji,jj,ikt,jpnh4) = trn(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
	334	trn(ji,jj,ikt,jpno3) = trn(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
	335	trn(ji,jj,ikt,jpoxy) = trn(ji,jj,ikt,jpoxy) - zolimit * o2ut
	336	trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
	337	trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
[3443]	338	zwork4(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
	339	#endif
	340	END DO
	341	END DO
	342
	343	! Nitrogen fixation process
[4529]	344	! Small source iron from particulate inorganic iron
[3443]	345	!-----------------------------------
	346	DO jk = 1, jpkm1
	347	DO jj = 1, jpj
	348	DO ji = 1, jpi
[4529]	349	! ! Potential nitrogen fixation dependant on temperature and iron
[3443]	350	zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
	351	IF( zlim <= 0.2 ) zlim = 0.01
	352	#if defined key_degrad
	353	zfact = zlim * rfact2 * facvol(ji,jj,jk)
	354	#else
	355	zfact = zlim * rfact2
	356	#endif
[3446]	357	ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
	358	ztrpo4 = trn (ji,jj,jk,jppo4) / ( concnnh4 + trn (ji,jj,jk,jppo4) )
[4529]	359	zlight = ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) )
[3443]	360	znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &
[4529]	361	& * zfact * MIN( ztrfer, ztrpo4 ) * zlight
	362	zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
[3443]	363	END DO
	364	END DO
	365	END DO
[3496]	366
[3443]	367	! Nitrogen change due to nitrogen fixation
	368	! ----------------------------------------
	369	DO jk = 1, jpkm1
	370	DO jj = 1, jpj
	371	DO ji = 1, jpi
	372	zfact = znitrpot(ji,jj,jk) * nitrfix
	373	trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
	374	trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zfact
	375	trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + o2nit * zfact
[4529]	376	trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trn(ji,jj,jk,jppo4) ) &
	377	& * 0.002 * trn(ji,jj,jk,jpdoc) * rfact2 / rday
	378	trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
[3443]	379	END DO
	380	END DO
	381	END DO
[4529]	382
	383
	384	IF( ln_check_mass ) THEN
	385	! Global budget of N SMS : denitrification in the water column and in the sediment
	386	! nitrogen fixation by the diazotrophs
	387	! --------------------------------------------------------------------------------
	388	zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
	389	zsdenittot = glob_sum ( zwork4(:,:) * e1e2t(:,:) )
	390	znitrpottot = glob_sum ( znitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
	391	IF( kt == nitend .AND. jnt == nrdttrc ) THEN
	392	zfact = 1.e+3 * rfact2r * rno3 * ryyss * 14. / 1e12
	393	IF(lwp) WRITE(numnit,9100) ndastp, znitrpottot * nitrfix * zfact, zrdenittot * zfact , zsdenittot * zfact
	394	ENDIF
	395	ENDIF
[3443]	396	!
	397	IF( ln_diatrc ) THEN
	398	zfact = 1.e+3 * rfact2r
[3751]	399	IF( lk_iomput ) THEN
	400	IF( jnt == nrdttrc ) THEN
	401	CALL iom_put( "Nfix" , znitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation
	402	CALL iom_put( "Sdenit", zwork4(:,:) * rno3 * zfact * tmask(:,:,1) ) ! Nitrate reduction in the sediments
	403	ENDIF
[3443]	404	ELSE
	405	trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1)
	406	ENDIF
	407	ENDIF
	408	!
	409	IF(ln_ctl) THEN ! print mean trends (USEd for debugging)
	410	WRITE(charout, fmt="('sed ')")
	411	CALL prt_ctl_trc_info(charout)
	412	CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
	413	ENDIF
	414	!
[4641]	415	CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
[4521]	416	CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
[4641]	417	CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zsoufer )
[3443]	418	!
	419	IF( nn_timing == 1 ) CALL timing_stop('p4z_sed')
	420	!
[3496]	421	9100 FORMAT(i8,3f10.5)
	422	!
[3443]	423	END SUBROUTINE p4z_sed
	424
	425	#else
	426	!!======================================================================
	427	!! Dummy module : No PISCES bio-model
	428	!!======================================================================
	429	CONTAINS
	430	SUBROUTINE p4z_sed ! Empty routine
	431	END SUBROUTINE p4z_sed
	432	#endif
	433
	434	!!======================================================================
	435	END MODULE p4zsed

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

Download in other formats: