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 @ 12537

Last change on this file since 12537 was 12537, checked in by aumont, 4 years ago
Comments in routines have been revised and significantly augmented
Property svn:keywords set to `Id`
File size: 27.3 KB

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

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

Download in other formats: