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

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

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

Download in other formats: