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

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

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

Download in other formats: