Context Navigation

trcrst.F90

Last change on this file was 11990, checked in by dford, 4 years ago
Get the nitrogen balancing working with 3D chlorophyll increments.
File size: 44.0 KB

Line
1	MODULE trcrst
2	!!======================================================================
3	!! * MODULE trcrst *
4	!! TOP : Manage the passive tracer restart
5	!!======================================================================
6	!! History : - ! 1991-03 () original code
7	!! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90
8	!! - ! 2005-10 (C. Ethe) print control
9	!! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture
10	!!----------------------------------------------------------------------
11	#if defined key_top
12	!!----------------------------------------------------------------------
13	!! 'key_top' TOP models
14	!!----------------------------------------------------------------------
15	!!----------------------------------------------------------------------
16	!! trc_rst : Restart for passive tracer
17	!!----------------------------------------------------------------------
18	!!----------------------------------------------------------------------
19	!! 'key_top' TOP models
20	!!----------------------------------------------------------------------
21	!! trc_rst_opn : open restart file
22	!! trc_rst_read : read restart file
23	!! trc_rst_wri : write restart file
24	!!----------------------------------------------------------------------
25	USE oce_trc
26	USE trc
27	USE trcnam_trp
28	USE iom
29	USE ioipsl, ONLY : ju2ymds ! for calendar
30	USE daymod
31	!! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs
32	USE par_medusa
33	USE sms_medusa
34	USE trcsms_medusa
35	!!
36	#if defined key_idtra
37	USE trcsms_idtra
38	#endif
39	!!
40	#if defined key_cfc
41	USE trcsms_cfc
42	#endif
43	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
44	USE sbc_oce, ONLY: lk_oasis
45	USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl !! Coupling variable
46	USE trcstat
47	#if defined key_foam_medusa
48	USE obs_const, ONLY: obfillflt ! Observation operator fill value
49	#endif
50
51	IMPLICIT NONE
52	PRIVATE
53
54	PUBLIC trc_rst_opn ! called by ???
55	PUBLIC trc_rst_read ! called by ???
56	PUBLIC trc_rst_wri ! called by ???
57	PUBLIC trc_rst_cal
58	PUBLIC trc_rst_stat
59	#if defined key_medusa && defined key_roam
60	PUBLIC trc_rst_conserve
61	#endif
62
63	!! * Substitutions
64	# include "top_substitute.h90"
65
66	CONTAINS
67
68	SUBROUTINE trc_rst_opn( kt )
69	!!----------------------------------------------------------------------
70	!! * trc_rst_opn *
71	!!
72	!! ** purpose : output of sea-trc variable in a netcdf file
73	!!----------------------------------------------------------------------
74	INTEGER, INTENT(in) :: kt ! number of iteration
75	INTEGER :: iyear, imonth, iday
76	REAL (wp) :: zsec
77	REAL (wp) :: zfjulday
78	!
79	CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character
80	CHARACTER(LEN=50) :: clname ! trc output restart file name
81	CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file
82	!!----------------------------------------------------------------------
83	!
84	IF( lk_offline ) THEN
85	IF( kt == nittrc000 ) THEN
86	lrst_trc = .FALSE.
87	IF( ln_rst_list ) THEN
88	nrst_lst = 1
89	nitrst = nstocklist( nrst_lst )
90	ELSE
91	nitrst = nitend
92	ENDIF
93	ENDIF
94
95	IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
96	! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
97	nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing
98	IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run
99	ENDIF
100	ELSE
101	IF( kt == nittrc000 ) lrst_trc = .FALSE.
102	ENDIF
103
104	! to get better performances with NetCDF format:
105	! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
106	! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1
107	IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
108	IF ( ln_rstdate ) THEN
109	!! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name
110	!! -- the condition to open the rst file is not the same than for the dynamic rst.
111	!! -- here it - for an obscure reason - is open 2 time-step before the restart writing process
112	!! instead of 1.
113	!! -- i am not sure if someone forgot +1 in the if loop condition as
114	!! it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is
115	!! nitrst - 2*nn_dttrc
116	!! -- nevertheless we didn't wanted to broke something already working
117	!! and just adapted the part we added.
118	!! -- So instead of calling ju2ymds( fjulday + (rdttra(1))
119	!! we call ju2ymds( fjulday + (2*rdttra(1))
120	!!--------------------------------------------------------------------
121	zfjulday = fjulday + (2*rdttra(1)) / rday
122	IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error
123	CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec )
124	WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
125	ELSE
126	! beware of the format used to write kt (default is i8.8, that should be large enough)
127	IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst
128	ELSE ; WRITE(clkt,'(i8.8)') nitrst
129	ENDIF
130	ENDIF
131	! create the file
132	IF(lwp) WRITE(numout,*)
133	clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
134	clpath = TRIM(cn_trcrst_outdir)
135	IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
136	IF(lwp) WRITE(numout,*) &
137	' open trc restart.output NetCDF file: ',TRIM(clpath)//clname
138	CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
139	lrst_trc = .TRUE.
140	ENDIF
141	!
142	END SUBROUTINE trc_rst_opn
143
144	SUBROUTINE trc_rst_read
145	!!----------------------------------------------------------------------
146	!! * trc_rst_opn *
147	!!
148	!! ** purpose : read passive tracer fields in restart files
149	!!----------------------------------------------------------------------
150	INTEGER :: jn, jl
151	!! AXY (05/11/13): temporary variables
152	REAL(wp) :: fq0,fq1,fq2
153
154	!!----------------------------------------------------------------------
155	!
156	IF(lwp) WRITE(numout,*)
157	IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
158	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
159
160	! READ prognostic variables and computes diagnostic variable
161	DO jn = 1, jptra
162	CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
163	trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:)
164	END DO
165
166	DO jn = 1, jptra
167	CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
168	trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:)
169	END DO
170	!
171	!! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
172	!! call to MEDUSA-2 at this point; this suggests that the FCM
173	!! version of NEMO date significantly earlier than the current
174	!! version
175
176	#if defined key_medusa
177	!! AXY (13/01/12): check if the restart contains sediment fields;
178	!! this is only relevant for simulations that include
179	!! biogeochemistry and are restarted from earlier runs
180	!! in which there was no sediment component
181	!!
182	IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
183	!! YES; in which case read them
184	!!
185	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
186	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) )
187	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) )
188	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
189	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
190	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
191	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
192	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) )
193	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) )
194	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
195	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
196	ELSE
197	!! NO; in which case set them to zero
198	!!
199	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
200	zb_sed_n(:,:) = 0.0 !! organic N
201	zn_sed_n(:,:) = 0.0
202	zb_sed_fe(:,:) = 0.0 !! organic Fe
203	zn_sed_fe(:,:) = 0.0
204	zb_sed_si(:,:) = 0.0 !! inorganic Si
205	zn_sed_si(:,:) = 0.0
206	zb_sed_c(:,:) = 0.0 !! organic C
207	zn_sed_c(:,:) = 0.0
208	zb_sed_ca(:,:) = 0.0 !! inorganic C
209	zn_sed_ca(:,:) = 0.0
210	ENDIF
211	!!
212	!! calculate stats on these fields
213	IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
214	call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N')
215	call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
216	call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
217	call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
218	call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
219	!!
220	!! AXY (07/07/15): read in temporally averaged fields for DMS
221	!! calculations
222	!!
223	IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
224	!! YES; in which case read them
225	!!
226	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
227	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN', zb_dms_chn(:,:) )
228	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN', zn_dms_chn(:,:) )
229	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD', zb_dms_chd(:,:) )
230	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD', zn_dms_chd(:,:) )
231	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD', zb_dms_mld(:,:) )
232	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD', zn_dms_mld(:,:) )
233	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR', zb_dms_qsr(:,:) )
234	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR', zn_dms_qsr(:,:) )
235	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN', zb_dms_din(:,:) )
236	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN', zn_dms_din(:,:) )
237	ELSE
238	!! NO; in which case set them to zero
239	!!
240	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
241	zb_dms_chn(:,:) = 0.0 !! CHN
242	zn_dms_chn(:,:) = 0.0
243	zb_dms_chd(:,:) = 0.0 !! CHD
244	zn_dms_chd(:,:) = 0.0
245	zb_dms_mld(:,:) = 0.0 !! MLD
246	zn_dms_mld(:,:) = 0.0
247	zb_dms_qsr(:,:) = 0.0 !! QSR
248	zn_dms_qsr(:,:) = 0.0
249	zb_dms_din(:,:) = 0.0 !! DIN
250	zn_dms_din(:,:) = 0.0
251	ENDIF
252	!!
253	!! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
254	!! -- needed for the coupling with atm
255	IF( iom_varid( numrtr, 'N_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN
256	IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...'
257	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf', zb_dms_srf(:,:) )
258	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf', zn_dms_srf(:,:) )
259	ELSE
260	IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...'
261	zb_dms_srf(:,:) = 0.0 !! DMS
262	zn_dms_srf(:,:) = 0.0
263	ENDIF
264	IF (lk_oasis) THEN
265	DMS_out_cpl(:,:) = zn_dms_srf(:,:) !! Coupling variable
266	END IF
267	!!
268	IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN
269	IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...'
270	CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx', zb_co2_flx(:,:) )
271	CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx', zn_co2_flx(:,:) )
272	ELSE
273	IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...'
274	zb_co2_flx(:,:) = 0.0 !! CO2 flx
275	zn_co2_flx(:,:) = 0.0
276	ENDIF
277	IF (lk_oasis) THEN
278	CO2Flux_out_cpl(:,:) = zn_co2_flx(:,:) !! Coupling variable
279	END IF
280	!!
281	!! JPALM 02-06-2017 -- in complement to DMS surf
282	!! -- the atm model needs surf Chl
283	!! as proxy of org matter from the ocean
284	!! -- needed for the coupling with atm
285	!! 07-12-2017 -- To make things cleaner, we want to store an
286	!! unscaled Chl field in the restart and only
287	!! scale it when reading it in.
288
289	IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN
290	IF(lwp) WRITE(numout,*) 'Chl cpl concentration - reading in ... - scale by ', scl_chl
291	CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf', zn_chl_srf(:,:) )
292	ELSE
293	IF(lwp) WRITE(numout,*) 'set Chl coupled concentration - scaled by ', scl_chl
294	zn_chl_srf(:,:) = MAX( 0.0, (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6 )
295	ENDIF
296	IF (lk_oasis) THEN
297	chloro_out_cpl(:,:) = zn_chl_srf(:,:) * scl_chl !! Coupling variable
298	END IF
299	!!
300	!! calculate stats on these fields
301	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
302	call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
303	call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
304	call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
305	call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
306	call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
307	call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
308	call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
309	IF (lk_oasis) THEN
310	call trc_rst_dia_stat(chloro_out_cpl(:,:), 'CHL cpl')
311	END IF
312	!!
313	!! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart
314	!! -- needed for monthly call of carb-chem routine and better reproducibility
315	# if defined key_roam
316	IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN
317	IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...'
318	CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D' , f3_pH(:,:,:) )
319	CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D', f3_h2co3(:,:,:) )
320	CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' , f3_hco3(:,:,:) )
321	CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D' , f3_co3(:,:,:) )
322	CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D', f3_omcal(:,:,:) )
323	CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D', f3_omarg(:,:,:) )
324	CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' , f2_ccd_cal(:,:) )
325	CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' , f2_ccd_arg(:,:) )
326	!!
327	IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...'
328	call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf')
329	call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf')
330	call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' )
331	call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' )
332	call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf')
333	call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf')
334	call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL')
335	call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG')
336
337	ELSE
338	IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... '
339	IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not '
340	IF(lwp) WRITE(numout,) 'Check if mod(ktrdt,2592000) == rdt'
341	IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...'
342	ENDIF
343	!
344	# if defined key_foam_medusa
345	!! 2D fields of pCO2 and fCO2 for observation operator on first timestep
346	IF( iom_varid( numrtr, 'PCO2W', ldstop = .FALSE. ) > 0 ) THEN
347	IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 present - reading in ...'
348	CALL iom_get( numrtr, jpdom_autoglo, 'PCO2W', f2_pco2w(:,:) )
349	CALL iom_get( numrtr, jpdom_autoglo, 'FCO2W', f2_fco2w(:,:) )
350	ELSE
351	IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 absent - setting to fill ...'
352	f2_pco2w(:,:) = obfillflt * tmask(:,:,1)
353	f2_fco2w(:,:) = obfillflt * tmask(:,:,1)
354	ENDIF
355	# endif
356	# endif
357	# if defined key_foam_medusa
358	!! Fields for ocean colour assimilation on first timestep
359	IF( iom_varid( numrtr, 'pgrow_avg', ldstop = .FALSE. ) > 0 ) THEN
360	IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...'
361	CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg', pgrow_avg(:,:) )
362	CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg', ploss_avg(:,:) )
363	CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg', phyt_avg(:,:) )
364	CALL iom_get( numrtr, jpdom_autoglo, 'mld_max', mld_max(:,:) )
365	ELSE
366	IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg absent - setting to zero ...'
367	pgrow_avg(:,:) = 0.0
368	ploss_avg(:,:) = 0.0
369	phyt_avg(:,:) = 0.0
370	mld_max(:,:) = 0.0
371	ENDIF
372	IF( iom_varid( numrtr, 'pgrow_avg_3d', ldstop = .FALSE. ) > 0 ) THEN
373	IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...'
374	CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg_3d', pgrow_avg_3d(:,:,:) )
375	CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg_3d', ploss_avg_3d(:,:,:) )
376	CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg_3d', phyt_avg_3d(:,:,:) )
377	ELSE
378	IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg_3d absent - setting to zero ...'
379	pgrow_avg_3d(:,:,:) = 0.0
380	ploss_avg_3d(:,:,:) = 0.0
381	phyt_avg_3d(:,:,:) = 0.0
382	ENDIF
383	# endif
384
385	#endif
386	!
387	#if defined key_idtra
388	!! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and
389	!! writting here undre their key.
390	!! problems in CFC restart, maybe because of this...
391	!! and pb in idtra diag or diad-restart writing.
392	!!----------------------------------------------------------------------
393	IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN
394	!! YES; in which case read them
395	!!
396	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...'
397	CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,1) )
398	ELSE
399	!! NO; in which case set them to zero
400	!!
401	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...'
402	qint_idtra(:,:,1) = 0.0 !! CHN
403	ENDIF
404	!!
405	!! calculate stats on these fields
406	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
407	call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
408	#endif
409	!
410	#if defined key_cfc
411	DO jl = 1, jp_cfc
412	jn = jp_cfc0 + jl - 1
413	IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN
414	!! YES; in which case read them
415	!!
416	IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...'
417	CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
418	ELSE
419	!! NO; in which case set them to zero
420	!!
421	IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...'
422	qint_cfc(:,:,jn) = 0.0 !! CHN
423	ENDIF
424	!!
425	!! calculate stats on these fields
426	IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
427	call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
428	END DO
429	#endif
430	!
431	END SUBROUTINE trc_rst_read
432
433	SUBROUTINE trc_rst_wri( kt )
434	!!----------------------------------------------------------------------
435	!! * trc_rst_wri *
436	!!
437	!! ** purpose : write passive tracer fields in restart files
438	!!----------------------------------------------------------------------
439	INTEGER, INTENT( in ) :: kt ! ocean time-step index
440	!!
441	INTEGER :: jn, jl
442	REAL(wp) :: zarak0
443	!! AXY (05/11/13): temporary variables
444	REAL(wp) :: fq0,fq1,fq2
445	!!----------------------------------------------------------------------
446	!
447	CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) ) ! surface passive tracer time step
448	! prognostic variables
449	! --------------------
450	DO jn = 1, jptra
451	CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
452	END DO
453
454	DO jn = 1, jptra
455	CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
456	END DO
457
458	!! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
459	!! call to MEDUSA-2 at this point; this suggests that the FCM
460	!! version of NEMO date significantly earlier than the current
461	!! version
462
463	#if defined key_medusa
464	!! AXY (13/01/12): write out "before" and "now" state of seafloor
465	!! sediment pools into restart; this happens
466	!! whether or not the pools are to be used by
467	!! MEDUSA (which is controlled by a switch in the
468	!! namelist_top file)
469	!!
470	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
471	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N', zb_sed_n(:,:) )
472	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N', zn_sed_n(:,:) )
473	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) )
474	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) )
475	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) )
476	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) )
477	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C', zb_sed_c(:,:) )
478	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C', zn_sed_c(:,:) )
479	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) )
480	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) )
481	!!
482	!! calculate stats on these fields
483	IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
484	call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N')
485	call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
486	call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
487	call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
488	call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
489	!!
490	!! AXY (07/07/15): write out temporally averaged fields for DMS
491	!! calculations
492	!!
493	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
494	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN', zb_dms_chn(:,:) )
495	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN', zn_dms_chn(:,:) )
496	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD', zb_dms_chd(:,:) )
497	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD', zn_dms_chd(:,:) )
498	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD', zb_dms_mld(:,:) )
499	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD', zn_dms_mld(:,:) )
500	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR', zb_dms_qsr(:,:) )
501	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR', zn_dms_qsr(:,:) )
502	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN', zb_dms_din(:,:) )
503	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN', zn_dms_din(:,:) )
504	!! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
505	!! -- needed for the coupling with atm
506	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf', zb_dms_srf(:,:) )
507	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf', zn_dms_srf(:,:) )
508	CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx', zb_co2_flx(:,:) )
509	CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx', zn_co2_flx(:,:) )
510	!! JPALM 07-12-2017 -- To make things cleaner, we want to store an
511	!! unscaled Chl field in the restart and only
512	!! scale it when reading it in.
513	CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf', zn_chl_srf(:,:) )
514	!!
515	!! calculate stats on these fields
516	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
517	call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
518	call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
519	call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
520	call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
521	call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
522	call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
523	call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
524	call trc_rst_dia_stat(zn_chl_srf(:,:), 'unscaled CHL cpl')
525	!!
526	IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.'
527	call trc_rst_dia_stat(dust(:,:), 'Dust dep')
528	call trc_rst_dia_stat(zirondep(:,:), 'Iron dep')
529	!!
530	!!
531	!! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart
532	!! -- needed for monthly call of carb-chem routine and better reproducibility
533	# if defined key_roam
534	IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...'
535	CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D' , f3_pH(:,:,:) )
536	CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D', f3_h2co3(:,:,:) )
537	CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' , f3_hco3(:,:,:) )
538	CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D' , f3_co3(:,:,:) )
539	CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D', f3_omcal(:,:,:) )
540	CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D', f3_omarg(:,:,:) )
541	CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' , f2_ccd_cal(:,:) )
542	CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' , f2_ccd_arg(:,:) )
543	!!
544	IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...'
545	call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf')
546	call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf')
547	call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' )
548	call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' )
549	call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf')
550	call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf')
551	call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL')
552	call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG')
553	!!
554	# if defined key_foam_medusa
555	!! Fields for observation operator on first timestep
556	IF(lwp) WRITE(numout,*) ' MEDUSA OBS fields - writing out ...'
557	CALL iom_rstput( kt, nitrst, numrtw, 'PCO2W', f2_pco2w(:,:) )
558	CALL iom_rstput( kt, nitrst, numrtw, 'FCO2W', f2_fco2w(:,:) )
559	# endif
560	# endif
561	# if defined key_foam_medusa
562	!! Fields for assimilation on first timestep
563	IF(lwp) WRITE(numout,*) ' MEDUSA ASM fields - writing out ...'
564	CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg', pgrow_avg(:,:) )
565	CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg', ploss_avg(:,:) )
566	CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg', phyt_avg(:,:) )
567	CALL iom_rstput( kt, nitrst, numrtw, 'mld_max', mld_max(:,:) )
568	CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg_3d', pgrow_avg_3d(:,:,:) )
569	CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg_3d', ploss_avg_3d(:,:,:) )
570	CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg_3d', phyt_avg_3d(:,:,:) )
571	# endif
572	!!
573	#endif
574	!
575	#if defined key_idtra
576	!! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and
577	!! writting here undre their key.
578	!! problems in CFC restart, maybe because of this...
579	!! and pb in idtra diag or diad-restart writing.
580	!!----------------------------------------------------------------------
581	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...'
582	CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) )
583	!!
584	!! calculate stats on these fields
585	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
586	call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
587	#endif
588	!
589	#if defined key_cfc
590	DO jl = 1, jp_cfc
591	jn = jp_cfc0 + jl - 1
592	IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...'
593	CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
594	!!
595	!! calculate stats on these fields
596	IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
597	call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
598	END DO
599	#endif
600	!
601
602	IF( kt == nitrst ) THEN
603	CALL trc_rst_stat ! statistics
604	#if defined key_medusa && defined key_roam
605	CALL trc_rst_conserve ! conservation check
606	#endif
607	CALL iom_close( numrtw ) ! close the restart file (only at last time step)
608	#if ! defined key_trdmxl_trc
609	lrst_trc = .FALSE.
610	#endif
611	IF( lk_offline .AND. ln_rst_list ) THEN
612	nrst_lst = nrst_lst + 1
613	nitrst = nstocklist( nrst_lst )
614	ENDIF
615	ENDIF
616	!
617	END SUBROUTINE trc_rst_wri
618
619
620	SUBROUTINE trc_rst_cal( kt, cdrw )
621	!!---------------------------------------------------------------------
622	!! * ROUTINE trc_rst_cal *
623	!!
624	!! ** Purpose : Read or write calendar in restart file:
625	!!
626	!! WRITE(READ) mode:
627	!! kt : number of time step since the begining of the experiment at the
628	!! end of the current(previous) run
629	!! adatrj(0) : number of elapsed days since the begining of the experiment at the
630	!! end of the current(previous) run (REAL -> keep fractions of day)
631	!! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer)
632	!!
633	!! According to namelist parameter nrstdt,
634	!! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary).
635	!! nn_rsttr = 1 we verify that nittrc000 is equal to the last
636	!! time step of previous run + 1.
637	!! In both those options, the exact duration of the experiment
638	!! since the beginning (cumulated duration of all previous restart runs)
639	!! is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
640	!! This is valid is the time step has remained constant.
641	!!
642	!! nn_rsttr = 2 the duration of the experiment in days (adatrj)
643	!! has been stored in the restart file.
644	!!----------------------------------------------------------------------
645	INTEGER , INTENT(in) :: kt ! ocean time-step
646	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
647	!
648	INTEGER :: jlibalt = jprstlib
649	LOGICAL :: llok
650	REAL(wp) :: zkt, zrdttrc1
651	REAL(wp) :: zndastp
652
653	! Time domain : restart
654	! ---------------------
655
656	IF( TRIM(cdrw) == 'READ' ) THEN
657
658	IF(lwp) WRITE(numout,*)
659	IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
660	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
661
662	IF ( jprstlib == jprstdimg ) THEN
663	! eventually read netcdf file (monobloc) for restarting on different number of processors
664	! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
665	INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
666	IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
667	ENDIF
668
669	IF( ln_rsttr ) THEN
670	CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
671	CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run
672
673	IF(lwp) THEN
674	WRITE(numout,) ' ** Info read in restart : '
675	WRITE(numout,*) ' previous time-step : ', NINT( zkt )
676	WRITE(numout,) ' ** restart option'
677	SELECT CASE ( nn_rsttr )
678	CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
679	CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
680	CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
681	END SELECT
682	WRITE(numout,*)
683	ENDIF
684	! Control of date
685	IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) &
686	& CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', &
687	& ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
688	ENDIF
689	!
690	IF( lk_offline ) THEN
691	! ! set the date in offline mode
692	IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
693	CALL iom_get( numrtr, 'ndastp', zndastp )
694	ndastp = NINT( zndastp )
695	CALL iom_get( numrtr, 'adatrj', adatrj )
696	ELSE
697	ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam
698	adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
699	! note this is wrong if time step has changed during run
700	ENDIF
701	!
702	IF(lwp) THEN
703	WRITE(numout,) ' ** Info used values : '
704	WRITE(numout,*) ' date ndastp : ', ndastp
705	WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj
706	WRITE(numout,*)
707	ENDIF
708	!
709	IF( ln_rsttr ) THEN ; neuler = 1
710	ELSE ; neuler = 0
711	ENDIF
712	!
713	CALL day_init ! compute calendar
714	!
715	ENDIF
716	!
717	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
718	!
719	IF( kt == nitrst ) THEN
720	IF(lwp) WRITE(numout,*)
721	IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
722	IF(lwp) WRITE(numout,*) '~~~~~~~'
723	ENDIF
724	CALL iom_rstput( kt, nitrst, numrtw, 'kt' , REAL( kt , wp) ) ! time-step
725	CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) ) ! date
726	CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj ) ! number of elapsed days since
727	! ! the begining of the run [s]
728	ENDIF
729
730	END SUBROUTINE trc_rst_cal
731
732
733	SUBROUTINE trc_rst_stat
734	!!----------------------------------------------------------------------
735	!! * trc_rst_stat *
736	!!
737	!! ** purpose : Compute tracers statistics
738	!!----------------------------------------------------------------------
739	INTEGER :: jk, jn
740	REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
741	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
742	!!----------------------------------------------------------------------
743
744	IF( lwp ) THEN
745	WRITE(numout,*)
746	WRITE(numout,*) ' ----TRACER STAT---- '
747	WRITE(numout,*)
748	ENDIF
749	!
750	DO jk = 1, jpk
751	zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
752	END DO
753	!
754	DO jn = 1, jptra
755	ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
756	zmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
757	zmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
758	IF( lk_mpp ) THEN
759	CALL mpp_min( zmin ) ! min over the global domain
760	CALL mpp_max( zmax ) ! max over the global domain
761	END IF
762	zmean = ztraf / areatot
763	zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 ) ) * 100._wp
764	IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
765	END DO
766	IF(lwp) WRITE(numout,*)
767	9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, &
768	& ' max :',e18.10,' drift :',e18.10, ' %')
769	!
770	END SUBROUTINE trc_rst_stat
771
772
773	# if defined key_medusa && defined key_roam
774	SUBROUTINE trc_rst_conserve
775	!!----------------------------------------------------------------------
776	!! * trc_rst_conserve *
777	!!
778	!! ** purpose : Compute tracers conservation statistics
779	!!
780	!! AXY (17/11/2017)
781	!! This routine calculates the "now" inventories of the elemental
782	!! cycles of MEDUSA and compares them to those calculate when the
783	!! model was initialised / restarted; the cycles calculated are:
784	!! nitrogen, silicon, iron, carbon, alkalinity and oxygen
785	!!----------------------------------------------------------------------
786	INTEGER :: ji, jj, jk, jn
787	REAL(wp) :: zsum3d, zsum2d, zinvt, zdelta, zratio, loc_vol, loc_are
788	REAL(wp) :: zq1, zq2, loc_vol, loc_area
789	REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d, zvol
790	REAL(wp), DIMENSION(jpi,jpj) :: z2d, zarea
791	REAL(wp), DIMENSION(6) :: loc_cycletot3, loc_cycletot2
792	!!----------------------------------------------------------------------
793	!
794	IF( lwp ) THEN
795	WRITE(numout,*)
796	WRITE(numout,*) ' ----TRACER CONSERVATION---- '
797	WRITE(numout,*)
798	ENDIF
799	!
800	! ocean volume
801	DO jk = 1, jpk
802	zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
803	END DO
804	!
805	! ocean area (for sediments)
806	zarea(:,:) = e1e2t(:,:) * tmask(:,:,1)
807	!
808	!----------------------------------------------------------------------
809	! nitrogen
810	z3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + &
811	trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin)
812	z2d(:,:) = zn_sed_n(:,:)
813	zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
814	zsum2d = glob_sum( z2d(:,:) * zarea(:,:) )
815	! total tracer, and delta
816	zinvt = zsum3d + zsum2d
817	zdelta = zinvt - cycletot(1)
818	zratio = 1.0e2 * zdelta / cycletot(1)
819	!
820	IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, zinvt, &
821	cycletot(1), zdelta, zratio
822	IF ( lwp ) WRITE(numout,*)
823	!
824	!----------------------------------------------------------------------
825	! silicon
826	z3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil)
827	z2d(:,:) = zn_sed_si(:,:)
828	zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
829	zsum2d = glob_sum( z2d(:,:) * zarea(:,:) )
830	! total tracer, and delta
831	zinvt = zsum3d + zsum2d
832	zdelta = zinvt - cycletot(2)
833	zratio = 1.0e2 * zdelta / cycletot(2)
834	!
835	IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, zinvt, &
836	cycletot(2), zdelta, zratio
837	IF ( lwp ) WRITE(numout,*)
838	!
839	!----------------------------------------------------------------------
840	! iron
841	z3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + &
842	trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer)
843	z2d(:,:) = zn_sed_fe(:,:)
844	zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
845	zsum2d = glob_sum( z2d(:,:) * zarea(:,:) )
846	! total tracer, and delta
847	zinvt = zsum3d + zsum2d
848	zdelta = zinvt - cycletot(3)
849	zratio = 1.0e2 * zdelta / cycletot(3)
850	!
851	IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, zinvt, &
852	cycletot(3), zdelta, zratio
853	IF ( lwp ) WRITE(numout,*)
854	!
855	!----------------------------------------------------------------------
856	! carbon
857	z3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn) + (trn(:,:,:,jpphd) * xthetapd) + &
858	(trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) + &
859	trn(:,:,:,jpdtc) + trn(:,:,:,jpdic)
860	z2d(:,:) = zn_sed_c(:,:) + zn_sed_ca(:,:)
861	zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
862	zsum2d = glob_sum( z2d(:,:) * zarea(:,:) )
863	! total tracer, and delta
864	zinvt = zsum3d + zsum2d
865	zdelta = zinvt - cycletot(4)
866	zratio = 1.0e2 * zdelta / cycletot(4)
867	!
868	IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, zinvt, &
869	cycletot(4), zdelta, zratio
870	IF ( lwp ) WRITE(numout,*)
871	!
872	!----------------------------------------------------------------------
873	! alkalinity
874	z3d(:,:,:) = trn(:,:,:,jpalk)
875	z2d(:,:) = zn_sed_ca(:,:) * 2.0
876	zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
877	zsum2d = glob_sum( z2d(:,:) * zarea(:,:) )
878	! total tracer, and delta
879	zinvt = zsum3d + zsum2d
880	zdelta = zinvt - cycletot(5)
881	zratio = 1.0e2 * zdelta / cycletot(5)
882	!
883	IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, zinvt, &
884	cycletot(5), zdelta, zratio
885	IF ( lwp ) WRITE(numout,*)
886	!
887	!----------------------------------------------------------------------
888	! oxygen
889	z3d(:,:,:) = trn(:,:,:,jpoxy)
890	z2d(:,:) = 0.0
891	zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) )
892	zsum2d = glob_sum( z2d(:,:) * zarea(:,:) )
893	! total tracer, and delta
894	zinvt = zsum3d + zsum2d
895	zdelta = zinvt - cycletot(6)
896	zratio = 1.0e2 * zdelta / cycletot(6)
897	!
898	IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, zinvt, &
899	cycletot(6), zdelta, zratio
900	!
901	!----------------------------------------------------------------------
902	! Check
903	zsum3d = glob_sum( zvol(:,:,:) )
904	zsum2d = glob_sum( zarea(:,:) )
905	IF ( lwp ) THEN
906	WRITE(numout,*)
907	WRITE(numout,*) ' check : cvol : ', zsum3d
908	WRITE(numout,*) ' check : carea : ', zsum2d
909	WRITE(numout,*)
910	ENDIF
911	!
912	9010 FORMAT(' element:',a10, &
913	' 3d sum:',e18.10,' 2d sum:',e18.10, &
914	' total:',e18.10,' initial:',e18.10, &
915	' delta:',e18.10,' %:',e18.10)
916	!
917	END SUBROUTINE trc_rst_conserve
918	# endif
919
920
921	#else
922	!!----------------------------------------------------------------------
923	!! Dummy module : No passive tracer
924	!!----------------------------------------------------------------------
925	CONTAINS
926	SUBROUTINE trc_rst_read ! Empty routines
927	END SUBROUTINE trc_rst_read
928	SUBROUTINE trc_rst_wri( kt )
929	INTEGER, INTENT ( in ) :: kt
930	WRITE(,) 'trc_rst_wri: You should not have seen this print! error?', kt
931	END SUBROUTINE trc_rst_wri
932	#endif
933
934	!!----------------------------------------------------------------------
935	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
936	!! $Id$
937	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
938	!!======================================================================
939	END MODULE trcrst

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc_3dnitbal/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

Download in other formats: