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

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

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

Download in other formats: