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.

p4zprod.F90 in branches/2011/dev_r2787_PISCES_improvment/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

Context Navigation

source: branches/2011/dev_r2787_PISCES_improvment/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90 @ 2968

Last change on this file since 2968 was 2968, checked in by cetlod, 13 years ago
dev_r2787_PISCES_improvment:style corrections
Property svn:keywords set to `Id`
File size: 25.6 KB

Rev	Line
[935]	1	MODULE p4zprod
	2	!!======================================================================
	3	!! * MODULE p4zprod *
	4	!! TOP : PISCES
	5	!!======================================================================
	6	!! History : 1.0 ! 2004 (O. Aumont) Original code
	7	!! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
[2823]	8	!! 3.4 ! 2011-05 (O. Aumont, C. Ethe) New parameterization of light limitation
[935]	9	!!----------------------------------------------------------------------
	10	#if defined key_pisces
	11	!!----------------------------------------------------------------------
	12	!! 'key_pisces' PISCES bio-model
	13	!!----------------------------------------------------------------------
	14	!!----------------------------------------------------------------------
[2823]	15	!! p4z_prod : Compute the growth Rate of the two phytoplanktons groups
	16	!! p4z_prod_init : Initialization of the parameters for growth
	17	!! p4z_prod_alloc : Allocate variables for growth
	18	!!----------------------------------------------------------------------
	19	USE oce_trc ! shared variables between ocean and passive tracers
	20	USE trc ! passive tracers common variables
	21	USE sms_pisces ! PISCES Source Minus Sink variables
	22	USE p4zopt ! optical model
	23	USE p4zlim ! Co-limitations of differents nutrients
	24	USE prtctl_trc ! print control for debugging
	25	USE iom ! I/O manager
[935]	26
	27	IMPLICIT NONE
	28	PRIVATE
	29
[2528]	30	PUBLIC p4z_prod ! called in p4zbio.F90
	31	PUBLIC p4z_prod_init ! called in trcsms_pisces.F90
[2715]	32	PUBLIC p4z_prod_alloc
[935]	33
[2823]	34	!! * Shared module variables
[2957]	35	LOGICAL , PUBLIC :: ln_newprod = .FALSE.
	36	REAL(wp), PUBLIC :: pislope = 3.0_wp !:
	37	REAL(wp), PUBLIC :: pislope2 = 3.0_wp !:
	38	REAL(wp), PUBLIC :: excret = 10.e-5_wp !:
	39	REAL(wp), PUBLIC :: excret2 = 0.05_wp !:
	40	REAL(wp), PUBLIC :: bresp = 0.00333_wp !:
	41	REAL(wp), PUBLIC :: chlcnm = 0.033_wp !:
	42	REAL(wp), PUBLIC :: chlcdm = 0.05_wp !:
	43	REAL(wp), PUBLIC :: chlcmin = 0.00333_wp !:
	44	REAL(wp), PUBLIC :: fecnm = 10.E-6_wp !:
	45	REAL(wp), PUBLIC :: fecdm = 15.E-6_wp !:
	46	REAL(wp), PUBLIC :: grosip = 0.151_wp !:
[935]	47
[2957]	48	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax !: optimal production = f(temperature)
[2823]	49	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: quotan !: proxy of N quota in Nanophyto
	50	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: quotad !: proxy of N quota in diatomee
[935]	51
[2823]	52	REAL(wp) :: r1_rday !: 1 / rday
	53	REAL(wp) :: texcret !: 1 - excret
	54	REAL(wp) :: texcret2 !: 1 - excret2
	55	REAL(wp) :: tpp !: Total primary production
[935]	56
[2823]	57
[935]	58	!!* Substitution
[1800]	59	# include "top_substitute.h90"
[935]	60	!!----------------------------------------------------------------------
[2528]	61	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
[1152]	62	!! $Id$
[2715]	63	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[935]	64	!!----------------------------------------------------------------------
	65	CONTAINS
	66
	67	SUBROUTINE p4z_prod( kt , jnt )
	68	!!---------------------------------------------------------------------
	69	!! * ROUTINE p4z_prod *
	70	!!
	71	!! ** Purpose : Compute the phytoplankton production depending on
	72	!! light, temperature and nutrient availability
	73	!!
	74	!! ** Method : - ???
	75	!!---------------------------------------------------------------------
[2715]	76	USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
[2823]	77	USE wrk_nemo, ONLY: zmixnano => wrk_2d_1 , zmixdiat => wrk_2d_2, zstrn => wrk_2d_3
	78	USE wrk_nemo, ONLY: zpislopead => wrk_3d_2 , zpislopead2 => wrk_3d_3
	79	USE wrk_nemo, ONLY: zprdia => wrk_3d_4 , zprbio => wrk_3d_5
	80	USE wrk_nemo, ONLY: zprdch => wrk_3d_6 , zprnch => wrk_3d_7
	81	USE wrk_nemo, ONLY: zprorca => wrk_3d_8 , zprorcad => wrk_3d_9
	82	USE wrk_nemo, ONLY: zprofed => wrk_3d_10, zprofen => wrk_3d_11
	83	USE wrk_nemo, ONLY: zprochln => wrk_3d_12, zprochld => wrk_3d_13
	84	USE wrk_nemo, ONLY: zpronew => wrk_3d_14, zpronewd => wrk_3d_15
[2715]	85	!
[935]	86	INTEGER, INTENT(in) :: kt, jnt
[2715]	87	!
[1735]	88	INTEGER :: ji, jj, jk
[2823]	89	REAL(wp) :: zsilfac, zfact, znanotot, zdiattot, zconctemp, zconctemp2
	90	REAL(wp) :: zratio, zmax, zsilim, ztn, zadap
	91	REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zetot2, zproreg, zproreg2
[2968]	92	REAL(wp) :: zmxltst, zmxlday, zmaxday
[935]	93	REAL(wp) :: zpislopen , zpislope2n
[2823]	94	REAL(wp) :: zrum, zcodel, zargu, zval
	95	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zysopt
[1351]	96	REAL(wp) :: zrfact2
[935]	97	CHARACTER (len=25) :: charout
	98	!!---------------------------------------------------------------------
	99
[2715]	100	IF( wrk_in_use(2, 1,2,3) .OR. &
[2823]	101	wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) THEN
[2715]	102	CALL ctl_stop('p4z_prod: requested workspace arrays unavailable') ; RETURN
	103	ENDIF
[2823]	104
	105	ALLOCATE( zysopt(jpi,jpj,jpk) )
[935]	106
[2715]	107	zprorca (:,:,:) = 0._wp
	108	zprorcad(:,:,:) = 0._wp
	109	zprofed (:,:,:) = 0._wp
	110	zprofen (:,:,:) = 0._wp
	111	zprochln(:,:,:) = 0._wp
	112	zprochld(:,:,:) = 0._wp
	113	zpronew (:,:,:) = 0._wp
	114	zpronewd(:,:,:) = 0._wp
	115	zprdia (:,:,:) = 0._wp
	116	zprbio (:,:,:) = 0._wp
[2823]	117	zprdch (:,:,:) = 0._wp
	118	zprnch (:,:,:) = 0._wp
[2715]	119	zysopt (:,:,:) = 0._wp
	120
[1457]	121	! Computation of the optimal production
[2823]	122	prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:)
	123	IF( lk_degrad ) THEN
	124	prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:)
	125	ENDIF
[935]	126
[1073]	127	! compute the day length depending on latitude and the day
[2715]	128	zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
	129	zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) )
[935]	130
[1073]	131	! day length in hours
[2823]	132	zstrn(:,:) = 0.
[1073]	133	DO jj = 1, jpj
	134	DO ji = 1, jpi
[2528]	135	zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
[1073]	136	zargu = MAX( -1., MIN( 1., zargu ) )
[2823]	137	zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
[1073]	138	END DO
	139	END DO
	140
[2957]	141	IF( ln_newprod ) THEN
	142	! Impact of the day duration on phytoplankton growth
	143	DO jk = 1, jpkm1
	144	DO jj = 1 ,jpj
	145	DO ji = 1, jpi
	146	zval = MAX( 1., zstrn(ji,jj) )
	147	zval = 1.5 * zval / ( 12. + zval )
	148	zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
	149	zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
	150	END DO
[2823]	151	END DO
	152	END DO
[2957]	153	ENDIF
[1073]	154
[2957]	155	! Maximum light intensity
[2823]	156	WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
	157	zstrn(:,:) = 24. / zstrn(:,:)
	158
[2957]	159	IF( ln_newprod ) THEN
[935]	160	!CDIR NOVERRCHK
[2957]	161	DO jk = 1, jpkm1
[935]	162	!CDIR NOVERRCHK
[2957]	163	DO jj = 1, jpj
[935]	164	!CDIR NOVERRCHK
[2957]	165	DO ji = 1, jpi
[935]	166
[2957]	167	! Computation of the P-I slope for nanos and diatoms
	168	IF( etot(ji,jj,jk) > 1.E-3 ) THEN
	169	ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
	170	zadap = ztn / ( 2.+ ztn )
[935]	171
[2957]	172	zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 )
	173	zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp
[935]	174
[2957]	175	znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
	176	zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
[935]	177
[2957]	178	zfact = EXP( -0.21 * znanotot )
	179	zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) &
	180	& * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn)
[935]	181
[2957]	182	zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn ) &
	183	& * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn)
[935]	184
[2957]	185	! Computation of production function for Carbon
	186	! ---------------------------------------------
	187	zpislopen = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_day / chlcnm ) * rday + rtrn)
	188	zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_day / chlcdm ) * rday + rtrn)
	189	zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) )
	190	zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) )
[2823]	191
[2957]	192	! Computation of production function for Chlorophyll
	193	!--------------------------------------------------
	194	zmaxday = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn )
	195	zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) )
	196	zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) )
	197	ENDIF
	198	END DO
[935]	199	END DO
	200	END DO
[2957]	201	ELSE
	202	!CDIR NOVERRCHK
	203	DO jk = 1, jpkm1
	204	!CDIR NOVERRCHK
	205	DO jj = 1, jpj
	206	!CDIR NOVERRCHK
	207	DO ji = 1, jpi
[935]	208
[2957]	209	! Computation of the P-I slope for nanos and diatoms
	210	IF( etot(ji,jj,jk) > 1.E-3 ) THEN
	211	ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
	212	zadap = ztn / ( 2.+ ztn )
	213
	214	zfact = EXP( -0.21 * enano(ji,jj,jk) )
	215	zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact )
	216	zpislopead2(ji,jj,jk) = pislope2
	217
	218	zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) &
	219	& / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) &
	220	& / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
	221
	222	zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) &
	223	& / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) &
	224	& / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
	225
	226	! Computation of production function for Carbon
	227	! ---------------------------------------------
	228	zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
	229	zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
	230
	231	! Computation of production function for Chlorophyll
	232	!--------------------------------------------------
	233	zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) * zstrn(ji,jj) ) )
	234	zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) )
	235	ENDIF
	236	END DO
	237	END DO
	238	END DO
	239	ENDIF
	240
[2823]	241	! Computation of a proxy of the N/C ratio
	242	! ---------------------------------------
	243	!CDIR NOVERRCHK
	244	DO jk = 1, jpkm1
	245	!CDIR NOVERRCHK
	246	DO jj = 1, jpj
	247	!CDIR NOVERRCHK
	248	DO ji = 1, jpi
	249	zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
	250	quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval )
	251	zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
	252	quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval )
	253	END DO
	254	END DO
	255	END DO
[935]	256
[2823]	257
[935]	258	DO jk = 1, jpkm1
	259	DO jj = 1, jpj
	260	DO ji = 1, jpi
	261
	262	IF( etot(ji,jj,jk) > 1.E-3 ) THEN
[1457]	263	! Si/C of diatoms
	264	! ------------------------
	265	! Si/C increases with iron stress and silicate availability
	266	! Si/C is arbitrariliy increased for very high Si concentrations
	267	! to mimic the very high ratios observed in the Southern Ocean (silpot2)
[2823]	268	zlim = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 )
	269	zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
	270	zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0
[935]	271	zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) )
[2823]	272	zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 )
	273	zsilfac = MIN( 5.4, zsilfac * zsilfac2)
	274	zysopt(ji,jj,jk) = grosip * zlim * zsilfac
[935]	275	ENDIF
	276	END DO
	277	END DO
	278	END DO
	279
[2957]	280	! Computation of the limitation term due to a mixed layer deeper than the euphotic depth
[935]	281	DO jj = 1, jpj
	282	DO ji = 1, jpi
	283	zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) )
[2823]	284	zmxlday = zmxltst * zmxltst * r1_rday
	285	zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday )
	286	zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday )
[935]	287	END DO
	288	END DO
[1457]	289
	290	! Mixed-layer effect on production
[935]	291	DO jk = 1, jpkm1
	292	DO jj = 1, jpj
	293	DO ji = 1, jpi
	294	IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
	295	zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj)
	296	zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj)
	297	ENDIF
	298	END DO
	299	END DO
	300	END DO
	301
[2968]	302	! Computation of the various production terms
[935]	303	!CDIR NOVERRCHK
	304	DO jk = 1, jpkm1
	305	!CDIR NOVERRCHK
	306	DO jj = 1, jpj
	307	!CDIR NOVERRCHK
	308	DO ji = 1, jpi
	309	IF( etot(ji,jj,jk) > 1.E-3 ) THEN
[2968]	310	! production terms for nanophyto.
[935]	311	zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2
[2823]	312	zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
	313	!
	314	zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn )
	315	zratio = zratio / fecnm
	316	zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )
	317	zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) &
	318	& * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) &
	319	& * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) ) &
	320	& * zmax * trn(ji,jj,jk,jpphy) * rfact2
[2968]	321	! production terms for diatomees
[935]	322	zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2
[2823]	323	zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
	324	!
	325	zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
	326	zratio = zratio / fecdm
	327	zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )
	328	zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) &
	329	& * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) &
	330	& * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) ) &
	331	& * zmax * trn(ji,jj,jk,jpdia) * rfact2
[935]	332	ENDIF
	333	END DO
	334	END DO
	335	END DO
	336
[2968]	337	IF( ln_newprod ) THEN
	338	!CDIR NOVERRCHK
	339	DO jk = 1, jpkm1
	340	!CDIR NOVERRCHK
	341	DO jj = 1, jpj
	342	!CDIR NOVERRCHK
	343	DO ji = 1, jpi
	344	IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
	345	zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj)
	346	zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
	347	ENDIF
	348	IF( etot(ji,jj,jk) > 1.E-3 ) THEN
	349	! production terms for nanophyto. ( chlorophyll )
	350	znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
	351	zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
	352	zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
	353	zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / ( zpislopead(ji,jj,jk) * znanotot +rtrn)
	354	! production terms for diatomees ( chlorophyll )
	355	zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
	356	zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
	357	zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
	358	zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zdiattot +rtrn )
	359	ENDIF
	360	END DO
	361	END DO
	362	END DO
	363	ELSE
	364	!CDIR NOVERRCHK
	365	DO jk = 1, jpkm1
	366	!CDIR NOVERRCHK
	367	DO jj = 1, jpj
	368	!CDIR NOVERRCHK
	369	DO ji = 1, jpi
	370	IF( etot(ji,jj,jk) > 1.E-3 ) THEN
	371	! production terms for nanophyto. ( chlorophyll )
	372	znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
	373	zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
	374	zprochln(ji,jj,jk) = chlcnm * 144. * zprod / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn)
	375	! production terms for diatomees ( chlorophyll )
	376	zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
	377	zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
	378	zprochld(ji,jj,jk) = chlcdm * 144. * zprod / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn )
	379	ENDIF
	380	END DO
	381	END DO
	382	END DO
	383	ENDIF
	384
[1298]	385	! Update the arrays TRA which contain the biological sources and sinks
[935]	386	DO jk = 1, jpkm1
	387	DO jj = 1, jpj
	388	DO ji =1 ,jpi
	389	zproreg = zprorca(ji,jj,jk) - zpronew(ji,jj,jk)
	390	zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
	391	tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
	392	tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk)
	393	tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2
[1073]	394	tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret
	395	tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret
	396	tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret
	397	tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2
	398	tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2
	399	tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2
	400	tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2
[2823]	401	tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk)
[935]	402	tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) &
[2823]	403	& + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) )
	404	tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk)
	405	tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
[935]	406	tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
[2823]	407	tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
	408	& - rno3 * ( zproreg + zproreg2 )
[935]	409	END DO
	410	END DO
	411	END DO
	412
	413	! Total primary production per year
[2963]	414	tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
[2528]	415
[2730]	416	IF( kt == nitend .AND. jnt == nrdttrc .AND. lwp ) THEN
[2528]	417	WRITE(numout,*) 'Total PP (Gtc) :'
[935]	418	WRITE(numout,) '-------------------- : ',tpp 12. / 1.E12
[2528]	419	WRITE(numout,*)
[935]	420	ENDIF
	421
[2823]	422	#if defined key_diatrc
[935]	423	zrfact2 = 1.e3 * rfact2r
[2823]	424	#if defined key_iomput
	425	IF( jnt == nrdttrc ) THEN
[1836]	426	CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto
	427	CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom
	428	CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto
	429	CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom
	430	CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production
	431	CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom
	432	CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto
[2823]	433	#else
	434	trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:)
	435	trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:)
	436	trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:)
	437	trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:)
	438	trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:)
	439	trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:)
	440	# if ! defined key_kriest
	441	trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:)
	442	# endif
[935]	443	#endif
[2823]	444	#endif
[935]	445
[2715]	446	IF(ln_ctl) THEN ! print mean trends (used for debugging)
[935]	447	WRITE(charout, FMT="('prod')")
	448	CALL prt_ctl_trc_info(charout)
	449	CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
[2715]	450	ENDIF
[935]	451
[2715]	452	IF( wrk_not_released(2, 1,2,3) .OR. &
[2823]	453	wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14,15) ) &
[2715]	454	CALL ctl_stop('p4z_prod: failed to release workspace arrays')
	455	!
[2823]	456	DEALLOCATE( zysopt )
	457	!
[935]	458	END SUBROUTINE p4z_prod
	459
[2715]	460
[935]	461	SUBROUTINE p4z_prod_init
	462	!!----------------------------------------------------------------------
	463	!! * ROUTINE p4z_prod_init *
	464	!!
	465	!! ** Purpose : Initialization of phytoplankton production parameters
	466	!!
[1119]	467	!! ** Method : Read the nampisprod namelist and check the parameters
[2528]	468	!! called at the first timestep (nit000)
[935]	469	!!
[1119]	470	!! ** input : Namelist nampisprod
[935]	471	!!----------------------------------------------------------------------
[2823]	472	!
[2957]	473	NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2, &
[2823]	474	& chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip
[2715]	475	!!----------------------------------------------------------------------
[935]	476
[2823]	477	REWIND( numnatp ) ! read numnat
	478	READ ( numnatp, nampisprod )
[935]	479
	480	IF(lwp) THEN ! control print
	481	WRITE(numout,*) ' '
[1119]	482	WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod'
[935]	483	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
[2957]	484	WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod
	485	WRITE(numout,*) ' mean Si/C ratio grosip =', grosip
	486	WRITE(numout,*) ' P-I slope pislope =', pislope
	487	WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret
	488	WRITE(numout,*) ' excretion ratio of diatoms excret2 =', excret2
	489	IF( ln_newprod )
	490	WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp
	491	WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin
	492	ENDIF
	493	WRITE(numout,*) ' P-I slope for diatoms pislope2 =', pislope2
	494	WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm
	495	WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm
	496	WRITE(numout,*) ' Maximum Fe/C in nanophytoplankton fecnm =', fecnm
	497	WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm
[935]	498	ENDIF
[2715]	499	!
[2823]	500	r1_rday = 1._wp / rday
	501	texcret = 1._wp - excret
	502	texcret2 = 1._wp - excret2
	503	tpp = 0._wp
[2715]	504	!
[935]	505	END SUBROUTINE p4z_prod_init
	506
	507
[2715]	508	INTEGER FUNCTION p4z_prod_alloc()
	509	!!----------------------------------------------------------------------
	510	!! * ROUTINE p4z_prod_alloc *
	511	!!----------------------------------------------------------------------
[2823]	512	ALLOCATE( prmax(jpi,jpj,jpk), quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc )
[2715]	513	!
	514	IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.')
	515	!
	516	END FUNCTION p4z_prod_alloc
[935]	517
	518	#else
	519	!!======================================================================
	520	!! Dummy module : No PISCES bio-model
	521	!!======================================================================
	522	CONTAINS
	523	SUBROUTINE p4z_prod ! Empty routine
	524	END SUBROUTINE p4z_prod
	525	#endif
	526
	527	!!======================================================================
	528	END MODULE p4zprod

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

Download in other formats: