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

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

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

Download in other formats: