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

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

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

Download in other formats: