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

Last change on this file since 6259 was 6259, checked in by jpalmier, 8 years ago
JPALM --15-01-2016 -- bugfix lbc_lnk before trcadv is called
File size: 30.9 KB

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

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

Download in other formats: