Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

trcrst.F90 @ 11738

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

Download in other formats: