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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

trcrst.F90 in branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 6829

Last change on this file since 6829 was 6829, checked in by jpalmier, 8 years ago
JPALM -- 01-08-2016 -- debug dust dep forcing reading : allowed non climatological forcing
File size: 32.8 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 sms_medusa
33	USE trcsms_medusa
34	!!
35	#if defined key_idtra
36	USE trcsms_idtra
37	#endif
38	!!
39	#if defined key_cfc
40	USE trcsms_cfc
41	#endif
42	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
43	USE sbc_oce, ONLY: lk_oasis
44	USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl !! Coupling variable
45
46	IMPLICIT NONE
47	PRIVATE
48
49	PUBLIC trc_rst_opn ! called by ???
50	PUBLIC trc_rst_read ! called by ???
51	PUBLIC trc_rst_wri ! called by ???
52	PUBLIC trc_rst_cal
53	PUBLIC trc_rst_stat
54	PUBLIC trc_rst_dia_stat
55	PUBLIC trc_rst_tra_stat
56
57	!! * Substitutions
58	# include "top_substitute.h90"
59
60	CONTAINS
61
62	SUBROUTINE trc_rst_opn( kt )
63	!!----------------------------------------------------------------------
64	!! * trc_rst_opn *
65	!!
66	!! ** purpose : output of sea-trc variable in a netcdf file
67	!!----------------------------------------------------------------------
68	INTEGER, INTENT(in) :: kt ! number of iteration
69	INTEGER :: iyear, imonth, iday
70	REAL (wp) :: zsec
71	!
72	CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character
73	CHARACTER(LEN=50) :: clname ! trc output restart file name
74	CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file
75	!!----------------------------------------------------------------------
76	!
77	IF( lk_offline ) THEN
78	IF( kt == nittrc000 ) THEN
79	lrst_trc = .FALSE.
80	IF( ln_rst_list ) THEN
81	nrst_lst = 1
82	nitrst = nstocklist( nrst_lst )
83	ELSE
84	nitrst = nitend
85	ENDIF
86	ENDIF
87
88	IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
89	! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
90	nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing
91	IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run
92	ENDIF
93	ELSE
94	IF( kt == nittrc000 ) lrst_trc = .FALSE.
95	ENDIF
96
97	! to get better performances with NetCDF format:
98	! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
99	! 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
100	IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
101	IF ( ln_rstdate ) THEN
102	!! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name
103	!! -- the condition to open the rst file is not the same than for the dynamic rst.
104	!! -- here it - for an obscure reason - is open 2 time-step before the restart writing process
105	!! instead of 1.
106	!! -- i am not sure if someone forgot +1 in the if loop condition as
107	!! it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is
108	!! nitrst - 2*nn_dttrc
109	!! -- nevertheless we didn't wanted to broke something already working
110	!! and just adapted the part we added.
111	!! -- So instead of calling ju2ymds( fjulday + (rdttra(1))
112	!! we call ju2ymds( fjulday + (2*rdttra(1))
113	!!--------------------------------------------------------------------
114	CALL ju2ymds( fjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec )
115	WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
116	ELSE
117	! beware of the format used to write kt (default is i8.8, that should be large enough)
118	IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst
119	ELSE ; WRITE(clkt,'(i8.8)') nitrst
120	ENDIF
121	ENDIF
122	! create the file
123	IF(lwp) WRITE(numout,*)
124	clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
125	clpath = TRIM(cn_trcrst_outdir)
126	IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
127	IF(lwp) WRITE(numout,*) &
128	' open trc restart.output NetCDF file: ',TRIM(clpath)//clname
129	CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
130	lrst_trc = .TRUE.
131	ENDIF
132	!
133	END SUBROUTINE trc_rst_opn
134
135	SUBROUTINE trc_rst_read
136	!!----------------------------------------------------------------------
137	!! * trc_rst_opn *
138	!!
139	!! ** purpose : read passive tracer fields in restart files
140	!!----------------------------------------------------------------------
141	INTEGER :: jn, jl
142	!! AXY (05/11/13): temporary variables
143	REAL(wp) :: fq0,fq1,fq2
144
145	!!----------------------------------------------------------------------
146	!
147	IF(lwp) WRITE(numout,*)
148	IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
149	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
150
151	! READ prognostic variables and computes diagnostic variable
152	DO jn = 1, jptra
153	CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
154	trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:)
155	END DO
156
157	DO jn = 1, jptra
158	CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
159	trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:)
160	END DO
161	!
162	!! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
163	!! call to MEDUSA-2 at this point; this suggests that the FCM
164	!! version of NEMO date significantly earlier than the current
165	!! version
166
167	#if defined key_medusa
168	!! AXY (13/01/12): check if the restart contains sediment fields;
169	!! this is only relevant for simulations that include
170	!! biogeochemistry and are restarted from earlier runs
171	!! in which there was no sediment component
172	!!
173	IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
174	!! YES; in which case read them
175	!!
176	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
177	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) )
178	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) )
179	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
180	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
181	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
182	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
183	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) )
184	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) )
185	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
186	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
187	ELSE
188	!! NO; in which case set them to zero
189	!!
190	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
191	zb_sed_n(:,:) = 0.0 !! organic N
192	zn_sed_n(:,:) = 0.0
193	zb_sed_fe(:,:) = 0.0 !! organic Fe
194	zn_sed_fe(:,:) = 0.0
195	zb_sed_si(:,:) = 0.0 !! inorganic Si
196	zn_sed_si(:,:) = 0.0
197	zb_sed_c(:,:) = 0.0 !! organic C
198	zn_sed_c(:,:) = 0.0
199	zb_sed_ca(:,:) = 0.0 !! inorganic C
200	zn_sed_ca(:,:) = 0.0
201	ENDIF
202	!!
203	!! calculate stats on these fields
204	IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
205	call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N')
206	call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
207	call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
208	call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
209	call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
210	!!
211	!! AXY (07/07/15): read in temporally averaged fields for DMS
212	!! calculations
213	!!
214	IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN
215	!! YES; in which case read them
216	!!
217	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...'
218	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN', zb_dms_chn(:,:) )
219	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN', zn_dms_chn(:,:) )
220	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD', zb_dms_chd(:,:) )
221	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD', zn_dms_chd(:,:) )
222	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD', zb_dms_mld(:,:) )
223	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD', zn_dms_mld(:,:) )
224	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR', zb_dms_qsr(:,:) )
225	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR', zn_dms_qsr(:,:) )
226	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN', zb_dms_din(:,:) )
227	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN', zn_dms_din(:,:) )
228	ELSE
229	!! NO; in which case set them to zero
230	!!
231	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...'
232	zb_dms_chn(:,:) = 0.0 !! CHN
233	zn_dms_chn(:,:) = 0.0
234	zb_dms_chd(:,:) = 0.0 !! CHD
235	zn_dms_chd(:,:) = 0.0
236	zb_dms_mld(:,:) = 0.0 !! MLD
237	zn_dms_mld(:,:) = 0.0
238	zb_dms_qsr(:,:) = 0.0 !! QSR
239	zn_dms_qsr(:,:) = 0.0
240	zb_dms_din(:,:) = 0.0 !! DIN
241	zn_dms_din(:,:) = 0.0
242	ENDIF
243	!!
244	!! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
245	!! -- needed for the coupling with atm
246	IF( iom_varid( numrtr, 'B_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN
247	IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...'
248	CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf', zb_dms_srf(:,:) )
249	CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf', zn_dms_srf(:,:) )
250	ELSE
251	IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...'
252	zb_dms_srf(:,:) = 0.0 !! DMS
253	zn_dms_srf(:,:) = 0.0
254	ENDIF
255	IF (lk_oasis) THEN
256	DMS_out_cpl(:,:) = zn_dms_srf(:,:) !! Coupling variable
257	END IF
258	!!
259	IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN
260	IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...'
261	CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx', zb_co2_flx(:,:) )
262	CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx', zn_co2_flx(:,:) )
263	ELSE
264	IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...'
265	zb_co2_flx(:,:) = 0.0 !! CO2 flx
266	zn_co2_flx(:,:) = 0.0
267	ENDIF
268	IF (lk_oasis) THEN
269	CO2Flux_out_cpl(:,:) = zn_co2_flx(:,:) !! Coupling variable
270	END IF
271	!!
272	!! calculate stats on these fields
273	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
274	call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
275	call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
276	call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
277	call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
278	call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
279	call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
280	call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
281	#endif
282	!
283	#if defined key_idtra
284	!! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and
285	!! writting here undre their key.
286	!! problems in CFC restart, maybe because of this...
287	!! and pb in idtra diag or diad-restart writing.
288	!!----------------------------------------------------------------------
289	IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN
290	!! YES; in which case read them
291	!!
292	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...'
293	CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,1) )
294	ELSE
295	!! NO; in which case set them to zero
296	!!
297	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...'
298	qint_idtra(:,:,1) = 0.0 !! CHN
299	ENDIF
300	!!
301	!! calculate stats on these fields
302	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
303	call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
304	#endif
305	!
306	#if defined key_cfc
307	DO jl = 1, jp_cfc
308	jn = jp_cfc0 + jl - 1
309	IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN
310	!! YES; in which case read them
311	!!
312	IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...'
313	CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
314	ELSE
315	!! NO; in which case set them to zero
316	!!
317	IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...'
318	qint_cfc(:,:,jn) = 0.0 !! CHN
319	ENDIF
320	!!
321	!! calculate stats on these fields
322	IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
323	call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
324	END DO
325	#endif
326	!
327	END SUBROUTINE trc_rst_read
328
329	SUBROUTINE trc_rst_wri( kt )
330	!!----------------------------------------------------------------------
331	!! * trc_rst_wri *
332	!!
333	!! ** purpose : write passive tracer fields in restart files
334	!!----------------------------------------------------------------------
335	INTEGER, INTENT( in ) :: kt ! ocean time-step index
336	!!
337	INTEGER :: jn, jl
338	REAL(wp) :: zarak0
339	!! AXY (05/11/13): temporary variables
340	REAL(wp) :: fq0,fq1,fq2
341	!!----------------------------------------------------------------------
342	!
343	CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) ) ! surface passive tracer time step
344	! prognostic variables
345	! --------------------
346	DO jn = 1, jptra
347	CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
348	END DO
349
350	DO jn = 1, jptra
351	CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
352	END DO
353
354	!! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
355	!! call to MEDUSA-2 at this point; this suggests that the FCM
356	!! version of NEMO date significantly earlier than the current
357	!! version
358
359	#if defined key_medusa
360	!! AXY (13/01/12): write out "before" and "now" state of seafloor
361	!! sediment pools into restart; this happens
362	!! whether or not the pools are to be used by
363	!! MEDUSA (which is controlled by a switch in the
364	!! namelist_top file)
365	!!
366	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
367	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N', zb_sed_n(:,:) )
368	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N', zn_sed_n(:,:) )
369	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) )
370	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) )
371	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) )
372	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) )
373	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C', zb_sed_c(:,:) )
374	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C', zn_sed_c(:,:) )
375	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) )
376	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) )
377	!!
378	!! calculate stats on these fields
379	IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
380	call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N')
381	call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe')
382	call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si')
383	call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C')
384	call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca')
385	!!
386	!! AXY (07/07/15): write out temporally averaged fields for DMS
387	!! calculations
388	!!
389	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...'
390	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN', zb_dms_chn(:,:) )
391	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN', zn_dms_chn(:,:) )
392	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD', zb_dms_chd(:,:) )
393	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD', zn_dms_chd(:,:) )
394	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD', zb_dms_mld(:,:) )
395	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD', zn_dms_mld(:,:) )
396	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR', zb_dms_qsr(:,:) )
397	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR', zn_dms_qsr(:,:) )
398	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN', zb_dms_din(:,:) )
399	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN', zn_dms_din(:,:) )
400	!! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart
401	!! -- needed for the coupling with atm
402	CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf', zb_dms_srf(:,:) )
403	CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf', zn_dms_srf(:,:) )
404	CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx', zb_co2_flx(:,:) )
405	CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx', zn_co2_flx(:,:) )
406	!!
407	!! calculate stats on these fields
408	IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...'
409	call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN')
410	call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD')
411	call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD')
412	call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR')
413	call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN')
414	call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf')
415	call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux')
416	!!
417	IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.'
418	call trc_rst_dia_stat(dust(:,:), 'Dust dep')
419	call trc_rst_dia_stat(zirondep(:,:), 'Iron dep')
420	!!
421	#endif
422	!
423	#if defined key_idtra
424	!! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and
425	!! writting here undre their key.
426	!! problems in CFC restart, maybe because of this...
427	!! and pb in idtra diag or diad-restart writing.
428	!!----------------------------------------------------------------------
429	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...'
430	CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) )
431	!!
432	!! calculate stats on these fields
433	IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...'
434	call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA')
435	#endif
436	!
437	#if defined key_cfc
438	DO jl = 1, jp_cfc
439	jn = jp_cfc0 + jl - 1
440	IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...'
441	CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )
442	!!
443	!! calculate stats on these fields
444	IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...'
445	call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn))
446	END DO
447	#endif
448	!
449
450	IF( kt == nitrst ) THEN
451	CALL trc_rst_stat ! statistics
452	CALL iom_close( numrtw ) ! close the restart file (only at last time step)
453	#if ! defined key_trdmxl_trc
454	lrst_trc = .FALSE.
455	#endif
456	IF( lk_offline .AND. ln_rst_list ) THEN
457	nrst_lst = nrst_lst + 1
458	nitrst = nstocklist( nrst_lst )
459	ENDIF
460	ENDIF
461	!
462	END SUBROUTINE trc_rst_wri
463
464
465	SUBROUTINE trc_rst_cal( kt, cdrw )
466	!!---------------------------------------------------------------------
467	!! * ROUTINE trc_rst_cal *
468	!!
469	!! ** Purpose : Read or write calendar in restart file:
470	!!
471	!! WRITE(READ) mode:
472	!! kt : number of time step since the begining of the experiment at the
473	!! end of the current(previous) run
474	!! adatrj(0) : number of elapsed days since the begining of the experiment at the
475	!! end of the current(previous) run (REAL -> keep fractions of day)
476	!! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer)
477	!!
478	!! According to namelist parameter nrstdt,
479	!! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary).
480	!! nn_rsttr = 1 we verify that nittrc000 is equal to the last
481	!! time step of previous run + 1.
482	!! In both those options, the exact duration of the experiment
483	!! since the beginning (cumulated duration of all previous restart runs)
484	!! is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
485	!! This is valid is the time step has remained constant.
486	!!
487	!! nn_rsttr = 2 the duration of the experiment in days (adatrj)
488	!! has been stored in the restart file.
489	!!----------------------------------------------------------------------
490	INTEGER , INTENT(in) :: kt ! ocean time-step
491	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
492	!
493	INTEGER :: jlibalt = jprstlib
494	LOGICAL :: llok
495	REAL(wp) :: zkt, zrdttrc1
496	REAL(wp) :: zndastp
497
498	! Time domain : restart
499	! ---------------------
500
501	IF( TRIM(cdrw) == 'READ' ) THEN
502
503	IF(lwp) WRITE(numout,*)
504	IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
505	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
506
507	IF ( jprstlib == jprstdimg ) THEN
508	! eventually read netcdf file (monobloc) for restarting on different number of processors
509	! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
510	INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
511	IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
512	ENDIF
513
514	IF( ln_rsttr ) THEN
515	CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
516	CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run
517
518	IF(lwp) THEN
519	WRITE(numout,) ' ** Info read in restart : '
520	WRITE(numout,*) ' previous time-step : ', NINT( zkt )
521	WRITE(numout,) ' ** restart option'
522	SELECT CASE ( nn_rsttr )
523	CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
524	CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
525	CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
526	END SELECT
527	WRITE(numout,*)
528	ENDIF
529	! Control of date
530	IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) &
531	& CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', &
532	& ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
533	ENDIF
534	!
535	IF( lk_offline ) THEN
536	! ! set the date in offline mode
537	IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
538	CALL iom_get( numrtr, 'ndastp', zndastp )
539	ndastp = NINT( zndastp )
540	CALL iom_get( numrtr, 'adatrj', adatrj )
541	ELSE
542	ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam
543	adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
544	! note this is wrong if time step has changed during run
545	ENDIF
546	!
547	IF(lwp) THEN
548	WRITE(numout,) ' ** Info used values : '
549	WRITE(numout,*) ' date ndastp : ', ndastp
550	WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj
551	WRITE(numout,*)
552	ENDIF
553	!
554	IF( ln_rsttr ) THEN ; neuler = 1
555	ELSE ; neuler = 0
556	ENDIF
557	!
558	CALL day_init ! compute calendar
559	!
560	ENDIF
561	!
562	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
563	!
564	IF( kt == nitrst ) THEN
565	IF(lwp) WRITE(numout,*)
566	IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
567	IF(lwp) WRITE(numout,*) '~~~~~~~'
568	ENDIF
569	CALL iom_rstput( kt, nitrst, numrtw, 'kt' , REAL( kt , wp) ) ! time-step
570	CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) ) ! date
571	CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj ) ! number of elapsed days since
572	! ! the begining of the run [s]
573	ENDIF
574
575	END SUBROUTINE trc_rst_cal
576
577
578	SUBROUTINE trc_rst_stat
579	!!----------------------------------------------------------------------
580	!! * trc_rst_stat *
581	!!
582	!! ** purpose : Compute tracers statistics
583	!!----------------------------------------------------------------------
584	INTEGER :: jk, jn
585	REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
586	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
587	!!----------------------------------------------------------------------
588
589	IF( lwp ) THEN
590	WRITE(numout,*)
591	WRITE(numout,*) ' ----TRACER STAT---- '
592	WRITE(numout,*)
593	ENDIF
594	!
595	DO jk = 1, jpk
596	zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
597	END DO
598	!
599	DO jn = 1, jptra
600	ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
601	zmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
602	zmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
603	IF( lk_mpp ) THEN
604	CALL mpp_min( zmin ) ! min over the global domain
605	CALL mpp_max( zmax ) ! max over the global domain
606	END IF
607	zmean = ztraf / areatot
608	zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 ) ) * 100._wp
609	IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
610	END DO
611	IF(lwp) WRITE(numout,*)
612	9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, &
613	& ' max :',e18.10,' drift :',e18.10, ' %')
614	!
615	END SUBROUTINE trc_rst_stat
616
617
618	SUBROUTINE trc_rst_tra_stat
619	!!----------------------------------------------------------------------
620	!! * trc_rst_tra_stat *
621	!!
622	!! ** purpose : Compute tracers statistics - check where crazy values appears
623	!!----------------------------------------------------------------------
624	INTEGER :: jk, jn
625	REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
626	REAL(wp), DIMENSION(jpi,jpj) :: zvol
627	!!----------------------------------------------------------------------
628
629	IF( lwp ) THEN
630	WRITE(numout,*)
631	WRITE(numout,*) ' ----SURFACE TRA STAT---- '
632	WRITE(numout,*)
633	ENDIF
634	!
635	zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
636	DO jn = 1, jptra
637	ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) )
638	zmin = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
639	zmax = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
640	IF( lk_mpp ) THEN
641	CALL mpp_min( zmin ) ! min over the global domain
642	CALL mpp_max( zmax ) ! max over the global domain
643	END IF
644	zmean = ztraf / areatot
645	IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax
646	END DO
647	IF(lwp) WRITE(numout,*)
648	9001 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, &
649	& ' max :',e18.10)
650	!
651	END SUBROUTINE trc_rst_tra_stat
652
653
654
655	SUBROUTINE trc_rst_dia_stat( dgtr, names)
656	!!----------------------------------------------------------------------
657	!! * trc_rst_dia_stat *
658	!!
659	!! ** purpose : Compute tracers statistics
660	!!----------------------------------------------------------------------
661	REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: dgtr ! 2D diag var
662	CHARACTER(len=*) , INTENT(in) :: names ! 2D diag name
663	!!---------------------------------------------------------------------
664	INTEGER :: jk, jn
665	REAL(wp) :: ztraf, zmin, zmax, zmean, areasf
666	REAL(wp), DIMENSION(jpi,jpj) :: zvol
667	!!----------------------------------------------------------------------
668
669	IF( lwp ) WRITE(numout,*) 'STAT- ', names
670	!
671	zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
672	ztraf = glob_sum( dgtr(:,:) * zvol(:,:) )
673	areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) )
674	zmin = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
675	zmax = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
676	IF( lk_mpp ) THEN
677	CALL mpp_min( zmin ) ! min over the global domain
678	CALL mpp_max( zmax ) ! max over the global domain
679	END IF
680	zmean = ztraf / areatot
681	IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax
682	!
683	IF(lwp) WRITE(numout,*)
684	9002 FORMAT(' tracer name :',a10,' mean :',e18.10,' min :',e18.10, &
685	& ' max :',e18.10 )
686	!
687	END SUBROUTINE trc_rst_dia_stat
688
689
690	#else
691	!!----------------------------------------------------------------------
692	!! Dummy module : No passive tracer
693	!!----------------------------------------------------------------------
694	CONTAINS
695	SUBROUTINE trc_rst_read ! Empty routines
696	END SUBROUTINE trc_rst_read
697	SUBROUTINE trc_rst_wri( kt )
698	INTEGER, INTENT ( in ) :: kt
699	WRITE(,) 'trc_rst_wri: You should not have seen this print! error?', kt
700	END SUBROUTINE trc_rst_wri
701	#endif
702
703	!!----------------------------------------------------------------------
704	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
705	!! $Id$
706	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
707	!!======================================================================
708	END MODULE trcrst

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

Download in other formats: