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

Last change on this file since 6028 was 6028, checked in by jpalmier, 9 years ago
JPALM -- 09-12-2015 -- modify trcrst.F90 so MEDUSA restart file name include date instead of time-step
File size: 20.8 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	!!
[335]	35	IMPLICIT NONE
	36	PRIVATE
[1801]	37
[945]	38	PUBLIC trc_rst_opn ! called by ???
	39	PUBLIC trc_rst_read ! called by ???
	40	PUBLIC trc_rst_wri ! called by ???
[3294]	41	PUBLIC trc_rst_cal
[1801]	42
[350]	43	!! * Substitutions
[945]	44	# include "top_substitute.h90"
[335]	45
[268]	46	CONTAINS
[335]	47
[616]	48	SUBROUTINE trc_rst_opn( kt )
	49	!!----------------------------------------------------------------------
	50	!! * trc_rst_opn *
	51	!!
	52	!! ** purpose : output of sea-trc variable in a netcdf file
	53	!!----------------------------------------------------------------------
	54	INTEGER, INTENT(in) :: kt ! number of iteration
	55	!
	56	CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character
	57	CHARACTER(LEN=50) :: clname ! trc output restart file name
[5341]	58	CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file
[616]	59	!!----------------------------------------------------------------------
	60	!
[2528]	61	IF( lk_offline ) THEN
[3294]	62	IF( kt == nittrc000 ) THEN
[2528]	63	lrst_trc = .FALSE.
[5341]	64	IF( ln_rst_list ) THEN
	65	nrst_lst = 1
	66	nitrst = nstocklist( nrst_lst )
	67	ELSE
	68	nitrst = nitend
	69	ENDIF
[2528]	70	ENDIF
	71
[5341]	72	IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
[3294]	73	! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
[2528]	74	nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing
	75	IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run
	76	ENDIF
	77	ELSE
[3294]	78	IF( kt == nittrc000 ) lrst_trc = .FALSE.
[1655]	79	ENDIF
	80
[2528]	81	! to get better performances with NetCDF format:
	82	! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
	83	! 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]	84	IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
[6028]	85	IF ( ln_rstdate ) THEN
	86	CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec )
	87	WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
	88	ELSE
	89	! beware of the format used to write kt (default is i8.8, that should be large enough)
	90	IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst
	91	ELSE ; WRITE(clkt,'(i8.8)') nitrst
	92	ENDIF
[616]	93	ENDIF
	94	! create the file
	95	IF(lwp) WRITE(numout,*)
[1254]	96	clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
[5341]	97	clpath = TRIM(cn_trcrst_outdir)
	98	IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
	99	IF(lwp) WRITE(numout,*) &
	100	' open trc restart.output NetCDF file: ',TRIM(clpath)//clname
	101	CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
[616]	102	lrst_trc = .TRUE.
	103	ENDIF
	104	!
	105	END SUBROUTINE trc_rst_opn
	106
[1801]	107	SUBROUTINE trc_rst_read
[945]	108	!!----------------------------------------------------------------------
	109	!! * trc_rst_opn *
[335]	110	!!
[945]	111	!! ** purpose : read passive tracer fields in restart files
	112	!!----------------------------------------------------------------------
[1801]	113	INTEGER :: jn
[5726]	114	!! AXY (05/11/13): temporary variables
	115	REAL(wp) :: fq0,fq1,fq2
[1287]	116
[945]	117	!!----------------------------------------------------------------------
[3294]	118	!
[945]	119	IF(lwp) WRITE(numout,*)
[3294]	120	IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
[945]	121	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
[350]	122
[945]	123	! READ prognostic variables and computes diagnostic variable
[494]	124	DO jn = 1, jptra
[1801]	125	CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
[335]	126	END DO
[1077]	127
[1287]	128	DO jn = 1, jptra
[1801]	129	CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
[1077]	130	END DO
[5726]	131
	132	!! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
	133	!! call to MEDUSA-2 at this point; this suggests that the FCM
	134	!! version of NEMO date significantly earlier than the current
	135	!! version
	136
	137	#if defined key_medusa
	138	!! AXY (13/01/12): check if the restart contains sediment fields;
	139	!! this is only relevant for simulations that include
	140	!! biogeochemistry and are restarted from earlier runs
	141	!! in which there was no sediment component
	142	!!
	143	IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN
	144	!! YES; in which case read them
	145	!!
	146	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...'
	147	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) )
	148	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) )
	149	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) )
	150	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) )
	151	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) )
	152	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) )
	153	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) )
	154	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) )
	155	CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) )
	156	CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) )
	157	ELSE
	158	!! NO; in which case set them to zero
	159	!!
	160	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...'
	161	zb_sed_n(:,:) = 0.0 !! organic N
	162	zn_sed_n(:,:) = 0.0
	163	zb_sed_fe(:,:) = 0.0 !! organic Fe
	164	zn_sed_fe(:,:) = 0.0
	165	zb_sed_si(:,:) = 0.0 !! inorganic Si
	166	zn_sed_si(:,:) = 0.0
	167	zb_sed_c(:,:) = 0.0 !! organic C
	168	zn_sed_c(:,:) = 0.0
	169	zb_sed_ca(:,:) = 0.0 !! inorganic C
	170	zn_sed_ca(:,:) = 0.0
	171	ENDIF
	172	!!
	173	!! calculate stats on these fields
	174	IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
	175	fq0 = MINVAL(zn_sed_n(:,:))
	176	fq1 = MAXVAL(zn_sed_n(:,:))
	177	fq2 = SUM(zn_sed_n(:,:))
	178	if (lwp) write (numout,'(a,3f15.5)') 'Sediment N ', &
	179	& fq0, fq1, fq2
	180	fq0 = MINVAL(zn_sed_fe(:,:))
	181	fq1 = MAXVAL(zn_sed_fe(:,:))
	182	fq2 = SUM(zn_sed_fe(:,:))
	183	if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
	184	& fq0, fq1, fq2
	185	fq0 = MINVAL(zn_sed_si(:,:))
	186	fq1 = MAXVAL(zn_sed_si(:,:))
	187	fq2 = SUM(zn_sed_si(:,:))
	188	if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
	189	& fq0, fq1, fq2
	190	fq0 = MINVAL(zn_sed_c(:,:))
	191	fq1 = MAXVAL(zn_sed_c(:,:))
	192	fq2 = SUM(zn_sed_c(:,:))
	193	if (lwp) write (numout,'(a,3f15.5)') 'Sediment C ', &
	194	& fq0, fq1, fq2
	195	fq0 = MINVAL(zn_sed_ca(:,:))
	196	fq1 = MAXVAL(zn_sed_ca(:,:))
	197	fq2 = SUM(zn_sed_ca(:,:))
	198	if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
	199	& fq0, fq1, fq2
	200	#endif
	201
[945]	202	!
	203	END SUBROUTINE trc_rst_read
[494]	204
[945]	205	SUBROUTINE trc_rst_wri( kt )
	206	!!----------------------------------------------------------------------
	207	!! * trc_rst_wri *
[335]	208	!!
[945]	209	!! ** purpose : write passive tracer fields in restart files
	210	!!----------------------------------------------------------------------
	211	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[335]	212	!!
[1287]	213	INTEGER :: jn
	214	REAL(wp) :: zarak0
[5726]	215	!! AXY (05/11/13): temporary variables
	216	REAL(wp) :: fq0,fq1,fq2
[945]	217	!!----------------------------------------------------------------------
[3294]	218	!
[2528]	219	CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) ) ! surface passive tracer time step
[1801]	220	! prognostic variables
	221	! --------------------
[1100]	222	DO jn = 1, jptra
	223	CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
	224	END DO
[1077]	225
[1100]	226	DO jn = 1, jptra
	227	CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
	228	END DO
[5726]	229
	230	!! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent
	231	!! call to MEDUSA-2 at this point; this suggests that the FCM
	232	!! version of NEMO date significantly earlier than the current
	233	!! version
	234
	235	#if defined key_medusa
	236	!! AXY (13/01/12): write out "before" and "now" state of seafloor
	237	!! sediment pools into restart; this happens
	238	!! whether or not the pools are to be used by
	239	!! MEDUSA (which is controlled by a switch in the
	240	!! namelist_top file)
	241	!!
	242	IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...'
	243	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N', zb_sed_n(:,:) )
	244	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N', zn_sed_n(:,:) )
	245	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) )
	246	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) )
	247	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) )
	248	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) )
	249	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C', zb_sed_c(:,:) )
	250	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C', zn_sed_c(:,:) )
	251	CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) )
	252	CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) )
	253	!!
	254	!! calculate stats on these fields
	255	IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...'
	256	fq0 = MINVAL(zn_sed_n(:,:))
	257	fq1 = MAXVAL(zn_sed_n(:,:))
	258	fq2 = SUM(zn_sed_n(:,:))
	259	if (lwp) write (numout,'(a,3f15.5)') 'Sediment N ', &
	260	& fq0, fq1, fq2
	261	fq0 = MINVAL(zn_sed_fe(:,:))
	262	fq1 = MAXVAL(zn_sed_fe(:,:))
	263	fq2 = SUM(zn_sed_fe(:,:))
	264	if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', &
	265	& fq0, fq1, fq2
	266	fq0 = MINVAL(zn_sed_si(:,:))
	267	fq1 = MAXVAL(zn_sed_si(:,:))
	268	fq2 = SUM(zn_sed_si(:,:))
	269	if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', &
	270	& fq0, fq1, fq2
	271	fq0 = MINVAL(zn_sed_c(:,:))
	272	fq1 = MAXVAL(zn_sed_c(:,:))
	273	fq2 = SUM(zn_sed_c(:,:))
	274	if (lwp) write (numout,'(a,3f15.5)') 'Sediment C ', &
	275	& fq0, fq1, fq2
	276	fq0 = MINVAL(zn_sed_ca(:,:))
	277	fq1 = MAXVAL(zn_sed_ca(:,:))
	278	fq2 = SUM(zn_sed_ca(:,:))
	279	if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', &
	280	& fq0, fq1, fq2
	281	#endif
	282
[3680]	283	!
[1287]	284	IF( kt == nitrst ) THEN
[1119]	285	CALL trc_rst_stat ! statistics
[1100]	286	CALL iom_close( numrtw ) ! close the restart file (only at last time step)
[4990]	287	#if ! defined key_trdmxl_trc
[1100]	288	lrst_trc = .FALSE.
[1177]	289	#endif
[5341]	290	IF( lk_offline .AND. ln_rst_list ) THEN
	291	nrst_lst = nrst_lst + 1
	292	nitrst = nstocklist( nrst_lst )
	293	ENDIF
[1287]	294	ENDIF
[945]	295	!
[1801]	296	END SUBROUTINE trc_rst_wri
[268]	297
[1801]	298
[1287]	299	SUBROUTINE trc_rst_cal( kt, cdrw )
	300	!!---------------------------------------------------------------------
	301	!! * ROUTINE trc_rst_cal *
	302	!!
	303	!! ** Purpose : Read or write calendar in restart file:
	304	!!
	305	!! WRITE(READ) mode:
	306	!! kt : number of time step since the begining of the experiment at the
	307	!! end of the current(previous) run
	308	!! adatrj(0) : number of elapsed days since the begining of the experiment at the
	309	!! end of the current(previous) run (REAL -> keep fractions of day)
	310	!! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer)
	311	!!
	312	!! According to namelist parameter nrstdt,
[3294]	313	!! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary).
	314	!! nn_rsttr = 1 we verify that nittrc000 is equal to the last
[1287]	315	!! time step of previous run + 1.
	316	!! In both those options, the exact duration of the experiment
	317	!! since the beginning (cumulated duration of all previous restart runs)
[3294]	318	!! is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
[1287]	319	!! This is valid is the time step has remained constant.
	320	!!
[2528]	321	!! nn_rsttr = 2 the duration of the experiment in days (adatrj)
[1287]	322	!! has been stored in the restart file.
	323	!!----------------------------------------------------------------------
	324	INTEGER , INTENT(in) :: kt ! ocean time-step
	325	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
	326	!
[3294]	327	INTEGER :: jlibalt = jprstlib
	328	LOGICAL :: llok
[2528]	329	REAL(wp) :: zkt, zrdttrc1
[1287]	330	REAL(wp) :: zndastp
	331
	332	! Time domain : restart
	333	! ---------------------
	334
	335	IF( TRIM(cdrw) == 'READ' ) THEN
[3294]	336
	337	IF(lwp) WRITE(numout,*)
	338	IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
	339	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
	340
	341	IF ( jprstlib == jprstdimg ) THEN
	342	! eventually read netcdf file (monobloc) for restarting on different number of processors
	343	! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
[5341]	344	INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
[3294]	345	IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
	346	ENDIF
	347
[5513]	348	IF( ln_rsttr ) THEN
	349	CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
	350	CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run
[3294]	351
[5513]	352	IF(lwp) THEN
	353	WRITE(numout,) ' ** Info read in restart : '
	354	WRITE(numout,*) ' previous time-step : ', NINT( zkt )
	355	WRITE(numout,) ' ** restart option'
	356	SELECT CASE ( nn_rsttr )
	357	CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
	358	CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
	359	CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
	360	END SELECT
	361	WRITE(numout,*)
	362	ENDIF
	363	! Control of date
	364	IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) &
	365	& CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', &
	366	& ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
[1287]	367	ENDIF
[5513]	368	!
[5504]	369	IF( lk_offline ) THEN
	370	! ! set the date in offline mode
	371	IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
[2528]	372	CALL iom_get( numrtr, 'ndastp', zndastp )
	373	ndastp = NINT( zndastp )
	374	CALL iom_get( numrtr, 'adatrj', adatrj )
[5504]	375	ELSE
[2528]	376	ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam
[3294]	377	adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
[2528]	378	! note this is wrong if time step has changed during run
	379	ENDIF
	380	!
	381	IF(lwp) THEN
	382	WRITE(numout,) ' ** Info used values : '
	383	WRITE(numout,*) ' date ndastp : ', ndastp
	384	WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj
	385	WRITE(numout,*)
	386	ENDIF
	387	!
[5504]	388	IF( ln_rsttr ) THEN ; neuler = 1
	389	ELSE ; neuler = 0
	390	ENDIF
	391	!
[2528]	392	CALL day_init ! compute calendar
	393	!
[1287]	394	ENDIF
	395	!
	396	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
	397	!
	398	IF( kt == nitrst ) THEN
	399	IF(lwp) WRITE(numout,*)
	400	IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
	401	IF(lwp) WRITE(numout,*) '~~~~~~~'
	402	ENDIF
	403	CALL iom_rstput( kt, nitrst, numrtw, 'kt' , REAL( kt , wp) ) ! time-step
	404	CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) ) ! date
	405	CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj ) ! number of elapsed days since
	406	! ! the begining of the run [s]
	407	ENDIF
	408
	409	END SUBROUTINE trc_rst_cal
	410
[1119]	411
	412	SUBROUTINE trc_rst_stat
	413	!!----------------------------------------------------------------------
	414	!! * trc_rst_stat *
	415	!!
	416	!! ** purpose : Compute tracers statistics
	417	!!----------------------------------------------------------------------
[3294]	418	INTEGER :: jk, jn
	419	REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
[5385]	420	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
[1119]	421	!!----------------------------------------------------------------------
	422
	423	IF( lwp ) THEN
	424	WRITE(numout,*)
	425	WRITE(numout,*) ' ----TRACER STAT---- '
	426	WRITE(numout,*)
	427	ENDIF
[3294]	428	!
[5385]	429	DO jk = 1, jpk
	430	zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
	431	END DO
	432	!
[1119]	433	DO jn = 1, jptra
[5385]	434	ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
[3294]	435	zmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
	436	zmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
[1119]	437	IF( lk_mpp ) THEN
[3294]	438	CALL mpp_min( zmin ) ! min over the global domain
	439	CALL mpp_max( zmax ) ! max over the global domain
[1119]	440	END IF
[3294]	441	zmean = ztraf / areatot
	442	zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 ) ) * 100._wp
	443	IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
[1119]	444	END DO
[3294]	445	WRITE(numout,*)
	446	9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, &
	447	& ' max :',e18.10,' drift :',e18.10, ' %')
	448	!
[1119]	449	END SUBROUTINE trc_rst_stat
	450
[268]	451	#else
[945]	452	!!----------------------------------------------------------------------
	453	!! Dummy module : No passive tracer
	454	!!----------------------------------------------------------------------
[335]	455	CONTAINS
[945]	456	SUBROUTINE trc_rst_read ! Empty routines
[616]	457	END SUBROUTINE trc_rst_read
[945]	458	SUBROUTINE trc_rst_wri( kt )
[335]	459	INTEGER, INTENT ( in ) :: kt
[616]	460	WRITE(,) 'trc_rst_wri: You should not have seen this print! error?', kt
[945]	461	END SUBROUTINE trc_rst_wri
[268]	462	#endif
[945]	463
[2528]	464	!!----------------------------------------------------------------------
	465	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
[5341]	466	!! $Id$
[2528]	467	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[945]	468	!!======================================================================
[335]	469	END MODULE trcrst

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

Download in other formats: