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/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z – NEMO

Context Navigation

source: NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsms.F90 @ 13467

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

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

Download in other formats: