Context Navigation

concoutput_mpi.f90 @ a803521

GFS_025dev

Last change on this file since a803521 was a803521, checked in by Espen Sollum ATMOS <eso@…>, 4 years ago
Merge branch 'dev' into espen
Property mode set to `100644`
File size: 25.5 KB

Rev	Line
[92fab65]	1	! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
	2	! SPDX-License-Identifier: GPL-3.0-or-later
[8a65cb0]	3
	4	subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
	5	drygridtotalunc)
	6	! i i o o
	7	! o
	8	!*****************************************************************************
	9	! *
	10	! Output of the concentration grid and the receptor concentrations. *
	11	! *
	12	! Author: A. Stohl *
	13	! *
	14	! 24 May 1995 *
	15	! *
	16	! 13 April 1999, Major update: if output size is smaller, dump output *
	17	! in sparse matrix format; additional output of *
	18	! uncertainty *
	19	! *
	20	! 05 April 2000, Major update: output of age classes; output for backward*
	21	! runs is time spent in grid cell times total mass of *
	22	! species. *
	23	! *
	24	! 17 February 2002, Appropriate dimensions for backward and forward runs *
	25	! are now specified in file par_mod *
	26	! *
	27	! June 2006, write grid in sparse matrix with a single write command *
	28	! in order to save disk space *
	29	! *
	30	! 2008 new sparse matrix format *
	31	! *
	32	! Changes eso: *
	33	! 2014 MPI version This routine is only called by root MPI *
	34	! process (the other processes have sent *
	35	! their fields to root) *
	36	!*****************************************************************************
	37	! *
	38	! Variables: *
	39	! outnum number of samples *
	40	! ncells number of cells with non-zero concentrations *
	41	! sparse .true. if in sparse matrix format, else .false. *
	42	! tot_mu 1 for forward, initial mass mixing ration for backw. runs *
	43	! *
	44	!*****************************************************************************
	45
	46	use unc_mod
	47	use point_mod
	48	use outg_mod
	49	use par_mod
	50	use com_mod
	51	use mpi_mod
[6a678e3]	52	use mean_mod
[8a65cb0]	53
	54	implicit none
	55
	56	real(kind=dp) :: jul
	57	integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
	58	integer :: sp_count_i,sp_count_r
	59	real :: sp_fact
	60	real :: outnum,densityoutrecept(maxreceptor),xl,yl
[f3054ea]	61	! RLT
	62	real :: densitydryrecept(maxreceptor)
	63	real :: factor_dryrecept(maxreceptor)
[8a65cb0]	64
	65	!real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
	66	! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
	67	! + maxageclass)
	68	!real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
	69	! + maxageclass)
	70	!real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
	71	! + maxpointspec_act,maxageclass)
	72	!real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
	73	! + maxpointspec_act,maxageclass),
	74	! + drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
	75	! + maxpointspec_act,maxageclass),
	76	! + wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
	77	! + maxpointspec_act,maxageclass)
	78	!real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
	79	!real sparse_dump_r(numxgridnumygridnumzgrid)
	80	!integer sparse_dump_i(numxgridnumygridnumzgrid)
	81
	82	!real sparse_dump_u(numxgridnumygridnumzgrid)
[6a678e3]	83	real(dep_prec) :: auxgrid(nclassunc)
	84	real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
	85	real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
	86	real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
[8a65cb0]	87	real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
	88	real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
	89	real,parameter :: weightair=28.97
	90	logical :: sp_zer
[20963b1]	91	logical,save :: init=.true.
[8a65cb0]	92	character :: adate8,atime6
	93	character(len=3) :: anspec
[5f9d14a]	94	integer :: mind
[b069789]	95	! mind eso: added to ensure identical results between 2&3-fields versions
	96	character(LEN=8),save :: file_stat='REPLACE'
	97	logical :: ldates_file
[f3054ea]	98	logical :: lexist
[b069789]	99	integer :: ierr
	100	character(LEN=100) :: dates_char
[8a65cb0]	101
	102	! Measure execution time
	103	if (mp_measure_time) call mpif_mtime('rootonly',0)
	104
	105	! Determine current calendar date, needed for the file name
	106	!**********************************************************
	107
	108	jul=bdate+real(itime,kind=dp)/86400._dp
	109	call caldate(jul,jjjjmmdd,ihmmss)
	110	write(adate,'(i8.8)') jjjjmmdd
	111	write(atime,'(i6.6)') ihmmss
[b069789]	112
	113	! Overwrite existing dates file on first call, later append to it
	114	! This fixes a bug where the dates file kept growing across multiple runs
	115
[20963b1]	116	! If 'dates' file exists in output directory, make a backup
[b069789]	117	inquire(file=path(2)(1:length(2))//'dates', exist=ldates_file)
	118	if (ldates_file.and.init) then
	119	open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
	120	&access='sequential', status='old', action='read', iostat=ierr)
	121	open(unit=unittmp, file=path(2)(1:length(2))//'dates.bak', access='sequential', &
	122	&status='replace', action='write', form='formatted', iostat=ierr)
	123	do while (.true.)
	124	read(unitdates, '(a)', iostat=ierr) dates_char
	125	if (ierr.ne.0) exit
	126	write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
	127	! if (ierr.ne.0) write(,) "Write error, ", ierr
	128	end do
	129	close(unit=unitdates)
	130	close(unit=unittmp)
	131	end if
	132
	133	open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND', STATUS=file_stat)
[8a65cb0]	134	write(unitdates,'(a)') adate//atime
	135	close(unitdates)
	136
[478e9e6]	137	! Overwrite existing dates file on first call, later append to it
	138	! This fixes a bug where the dates file kept growing across multiple runs
	139	IF (init) THEN
	140	file_stat='OLD'
	141	init=.false.
	142	END IF
	143
	144
[8a65cb0]	145	! For forward simulations, output fields have dimension MAXSPEC,
	146	! for backward simulations, output fields have dimension MAXPOINT.
	147	! Thus, make loops either about nspec, or about numpoint
	148	!*****************************************************************
	149
	150
	151	if (ldirect.eq.1) then
	152	do ks=1,nspec
	153	do kp=1,maxpointspec_act
	154	tot_mu(ks,kp)=1
	155	end do
	156	end do
	157	else
	158	do ks=1,nspec
	159	do kp=1,maxpointspec_act
	160	tot_mu(ks,kp)=xmass(kp,ks)
	161	end do
	162	end do
	163	endif
	164
	165
	166	!*******************************************************************
	167	! Compute air density: sufficiently accurate to take it
	168	! from coarse grid at some time
	169	! Determine center altitude of output layer, and interpolate density
	170	! data to that altitude
	171	!*******************************************************************
	172
[5f9d14a]	173	mind=memind(2)
[8a65cb0]	174	do kz=1,numzgrid
	175	if (kz.eq.1) then
	176	halfheight=outheight(1)/2.
	177	else
	178	halfheight=(outheight(kz)+outheight(kz-1))/2.
	179	endif
	180	do kzz=2,nz
	181	if ((height(kzz-1).lt.halfheight).and. &
	182	(height(kzz).gt.halfheight)) goto 46
	183	end do
	184	46 kzz=max(min(kzz,nz),2)
	185	dz1=halfheight-height(kzz-1)
	186	dz2=height(kzz)-halfheight
	187	dz=dz1+dz2
	188	do jy=0,numygrid-1
	189	do ix=0,numxgrid-1
	190	xl=outlon0+real(ix)*dxout
	191	yl=outlat0+real(jy)*dyout
	192	xl=(xl-xlon0)/dx
	193	yl=(yl-ylat0)/dy !v9.1.1
	194	iix=max(min(nint(xl),nxmin1),0)
	195	jjy=max(min(nint(yl),nymin1),0)
[5f9d14a]	196	! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
	197	! rho(iix,jjy,kzz-1,2)*dz2)/dz
	198	densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
	199	rho(iix,jjy,kzz-1,mind)*dz2)/dz
[f3054ea]	200	! RLT
	201	densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
	202	rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
[8a65cb0]	203	end do
	204	end do
	205	end do
	206
	207	do i=1,numreceptor
	208	xl=xreceptor(i)
	209	yl=yreceptor(i)
	210	iix=max(min(nint(xl),nxmin1),0)
	211	jjy=max(min(nint(yl),nymin1),0)
[5f9d14a]	212	!densityoutrecept(i)=rho(iix,jjy,1,2)
	213	densityoutrecept(i)=rho(iix,jjy,1,mind)
[f3054ea]	214	! RLT
	215	densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
[8a65cb0]	216	end do
	217
[f3054ea]	218	! RLT
	219	! conversion factor for output relative to dry air
	220	factor_drygrid=densityoutgrid/densitydrygrid
	221	factor_dryrecept=densityoutrecept/densitydryrecept
[8a65cb0]	222
	223	! Output is different for forward and backward simulations
	224	do kz=1,numzgrid
	225	do jy=0,numygrid-1
	226	do ix=0,numxgrid-1
	227	if (ldirect.eq.1) then
	228	factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
	229	else
	230	factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
	231	endif
	232	end do
	233	end do
	234	end do
	235
	236	!*********************************************************************
	237	! Determine the standard deviation of the mean concentration or mixing
	238	! ratio (uncertainty of the output) and the dry and wet deposition
	239	!*********************************************************************
	240
	241	gridtotal=0.
	242	gridsigmatotal=0.
	243	gridtotalunc=0.
	244	wetgridtotal=0.
	245	wetgridsigmatotal=0.
	246	wetgridtotalunc=0.
	247	drygridtotal=0.
	248	drygridsigmatotal=0.
	249	drygridtotalunc=0.
	250
	251	do ks=1,nspec
	252
	253	write(anspec,'(i3.3)') ks
	254
[20963b1]	255	if (DRYBKDEP.or.WETBKDEP) then !scavdep output
	256	if (DRYBKDEP) &
	257	open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_'//adate// &
	258	atime//'_'//anspec,form='unformatted')
	259	if (WETBKDEP) &
	260	open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_'//adate// &
[8a65cb0]	261	atime//'_'//anspec,form='unformatted')
[20963b1]	262	write(unitoutgrid) itime
	263	else
	264	if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
	265	if (ldirect.eq.1) then
	266	open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
	267	atime//'_'//anspec,form='unformatted')
	268	else
	269	open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
	270	atime//'_'//anspec,form='unformatted')
	271	endif
	272	write(unitoutgrid) itime
	273	endif
	274	if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
	275	open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
	276	atime//'_'//anspec,form='unformatted')
	277	write(unitoutgridppt) itime
	278	endif
	279	endif ! if deposition output
[8a65cb0]	280
	281	do kp=1,maxpointspec_act
	282	do nage=1,nageclass
	283
	284	do jy=0,numygrid-1
	285	do ix=0,numxgrid-1
	286
	287	! WET DEPOSITION
	288	if ((WETDEP).and.(ldirect.gt.0)) then
	289	do l=1,nclassunc
	290	auxgrid(l)=wetgridunc0(ix,jy,ks,kp,l,nage)
	291	end do
	292	call mean(auxgrid,wetgrid(ix,jy), &
	293	wetgridsigma(ix,jy),nclassunc)
	294	! Multiply by number of classes to get total concentration
	295	wetgrid(ix,jy)=wetgrid(ix,jy) &
	296	*nclassunc
	297	wetgridtotal=wetgridtotal+wetgrid(ix,jy)
	298	! Calculate standard deviation of the mean
	299	wetgridsigma(ix,jy)= &
	300	wetgridsigma(ix,jy)* &
	301	sqrt(real(nclassunc))
	302	wetgridsigmatotal=wetgridsigmatotal+ &
	303	wetgridsigma(ix,jy)
	304	endif
	305
	306	! DRY DEPOSITION
	307	if ((DRYDEP).and.(ldirect.gt.0)) then
	308	do l=1,nclassunc
	309	auxgrid(l)=drygridunc0(ix,jy,ks,kp,l,nage)
	310	end do
	311	call mean(auxgrid,drygrid(ix,jy), &
	312	drygridsigma(ix,jy),nclassunc)
	313	! Multiply by number of classes to get total concentration
	314	drygrid(ix,jy)=drygrid(ix,jy)* &
	315	nclassunc
	316	drygridtotal=drygridtotal+drygrid(ix,jy)
	317	! Calculate standard deviation of the mean
	318	drygridsigma(ix,jy)= &
	319	drygridsigma(ix,jy)* &
	320	sqrt(real(nclassunc))
	321	drygridsigmatotal=drygridsigmatotal+ &
	322	drygridsigma(ix,jy)
	323	endif
	324
	325	! CONCENTRATION OR MIXING RATIO
	326	do kz=1,numzgrid
	327	do l=1,nclassunc
	328	auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
	329	end do
	330	call mean(auxgrid,grid(ix,jy,kz), &
	331	gridsigma(ix,jy,kz),nclassunc)
	332	! Multiply by number of classes to get total concentration
	333	grid(ix,jy,kz)= &
	334	grid(ix,jy,kz)*nclassunc
	335	gridtotal=gridtotal+grid(ix,jy,kz)
	336	! Calculate standard deviation of the mean
	337	gridsigma(ix,jy,kz)= &
	338	gridsigma(ix,jy,kz)* &
	339	sqrt(real(nclassunc))
	340	gridsigmatotal=gridsigmatotal+ &
	341	gridsigma(ix,jy,kz)
	342	end do
	343	end do
	344	end do
	345
	346
	347
	348
	349	!*******************************************************************
	350	! Generate output: may be in concentration (ng/m3) or in mixing
	351	! ratio (ppt) or both
	352	! Output the position and the values alternated multiplied by
	353	! 1 or -1, first line is number of values, number of positions
	354	! For backward simulations, the unit is seconds, stored in grid_time
	355	!*******************************************************************
	356
	357	! Concentration output
	358	!*********************
[6741557]	359	if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
[8a65cb0]	360
	361	! Wet deposition
	362	sp_count_i=0
	363	sp_count_r=0
	364	sp_fact=-1.
	365	sp_zer=.true.
	366	if ((ldirect.eq.1).and.(WETDEP)) then
	367	do jy=0,numygrid-1
	368	do ix=0,numxgrid-1
	369	!oncentraion greater zero
	370	if (wetgrid(ix,jy).gt.smallnum) then
	371	if (sp_zer.eqv..true.) then ! first non zero value
	372	sp_count_i=sp_count_i+1
	373	sparse_dump_i(sp_count_i)=ix+jy*numxgrid
	374	sp_zer=.false.
	375	sp_fact=sp_fact*(-1.)
	376	endif
	377	sp_count_r=sp_count_r+1
	378	sparse_dump_r(sp_count_r)= &
	379	sp_fact1.e12wetgrid(ix,jy)/area(ix,jy)
	380	! sparse_dump_u(sp_count_r)=
	381	!+ 1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
	382	else ! concentration is zero
	383	sp_zer=.true.
	384	endif
	385	end do
	386	end do
	387	else
	388	sp_count_i=0
	389	sp_count_r=0
	390	endif
	391	write(unitoutgrid) sp_count_i
	392	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
	393	write(unitoutgrid) sp_count_r
	394	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
	395	! write(unitoutgrid) sp_count_u
	396	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
	397
	398	! Dry deposition
	399	sp_count_i=0
	400	sp_count_r=0
	401	sp_fact=-1.
	402	sp_zer=.true.
	403	if ((ldirect.eq.1).and.(DRYDEP)) then
	404	do jy=0,numygrid-1
	405	do ix=0,numxgrid-1
	406	if (drygrid(ix,jy).gt.smallnum) then
	407	if (sp_zer.eqv..true.) then ! first non zero value
	408	sp_count_i=sp_count_i+1
	409	sparse_dump_i(sp_count_i)=ix+jy*numxgrid
	410	sp_zer=.false.
	411	sp_fact=sp_fact*(-1.)
	412	endif
	413	sp_count_r=sp_count_r+1
	414	sparse_dump_r(sp_count_r)= &
	415	sp_fact* &
	416	1.e12*drygrid(ix,jy)/area(ix,jy)
	417	! sparse_dump_u(sp_count_r)=
	418	!+ 1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
	419	else ! concentration is zero
	420	sp_zer=.true.
	421	endif
	422	end do
	423	end do
	424	else
	425	sp_count_i=0
	426	sp_count_r=0
	427	endif
	428	write(unitoutgrid) sp_count_i
	429	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
	430	write(unitoutgrid) sp_count_r
	431	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
	432	! write(,) sp_count_u
	433	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
	434
	435
	436
	437	! Concentrations
	438	sp_count_i=0
	439	sp_count_r=0
	440	sp_fact=-1.
	441	sp_zer=.true.
	442	do kz=1,numzgrid
	443	do jy=0,numygrid-1
	444	do ix=0,numxgrid-1
	445	if (grid(ix,jy,kz).gt.smallnum) then
	446	if (sp_zer.eqv..true.) then ! first non zero value
	447	sp_count_i=sp_count_i+1
	448	sparse_dump_i(sp_count_i)= &
	449	ix+jynumxgrid+kznumxgrid*numygrid
	450	sp_zer=.false.
	451	sp_fact=sp_fact*(-1.)
	452	endif
	453	sp_count_r=sp_count_r+1
[20963b1]	454	if (lparticlecountoutput) then
	455	sparse_dump_r(sp_count_r)= &
	456	sp_fact* &
	457	grid(ix,jy,kz)
	458	else
[8a65cb0]	459	sparse_dump_r(sp_count_r)= &
	460	sp_fact* &
	461	grid(ix,jy,kz)* &
	462	factor3d(ix,jy,kz)/tot_mu(ks,kp)
[20963b1]	463	end if
	464
	465
[8a65cb0]	466	! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
	467	! + write (,) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
	468	! sparse_dump_u(sp_count_r)=
	469	!+ ,gridsigma(ix,jy,kz,ks,kp,nage)*
	470	!+ factor(ix,jy,kz)/tot_mu(ks,kp)
	471	else ! concentration is zero
	472	sp_zer=.true.
	473	endif
	474	end do
	475	end do
	476	end do
	477	write(unitoutgrid) sp_count_i
	478	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
	479	write(unitoutgrid) sp_count_r
	480	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
	481	! write(unitoutgrid) sp_count_u
	482	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
	483
	484
	485
	486	endif ! concentration output
	487
	488	! Mixing ratio output
	489	!********************
	490
	491	if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
	492
	493	! Wet deposition
	494	sp_count_i=0
	495	sp_count_r=0
	496	sp_fact=-1.
	497	sp_zer=.true.
	498	if ((ldirect.eq.1).and.(WETDEP)) then
	499	do jy=0,numygrid-1
	500	do ix=0,numxgrid-1
	501	if (wetgrid(ix,jy).gt.smallnum) then
	502	if (sp_zer.eqv..true.) then ! first non zero value
	503	sp_count_i=sp_count_i+1
	504	sparse_dump_i(sp_count_i)= &
	505	ix+jy*numxgrid
	506	sp_zer=.false.
	507	sp_fact=sp_fact*(-1.)
	508	endif
	509	sp_count_r=sp_count_r+1
	510	sparse_dump_r(sp_count_r)= &
	511	sp_fact* &
	512	1.e12*wetgrid(ix,jy)/area(ix,jy)
	513	! sparse_dump_u(sp_count_r)=
	514	! + ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
	515	else ! concentration is zero
	516	sp_zer=.true.
	517	endif
	518	end do
	519	end do
	520	else
	521	sp_count_i=0
	522	sp_count_r=0
	523	endif
	524	write(unitoutgridppt) sp_count_i
	525	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
	526	write(unitoutgridppt) sp_count_r
	527	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
	528	! write(unitoutgridppt) sp_count_u
	529	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
	530
	531
	532	! Dry deposition
	533	sp_count_i=0
	534	sp_count_r=0
	535	sp_fact=-1.
	536	sp_zer=.true.
	537	if ((ldirect.eq.1).and.(DRYDEP)) then
	538	do jy=0,numygrid-1
	539	do ix=0,numxgrid-1
	540	if (drygrid(ix,jy).gt.smallnum) then
	541	if (sp_zer.eqv..true.) then ! first non zero value
	542	sp_count_i=sp_count_i+1
	543	sparse_dump_i(sp_count_i)= &
	544	ix+jy*numxgrid
	545	sp_zer=.false.
	546	sp_fact=sp_fact*(-1)
	547	endif
	548	sp_count_r=sp_count_r+1
	549	sparse_dump_r(sp_count_r)= &
	550	sp_fact* &
	551	1.e12*drygrid(ix,jy)/area(ix,jy)
	552	! sparse_dump_u(sp_count_r)=
	553	! + ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
	554	else ! concentration is zero
	555	sp_zer=.true.
	556	endif
	557	end do
	558	end do
	559	else
	560	sp_count_i=0
	561	sp_count_r=0
	562	endif
	563	write(unitoutgridppt) sp_count_i
	564	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
	565	write(unitoutgridppt) sp_count_r
	566	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
	567	! write(unitoutgridppt) sp_count_u
	568	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
	569
	570
	571	! Mixing ratios
	572	sp_count_i=0
	573	sp_count_r=0
	574	sp_fact=-1.
	575	sp_zer=.true.
	576	do kz=1,numzgrid
	577	do jy=0,numygrid-1
	578	do ix=0,numxgrid-1
	579	if (grid(ix,jy,kz).gt.smallnum) then
	580	if (sp_zer.eqv..true.) then ! first non zero value
	581	sp_count_i=sp_count_i+1
	582	sparse_dump_i(sp_count_i)= &
	583	ix+jynumxgrid+kznumxgrid*numygrid
	584	sp_zer=.false.
	585	sp_fact=sp_fact*(-1.)
	586	endif
	587	sp_count_r=sp_count_r+1
	588	sparse_dump_r(sp_count_r)= &
	589	sp_fact* &
	590	1.e12*grid(ix,jy,kz) &
	591	/volume(ix,jy,kz)/outnum* &
	592	weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
	593	! sparse_dump_u(sp_count_r)=
	594	!+ ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
	595	!+ outnum*weightair/weightmolar(ks)/
	596	!+ densityoutgrid(ix,jy,kz)
	597	else ! concentration is zero
	598	sp_zer=.true.
	599	endif
	600	end do
	601	end do
	602	end do
	603	write(unitoutgridppt) sp_count_i
	604	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
	605	write(unitoutgridppt) sp_count_r
	606	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
	607	! write(unitoutgridppt) sp_count_u
	608	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
	609
	610	endif ! output for ppt
	611
	612	end do
	613	end do
	614
	615	close(unitoutgridppt)
	616	close(unitoutgrid)
	617
	618	end do
	619
[f3054ea]	620	! RLT Aug 2017
	621	! Write out conversion factor for dry air
	622	inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
	623	if (lexist) then
	624	! open and append
	625	open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
	626	status='old',action='write',access='append')
	627	else
	628	! create new
	629	open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
	630	status='new',action='write')
	631	endif
	632	sp_count_i=0
	633	sp_count_r=0
	634	sp_fact=-1.
	635	sp_zer=.true.
	636	do kz=1,numzgrid
	637	do jy=0,numygrid-1
	638	do ix=0,numxgrid-1
	639	if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
	640	if (sp_zer.eqv..true.) then ! first value not equal to one
	641	sp_count_i=sp_count_i+1
	642	sparse_dump_i(sp_count_i)= &
	643	ix+jynumxgrid+kznumxgrid*numygrid
	644	sp_zer=.false.
	645	sp_fact=sp_fact*(-1.)
	646	endif
	647	sp_count_r=sp_count_r+1
	648	sparse_dump_r(sp_count_r)= &
	649	sp_fact*factor_drygrid(ix,jy,kz)
	650	else ! factor is one
	651	sp_zer=.true.
	652	endif
	653	end do
	654	end do
	655	end do
	656	write(unitoutfactor) sp_count_i
	657	write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
	658	write(unitoutfactor) sp_count_r
	659	write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
	660	close(unitoutfactor)
	661
	662
[8a65cb0]	663	if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
	664	if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
	665	wetgridtotal
	666	if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
	667	drygridtotal
	668
	669	! Dump of receptor concentrations
	670
	671	if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then
	672	write(unitoutreceptppt) itime
	673	do ks=1,nspec
	674	write(unitoutreceptppt) (1.e12creceptor(i,ks)/outnum &
	675	weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
	676	end do
	677	endif
	678
	679	! Dump of receptor concentrations
	680
	681	if (numreceptor.gt.0) then
	682	write(unitoutrecept) itime
	683	do ks=1,nspec
	684	write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
	685	i=1,numreceptor)
	686	end do
	687	endif
	688
[f3054ea]	689	! RLT Aug 2017
	690	! Write out conversion factor for dry air
	691	if (numreceptor.gt.0) then
	692	inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
	693	if (lexist) then
	694	! open and append
	695	open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
	696	status='old',action='write',access='append')
	697	else
	698	! create new
	699	open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
	700	status='new',action='write')
	701	endif
	702	write(unitoutfactor) itime
	703	write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
	704	close(unitoutfactor)
	705	endif
[8a65cb0]	706
	707	! Reinitialization of grid
	708	!*************************
	709
[20963b1]	710	creceptor(:,:)=0.
	711	gridunc(:,:,:,:,:,:,:)=0.
[8a65cb0]	712
	713	if (mp_measure_time) call mpif_mtime('rootonly',1)
	714
	715	end subroutine concoutput

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

Download in other formats:

Original Format