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 @ 6213

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

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

Download in other formats: