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_GO6_ScalingCoupledChl/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/NERC/dev_r5518_GO6_ScalingCoupledChl/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 9032

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

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

Download in other formats: