Context Navigation

p4zsms.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.

File size: 27.6 KB

Line
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	!!----------------------------------------------------------------------
9	#if defined key_pisces
10	!!----------------------------------------------------------------------
11	!! 'key_pisces' PISCES bio-model
12	!!----------------------------------------------------------------------
13	!! p4zsms : Time loop of passive tracers sms
14	!!----------------------------------------------------------------------
15	USE oce_trc ! shared variables between ocean and passive tracers
16	USE trc ! passive tracers common variables
17	USE trcdta
18	USE sms_pisces ! PISCES Source Minus Sink variables
19	USE p4zbio ! Biological model
20	USE p4zche ! Chemical model
21	USE p4zlys ! Calcite saturation
22	USE p4zflx ! Gas exchange
23	USE p4zsbc ! External source of nutrients
24	USE p4zsed ! Sedimentation
25	USE p4zint ! time interpolation
26	USE p4zrem ! remineralisation
27	USE iom ! I/O manager
28	USE trd_oce ! Ocean trends variables
29	USE trdtrc ! TOP trends variables
30	USE sedmodel ! Sediment model
31	USE prtctl_trc ! print control for debugging
32
33	IMPLICIT NONE
34	PRIVATE
35
36	PUBLIC p4z_sms_init ! called in p4zsms.F90
37	PUBLIC p4z_sms ! called in p4zsms.F90
38
39	REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
40	REAL(wp) :: xfact1, xfact2, xfact3
41	INTEGER :: numco2, numnut, numnit !: logical unit for co2 budget
42
43	!!* Array used to indicate negative tracer values
44	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ???
45
46
47	!!----------------------------------------------------------------------
48	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
49	!! $Id: p4zsms.F90 3320 2012-03-05 16:37:52Z cetlod $
50	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
51	!!----------------------------------------------------------------------
52
53	CONTAINS
54
55	SUBROUTINE p4z_sms( kt )
56	!!---------------------------------------------------------------------
57	!! * ROUTINE p4z_sms *
58	!!
59	!! ** Purpose : Managment of the call to Biological sources and sinks
60	!! routines of PISCES bio-model
61	!!
62	!! ** Method : - at each new day ...
63	!! - several calls of bio and sed ???
64	!! - ...
65	!!---------------------------------------------------------------------
66	!
67	INTEGER, INTENT( in ) :: kt ! ocean time-step index
68	!!
69	INTEGER :: ji, jj, jk, jnt, jn, jl
70	REAL(wp) :: ztra
71	#if defined key_kriest
72	REAL(wp) :: zcoef1, zcoef2
73	#endif
74	CHARACTER (len=25) :: charout
75	!!---------------------------------------------------------------------
76	!
77	IF( nn_timing == 1 ) CALL timing_start('p4z_sms')
78	!
79	IF( kt == nittrc000 ) THEN
80	!
81	ALLOCATE( xnegtr(jpi,jpj,jpk) )
82	!
83	CALL p4z_che ! initialize the chemical constants
84	!
85	IF( .NOT. ln_rsttr ) THEN ; CALL p4z_ph_ini ! set PH at kt=nit000
86	ELSE ; CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields
87	ENDIF
88	!
89	ENDIF
90	!
91	IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers
92	!
93	! ! set time step size (Euler/Leapfrog)
94	IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc(1) ! at nittrc000
95	ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc(1) ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
96	ENDIF
97	!
98	IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
99	rfactr = 1. / rfact
100	rfact2 = rfact / FLOAT( nrdttrc )
101	rfact2r = 1. / rfact2
102	xstep = rfact2 / rday ! Time step duration for biology
103	IF(lwp) WRITE(numout,*)
104	IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdttra(1)
105	IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
106	IF(lwp) WRITE(numout,*)
107	ENDIF
108
109	IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
110	DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
111	trb(:,:,:,jn) = trn(:,:,:,jn)
112	END DO
113	ENDIF
114	!
115	IF( ndayflxtr /= nday_year ) THEN ! New days
116	!
117	ndayflxtr = nday_year
118
119	IF(lwp) write(numout,*)
120	IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year
121	IF(lwp) write(numout,*) '~~~~~~'
122
123	CALL p4z_che ! computation of chemical constants
124	CALL p4z_int( kt ) ! computation of various rates for biogeochemistry
125	!
126	ENDIF
127
128	IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients
129
130	DO jnt = 1, nrdttrc ! Potential time splitting if requested
131	!
132	CALL p4z_bio( kt, jnt ) ! Biology
133	CALL p4z_sed( kt, jnt ) ! Sedimentation
134	CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation
135	CALL p4z_flx( kt, jnt ) ! Compute surface fluxes
136	!
137	xnegtr(:,:,:) = 1.e0
138	DO jn = jp_pcs0, jp_pcs1
139	DO jk = 1, jpk
140	DO jj = 1, jpj
141	DO ji = 1, jpi
142	IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
143	ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
144	xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
145	ENDIF
146	END DO
147	END DO
148	END DO
149	END DO
150	! ! where at least 1 tracer concentration becomes negative
151	! !
152	DO jn = jp_pcs0, jp_pcs1
153	trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
154	END DO
155	!
156	DO jn = jp_pcs0, jp_pcs1
157	tra(:,:,:,jn) = 0._wp
158	END DO
159	!
160	IF( ln_top_euler ) THEN
161	DO jn = jp_pcs0, jp_pcs1
162	trn(:,:,:,jn) = trb(:,:,:,jn)
163	END DO
164	ENDIF
165	END DO
166
167	#if defined key_kriest
168	!
169	zcoef1 = 1.e0 / xkr_massp
170	zcoef2 = 1.e0 / xkr_massp / 1.1
171	DO jk = 1,jpkm1
172	trb(:,:,jk,jpnum) = MAX( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk) )
173	trb(:,:,jk,jpnum) = MIN( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2 )
174	END DO
175	!
176	#endif
177	!
178	!
179	IF( l_trdtrc ) THEN
180	DO jn = jp_pcs0, jp_pcs1
181	CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends
182	END DO
183	END IF
184	!
185	IF( lk_sed ) THEN
186	!
187	CALL sed_model( kt ) ! Main program of Sediment model
188	!
189	DO jn = jp_pcs0, jp_pcs1
190	CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
191	END DO
192	!
193	ENDIF
194	!
195	IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' ) !* Write PISCES informations in restart file
196	!
197
198	IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt ) ! Mass conservation checking
199
200	IF ( lwm .AND. kt == nittrc000 ) CALL FLUSH ( numonp ) ! flush output namelist PISCES
201	IF( nn_timing == 1 ) CALL timing_stop('p4z_sms')
202	!
203	!
204	END SUBROUTINE p4z_sms
205
206	SUBROUTINE p4z_sms_init
207	!!----------------------------------------------------------------------
208	!! * p4z_sms_init *
209	!!
210	!! ** Purpose : read PISCES namelist
211	!!
212	!! ** input : file 'namelist.trc.s' containing the following
213	!! namelist: natext, natbio, natsms
214	!! natkriest ("key_kriest")
215	!!----------------------------------------------------------------------
216	NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max
217	#if defined key_kriest
218	NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_ncontent, xkr_mass_min, xkr_mass_max
219	#endif
220	NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
221	NAMELIST/nampismass/ ln_check_mass
222	INTEGER :: ios ! Local integer output status for namelist read
223	!!----------------------------------------------------------------------
224
225	REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables
226	READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
227	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp )
228
229	REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables
230	READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
231	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp )
232	IF(lwm) WRITE ( numonp, nampisbio )
233
234	IF(lwp) THEN ! control print
235	WRITE(numout,*) ' Namelist : nampisbio'
236	WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc
237	WRITE(numout,*) ' POC sinking speed wsbio =', wsbio
238	WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort
239	WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3
240	WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2
241	WRITE(numout,*) ' Maximum number of iterations for POC niter1max =', niter1max
242	WRITE(numout,*) ' Maximum number of iterations for GOC niter2max =', niter2max
243	ENDIF
244
245	#if defined key_kriest
246
247	! ! nampiskrp : kriest parameters
248	! ! -----------------------------
249	REWIND( numnatp_ref ) ! Namelist nampiskrp in reference namelist : Pisces Kriest
250	READ ( numnatp_ref, nampiskrp, IOSTAT = ios, ERR = 903)
251	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in reference namelist', lwp )
252
253	REWIND( numnatp_cfg ) ! Namelist nampiskrp in configuration namelist : Pisces Kriest
254	READ ( numnatp_cfg, nampiskrp, IOSTAT = ios, ERR = 904 )
255	904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in configuration namelist', lwp )
256	IF(lwm) WRITE ( numonp, nampiskrp )
257
258	IF(lwp) THEN
259	WRITE(numout,*)
260	WRITE(numout,*) ' Namelist : nampiskrp'
261	WRITE(numout,*) ' Sinking exponent xkr_eta = ', xkr_eta
262	WRITE(numout,*) ' N content exponent xkr_zeta = ', xkr_zeta
263	WRITE(numout,*) ' N content factor xkr_ncontent = ', xkr_ncontent
264	WRITE(numout,*) ' Minimum mass for Aggregates xkr_mass_min = ', xkr_mass_min
265	WRITE(numout,*) ' Maximum mass for Aggregates xkr_mass_max = ', xkr_mass_max
266	WRITE(numout,*)
267	ENDIF
268
269
270	! Computation of some variables
271	xkr_massp = xkr_ncontent * 7.625 * xkr_mass_min**xkr_zeta
272
273	#endif
274
275	REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping
276	READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
277	905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp )
278
279	REWIND( numnatp_cfg ) ! Namelist nampisdmp in configuration namelist : Pisces damping
280	READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
281	906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp )
282	IF(lwm) WRITE ( numonp, nampisdmp )
283
284	IF(lwp) THEN ! control print
285	WRITE(numout,*)
286	WRITE(numout,*) ' Namelist : nampisdmp'
287	WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp
288	WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp
289	WRITE(numout,*) ' '
290	ENDIF
291
292	REWIND( numnatp_ref ) ! Namelist nampismass in reference namelist : Pisces mass conservation check
293	READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
294	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp )
295
296	REWIND( numnatp_cfg ) ! Namelist nampismass in configuration namelist : Pisces mass conservation check
297	READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
298	908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp )
299	IF(lwm) WRITE ( numonp, nampismass )
300
301	IF(lwp) THEN ! control print
302	WRITE(numout,*) ' '
303	WRITE(numout,*) ' Namelist parameter for mass conservation checking'
304	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
305	WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
306	ENDIF
307
308	END SUBROUTINE p4z_sms_init
309
310	SUBROUTINE p4z_ph_ini
311	!!---------------------------------------------------------------------
312	!! * ROUTINE p4z_ini_ph *
313	!!
314	!! ** Purpose : Initialization of chemical variables of the carbon cycle
315	!!---------------------------------------------------------------------
316	INTEGER :: ji, jj, jk
317	REAL(wp) :: zcaralk, zbicarb, zco3
318	REAL(wp) :: ztmas, ztmas1
319	!!---------------------------------------------------------------------
320
321	! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???)
322	! --------------------------------------------------------
323	DO jk = 1, jpk
324	DO jj = 1, jpj
325	DO ji = 1, jpi
326	ztmas = tmask(ji,jj,jk)
327	ztmas1 = 1. - tmask(ji,jj,jk)
328	zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) )
329	zco3 = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
330	zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk )
331	hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
332	END DO
333	END DO
334	END DO
335	!
336	END SUBROUTINE p4z_ph_ini
337
338	SUBROUTINE p4z_rst( kt, cdrw )
339	!!---------------------------------------------------------------------
340	!! * ROUTINE p4z_rst *
341	!!
342	!! ** Purpose : Read or write variables in restart file:
343	!!
344	!! WRITE(READ) mode:
345	!! kt : number of time step since the begining of the experiment at the
346	!! end of the current(previous) run
347	!!---------------------------------------------------------------------
348	INTEGER , INTENT(in) :: kt ! ocean time-step
349	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
350	!
351	INTEGER :: ji, jj, jk
352	REAL(wp) :: zcaralk, zbicarb, zco3
353	REAL(wp) :: ztmas, ztmas1
354	!!---------------------------------------------------------------------
355
356	IF( TRIM(cdrw) == 'READ' ) THEN
357	!
358	IF(lwp) WRITE(numout,*)
359	IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
360	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
361	!
362	IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
363	CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) )
364	ELSE
365	! hi(:,:,:) = 1.e-9
366	CALL p4z_ph_ini
367	ENDIF
368	CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
369	IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
370	CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) )
371	ELSE
372	xksimax(:,:) = xksi(:,:)
373	ENDIF
374	!
375	IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN ! cumulative total flux of carbon
376	CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum )
377	ELSE
378	t_oce_co2_flx_cum = 0._wp
379	ENDIF
380	!
381	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
382	IF( kt == nitrst ) THEN
383	IF(lwp) WRITE(numout,*)
384	IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file kt =', kt
385	IF(lwp) WRITE(numout,*) '~~~~~~~'
386	ENDIF
387	CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
388	CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
389	CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
390	CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
391	ENDIF
392	!
393	END SUBROUTINE p4z_rst
394
395	SUBROUTINE p4z_dmp( kt )
396	!!----------------------------------------------------------------------
397	!! * p4z_dmp *
398	!!
399	!! ** purpose : Relaxation of some tracers
400	!!----------------------------------------------------------------------
401	!
402	INTEGER, INTENT( in ) :: kt ! time step
403	!
404	REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
405	REAL(wp) :: po4mean = 2.165 ! mean value of phosphates
406	REAL(wp) :: no3mean = 30.90 ! mean value of nitrate
407	REAL(wp) :: silmean = 91.51 ! mean value of silicate
408	!
409	REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
410	REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
411	!!---------------------------------------------------------------------
412
413
414	IF(lwp) WRITE(numout,*)
415	IF(lwp) WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
416	IF(lwp) WRITE(numout,*)
417
418	IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) !
419	! ! --------------------------- !
420	! set total alkalinity, phosphate, nitrate & silicate
421	zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6
422
423	zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea
424	zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
425	zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
426	zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
427
428	IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn
429	trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
430
431	IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn
432	trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
433
434	IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn
435	trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
436
437	IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn
438	trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
439	!
440	!
441	IF( .NOT. ln_top_euler ) THEN
442	zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea
443	zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
444	zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
445	zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
446
447	IF(lwp) WRITE(numout,*) ' '
448	IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb
449	trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
450
451	IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb
452	trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
453
454	IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb
455	trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
456
457	IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb
458	trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
459	ENDIF
460	!
461	ENDIF
462	!
463	END SUBROUTINE p4z_dmp
464
465
466	SUBROUTINE p4z_chk_mass( kt )
467	!!----------------------------------------------------------------------
468	!! * ROUTINE p4z_chk_mass *
469	!!
470	!! ** Purpose : Mass conservation check
471	!!
472	!!---------------------------------------------------------------------
473	!
474	INTEGER, INTENT( in ) :: kt ! ocean time-step index
475	REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
476	CHARACTER(LEN=100) :: cltxt
477	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
478	INTEGER :: jk
479	!!----------------------------------------------------------------------
480
481	!
482	!!---------------------------------------------------------------------
483
484	IF( kt == nittrc000 ) THEN
485	IF( ln_check_mass .AND. lwp) THEN ! Open budget file of NO3, ALK, Si, Fer
486	CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
487	CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
488	CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
489	xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr
490	xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr
491	xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s
492	cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron'
493	IF( lwp ) WRITE(numnut,*) TRIM(cltxt)
494	IF( lwp ) WRITE(numnut,*)
495	ENDIF
496	ENDIF
497
498	!
499	IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
500	! Compute the budget of NO3, ALK, Si, Fer
501	no3budget = glob_sum( ( trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) &
502	& + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
503	& + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
504	& + trn(:,:,:,jppoc) &
505	#if ! defined key_kriest
506	& + trn(:,:,:,jpgoc) &
507	#endif
508	& + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
509	!
510	no3budget = no3budget / areatot
511	CALL iom_put( "pno3tot", no3budget )
512	ENDIF
513	!
514	IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
515	po4budget = glob_sum( ( trn(:,:,:,jppo4) &
516	& + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
517	& + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
518	& + trn(:,:,:,jppoc) &
519	#if ! defined key_kriest
520	& + trn(:,:,:,jpgoc) &
521	#endif
522	& + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
523	po4budget = po4budget / areatot
524	CALL iom_put( "ppo4tot", po4budget )
525	ENDIF
526	!
527	IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
528	silbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) &
529	& + trn(:,:,:,jpdsi) ) * cvol(:,:,:) )
530	!
531	silbudget = silbudget / areatot
532	CALL iom_put( "psiltot", silbudget )
533	ENDIF
534	!
535	IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
536	alkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 &
537	& + trn(:,:,:,jptal) &
538	& + trn(:,:,:,jpcal) * 2. ) * cvol(:,:,:) )
539	!
540	alkbudget = alkbudget / areatot
541	CALL iom_put( "palktot", alkbudget )
542	ENDIF
543	!
544	IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
545	ferbudget = glob_sum( ( trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) &
546	& + trn(:,:,:,jpdfe) &
547	#if ! defined key_kriest
548	& + trn(:,:,:,jpbfe) &
549	#endif
550	& + trn(:,:,:,jpsfe) &
551	& + trn(:,:,:,jpzoo) * ferat3 &
552	& + trn(:,:,:,jpmes) * ferat3 ) * cvol(:,:,:) )
553	!
554	ferbudget = ferbudget / areatot
555	CALL iom_put( "pfertot", ferbudget )
556	ENDIF
557	!
558
559	! Global budget of N SMS : denitrification in the water column and in the sediment
560	! nitrogen fixation by the diazotrophs
561	! --------------------------------------------------------------------------------
562	IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
563	znitrpottot = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
564	CALL iom_put( "tnfix" , znitrpottot * 1.e+3 * rno3 ) ! Global nitrogen fixation molC/l to molN/m3
565	ENDIF
566	!
567	IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
568	zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
569	CALL iom_put( "tdenit" , zrdenittot * 1.e+3 * rno3 ) ! Total denitrification molC/l to molN/m3
570	ENDIF
571	!
572	IF( iom_use( "Sdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
573	zsdenittot = glob_sum ( sdenit(:,:) * e1e2t(:,:) )
574	CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) ) ! Nitrate reduction in the sediments
575	ENDIF
576
577	IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
578	t_atm_co2_flx = t_atm_co2_flx / glob_sum( e1e2t(:,:) )
579	t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 )
580	tpp = tpp * 1000. * xfact1
581	t_oce_co2_exp = t_oce_co2_exp * 1000. * xfact1
582	IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
583	IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget * 1.e+06, &
584	& no3budget * rno3 * 1.e+06, &
585	& po4budget * po4r * 1.e+06, &
586	& silbudget * 1.e+06, &
587	& ferbudget * 1.e+09
588	!
589	IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2 , &
590	& zrdenittot * xfact2 , &
591	& zsdenittot * xfact2
592
593	ENDIF
594	!
595	9000 FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
596	9100 FORMAT(i8,5e18.10)
597	9200 FORMAT(i8,3f10.5)
598
599	!
600	END SUBROUTINE p4z_chk_mass
601
602	#else
603	!!======================================================================
604	!! Dummy module : No PISCES bio-model
605	!!======================================================================
606	CONTAINS
607	SUBROUTINE p4z_sms( kt ) ! Empty routine
608	INTEGER, INTENT( in ) :: kt
609	WRITE(,) 'p4z_sms: You should not have seen this print! error?', kt
610	END SUBROUTINE p4z_sms
611	#endif
612
613	!!======================================================================
614	END MODULE p4zsms

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90 @ 5870

Download in other formats: