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

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

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

Download in other formats: