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

Context Navigation

source: NEMO/trunk/src/TOP/PISCES/P4Z/p4zsms.F90 @ 11989

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

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

Download in other formats: