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

Context Navigation

source: branches/NERC/dev_r5518_GO6_Carb_Fail_from_GO6_8356/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 9073

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

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

Download in other formats: