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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc_v2/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 8495

Last change on this file since 8495 was 8495, checked in by dford, 7 years ago
Merge in changes from dev_r5518_GO6_package_asm_surf_bgc, and adapt to the updated MEDUSA structure.
File size: 40.1 KB

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

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

Download in other formats: