Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

concoutput_irreg.f90 @ 16

Last change on this file since 16 was 16, checked in by jebri, 11 years ago
sources for flexwrf v3.1
File size: 25.8 KB

Line
1	!***********************************************************************
2	!* Copyright 2012,2013 *
3	!* Jerome Brioude, Jerome Fast,
4	!* Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa *
5	!* Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann *
6	!* *
7	!* This file is part of FLEXPART WRF *
8	!* *
9	!* FLEXPART is free software: you can redistribute it and/or modify *
10	!* it under the terms of the GNU General Public License as published by*
11	!* the Free Software Foundation, either version 3 of the License, or *
12	!* (at your option) any later version. *
13	!* *
14	!* FLEXPART is distributed in the hope that it will be useful, *
15	!* but WITHOUT ANY WARRANTY; without even the implied warranty of *
16	!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
17	!* GNU General Public License for more details. *
18	!* *
19	!* You should have received a copy of the GNU General Public License *
20	!* along with FLEXPART. If not, see <http://www.gnu.org/licenses/>. *
21	!***********************************************************************
22	subroutine concoutput_irreg(itime,outnum,gridtotalunc,wetgridtotalunc, &
23	drygridtotalunc)
24	! i i o o
25	! o
26	!*******************************************************************************
27	! *
28	! Note: This is the FLEXPART_WRF version of subroutine concoutput *
29	! *
30	! Output of the concentration grid and the receptor concentrations. *
31	! *
32	! Author: A. Stohl *
33	! *
34	! 24 May 1995 *
35	! *
36	! 13 April 1999, Major update: if output size is smaller, dump output *
37	! in sparse matrix format; additional output of uncertainty *
38	! *
39	! 05 April 2000, Major update: output of age classes; output for backward *
40	! runs is time spent in grid cell times total mass of *
41	! species. *
42	! *
43	! 17 February 2002, Appropriate dimensions for backward and forward runs *
44	! are now specified in file includepar *
45	! *
46	! Dec 2005, J. Fast - Output files can be either binary or ascii. *
47	! Sparse output option is turned off. *
48	! Dec 2005, R. Easter - changed names of "lon0" & "lat0" variables *
49	! 2012, J. Brioude- modify output format to flexpart 8, latlon output
50	!*******************************************************************************
51	! *
52	! Variables: *
53	! outnum number of samples *
54	! ncells number of cells with non-zero concentrations *
55	! sparse .true. if in sparse matrix format, else .false. *
56	! nspeciesdim either nspec (forward runs), or numpoint (backward runs) *
57	! tot_mu 1 for forward, initial mass mixing ration for backw. runs *
58	! maxpointspec maxspec for forward runs, maxpoint for backward runs *
59	! *
60	!*******************************************************************************
61
62	! include 'includepar'
63	! include 'includecom'
64	!
65	! double precision jul
66	! integer itime,i,ix,jy,kz,k,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
67	! integer ncells(maxpointspec,maxageclass)
68	! integer ncellsd(maxpointspec,maxageclass)
69	! integer ncellsw(maxpointspec,maxageclass),nspeciesdim
70	! real outnum,weightair,densityoutrecept(maxreceptor),xl,yl
71	! real densityoutgrid(0:maxxgrid-1,0:maxygrid-1,maxzgrid),
72	! +grid(0:maxxgrid-1,0:maxygrid-1,maxzgrid,maxpointspec,maxageclass)
73	! real wetgrid(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
74	! real drygrid(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
75	! real gridsigma(0:maxxgrid-1,0:maxygrid-1,maxzgrid,maxpointspec,
76	! +maxageclass),
77	! +drygridsigma(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass),
78	! +wetgridsigma(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
79	! real auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
80	! real wetgridtotal,wetgridsigmatotal,wetgridtotalunc
81	! real drygridtotal,drygridsigmatotal,drygridtotalunc
82	! real factor(0:maxxgrid-1,0:maxygrid-1,maxzgrid)
83	! real halfheight,dz,dz1,dz2,tot_mu(maxpointspec)
84	! real xnelat,xnelon
85	! real xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat
86	! parameter(weightair=28.97)
87	! logical sparse(maxpointspec,maxageclass)
88	! logical sparsed(maxpointspec,maxageclass)
89	! logical sparsew(maxpointspec,maxageclass)
90	! character adate8,atime6
91	use unc_mod
92	use point_mod
93	use outg_mod
94	use par_mod
95	use com_mod
96
97	implicit none
98
99	real(kind=dp) :: jul
100	integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
101	integer :: sp_count_i,sp_count_r
102	real :: sp_fact
103	real :: outnum,densityoutrecept(maxreceptor),xl,yl
104	real :: auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
105	real :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
106	real :: drygridtotal,drygridsigmatotal,drygridtotalunc
107	real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
108	real :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat
109	real :: start, finish
110
111	real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
112	! real,parameter :: weightair=28.97 !AD: moved this to par_mod.f90
113	logical :: sp_zer
114	character :: adate8,atime6
115	character(len=3) :: anspec
116
117
118	! Determine current calendar date, needed for the file name
119	!**********************************************************
120
121	jul=bdate+real(itime,kind=dp)/86400._dp
122
123	call caldate(jul,jjjjmmdd,ihmmss)
124	write(adate,'(i8.8)') jjjjmmdd
125	write(atime,'(i6.6)') ihmmss
126	write(unitdates,'(a)') adate//atime
127
128
129	! For forward simulations, output fields have dimension MAXSPEC,
130	! for backward simulations, output fields have dimension MAXPOINT.
131	! Thus, make loops either about nspec, or about numpoint
132	!*****************************************************************
133
134	if (ldirect.eq.1) then
135	do ks=1,nspec
136	do kp=1,maxpointspec_act
137	tot_mu(ks,kp)=1
138	end do
139	end do
140	else
141	do ks=1,nspec
142	do kp=1,maxpointspec_act
143	tot_mu(ks,kp)=xmass(kp,ks)
144	end do
145	end do
146	endif
147
148	!*******************************************************************
149	! Compute air density: sufficiently accurate to take it
150	! from coarse grid at some time
151	! Determine center altitude of output layer, and interpolate density
152	! data to that altitude
153	!*******************************************************************
154
155	do kz=1,numzgrid
156	if (kz.eq.1) then
157	halfheight=outheight(1)/2.
158	else
159	halfheight=(outheight(kz)+outheight(kz-1))/2.
160	endif
161	do kzz=2,nz
162	if ((height(kzz-1).lt.halfheight).and. &
163	(height(kzz).gt.halfheight)) goto 46
164	end do
165	46 kzz=max(min(kzz,nz),2)
166	dz1=halfheight-height(kzz-1)
167	dz2=height(kzz)-halfheight
168	dz=dz1+dz2
169	do jy=0,numygrid-1
170	do ix=0,numxgrid-1
171	! xl=outlon0+real(ix)*dxout
172	! yl=outlat0+real(jy)*dyout
173	xl=out_xm0+float(ix)*dxout
174	yl=out_ym0+float(jy)*dyout
175	! xl=(xl-xlon0)/dx
176	! yl=(yl-ylat0)/dx
177	xl=(xl-xmet0)/dx
178	yl=(yl-ymet0)/dy
179	iix=max(min(nint(xl),nxmin1),0)
180	jjy=max(min(nint(yl),nymin1),0)
181	densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
182	rho(iix,jjy,kzz-1,2)*dz2)/dz
183	end do
184	end do
185	end do
186
187	do i=1,numreceptor
188	xl=xreceptor(i)
189	yl=yreceptor(i)
190	iix=max(min(nint(xl),nxmin1),0)
191	jjy=max(min(nint(yl),nymin1),0)
192	densityoutrecept(i)=rho(iix,jjy,1,2)
193	end do
194
195	! Output is different for forward and backward simulations
196	do kz=1,numzgrid
197	do jy=0,numygrid-1
198	do ix=0,numxgrid-1
199	if (ldirect.eq.1) then
200	factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
201	else
202	factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
203	endif
204	end do
205	end do
206	end do
207
208	!*********************************************************************
209	! Determine the standard deviation of the mean concentration or mixing
210	! ratio (uncertainty of the output) and the dry and wet deposition
211	!*********************************************************************
212
213	gridtotal=0.
214	gridsigmatotal=0.
215	gridtotalunc=0.
216	wetgridtotal=0.
217	wetgridsigmatotal=0.
218	wetgridtotalunc=0.
219	drygridtotal=0.
220	drygridsigmatotal=0.
221	drygridtotalunc=0.
222
223	!*******************************************************************
224	! Generate output: may be in concentration (ng/m3) or in mixing
225	! ratio (ppt) or both
226	! Output either in full grid dump or sparse matrix format
227	! For backward simulations, the unit is seconds, stored in grid_conc
228	!*******************************************************************
229
230	! Concentration output
231	!*********************
232
233	! open(53,file=path(1)(1:length(1))//'latlon.txt',form='formatted')
234	! open(54,file=path(1)(1:length(1))//'latlon_corner.txt' &
235	! ,form='formatted')
236	!
237	!! xnelat=outgrid_nelat
238	!! xnelon=outgrid_nelon
239	! print*,'before ll_to',outgrid_swlon,outgrid_swlat,outgrid_nelon,outgrid_nelat
240	! call ll_to_xymeter_wrf(outgrid_swlon,outgrid_swlat,xsw,ysw)
241	! call ll_to_xymeter_wrf(outgrid_nelon,outgrid_nelat,xne,yne)
242	! print*,'after ll_to'
243	! do jy=1,numygrid
244	! do ix=1,numxgrid
245	!! tmpx=out_xm0+(ix-1)*dxout
246	!! tmpy=out_ym0+(jy-1)*dyout
247	! tmpx=out_xm0+(float(ix)-0.5)*dxout
248	! tmpy=out_ym0+(float(jy)-0.5)*dyout
249	!! print*,'jb','tmpx','tmpy',dxout,dyout,ix,jy
250	! call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
251	!!jb if(iouttype.eq.0) write(unitoutgrid) tmplon,tmplat
252	!! if(iouttype.eq.1) write(unitoutgrid,*) tmplon,tmplat
253	! write(53,*) tmplon,tmplat
254	!! tmpx=out_xm0+(ix-1-0.5)*dxout
255	!! tmpy=out_ym0+(jy-1-0.5)*dyout
256	! tmpx=out_xm0+(float(ix)-1.)*dxout
257	! tmpy=out_ym0+(float(jy)-1.)*dyout
258	!! tmpx=xsw+(xne-xsw)*float(ix-1)/float(numxgrid-1)
259	!! tmpy=ysw+(yne-ysw)*float(jy-1)/float(numygrid-1)
260	!! print*,'jb2','tmpx','tmpy',dxout,dyout,ix,jy
261	!! call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
262	! call xymeter_to_ll_wrf_out(tmpx,tmpy,tmplon,tmplat)
263	! write(54,*) tmplon,tmplat
264	! enddo
265	! enddo
266	! close(53)
267	! close(54)
268
269	! print*,'in grid conc',nspec,iout,adate,atime
270	do ks=1,nspec
271	if (iouttype.ne.2) then ! Not netcdf output, open the standard files
272	! AD: I don't think this is right, there is no distinction between ascii
273	! or binary files as there is in concoutput_reg...
274	write(anspec,'(i3.3)') ks
275	if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
276	if (ldirect.eq.1) then
277	open(unitoutgrid,file=path(1)(1:length(1))//'grid_conc_'//adate// &
278	atime//'_'//anspec,form='unformatted')
279	else
280	open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_'//adate// &
281	atime//'_'//anspec,form='unformatted')
282	endif
283	write(unitoutgrid) itime
284	endif
285	endif ! iouttype.ne.2
286
287	if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
288	if(iouttype.ne.2) then ! Not netcdf output, open standard file
289	! AD: still the same issue as my previous comment...
290	open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_'//adate// &
291	atime//'_'//anspec,form='unformatted')
292	write(unitoutgridppt) itime
293	endif
294	endif
295
296
297	! print*,'in grid conc step 2',maxpointspec_act,nageclass,numygrid,numxgrid,numzgrid
298	do kp=1,maxpointspec_act
299	do nage=1,nageclass
300
301	do jy=0,numygrid-1
302	do ix=0,numxgrid-1
303
304	! WET DEPOSITION
305	if ((WETDEP).and.(ldirect.gt.0)) then
306	do l=1,nclassunc
307	auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
308	end do
309	call mean(auxgrid,wetgrid(ix,jy), &
310	wetgridsigma(ix,jy),nclassunc)
311	! Multiply by number of classes to get total concentration
312	wetgrid(ix,jy)=wetgrid(ix,jy) &
313	*nclassunc
314	wetgridtotal=wetgridtotal+wetgrid(ix,jy)
315	! Calculate standard deviation of the mean
316	wetgridsigma(ix,jy)= &
317	wetgridsigma(ix,jy)* &
318	sqrt(real(nclassunc))
319	wetgridsigmatotal=wetgridsigmatotal+ &
320	wetgridsigma(ix,jy)
321	endif
322
323	! DRY DEPOSITION
324	if ((DRYDEP).and.(ldirect.gt.0)) then
325	do l=1,nclassunc
326	auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
327	end do
328	call mean(auxgrid,drygrid(ix,jy), &
329	drygridsigma(ix,jy),nclassunc)
330	! Multiply by number of classes to get total concentration
331	drygrid(ix,jy)=drygrid(ix,jy)* &
332	nclassunc
333	drygridtotal=drygridtotal+drygrid(ix,jy)
334	! Calculate standard deviation of the mean
335	drygridsigma(ix,jy)= &
336	drygridsigma(ix,jy)* &
337	sqrt(real(nclassunc))
338	125 drygridsigmatotal=drygridsigmatotal+ &
339	drygridsigma(ix,jy)
340	endif
341	! CONCENTRATION OR MIXING RATIO
342	do kz=1,numzgrid
343	do l=1,nclassunc
344	auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
345	end do
346	call mean(auxgrid,grid(ix,jy,kz), &
347	gridsigma(ix,jy,kz),nclassunc)
348	! Multiply by number of classes to get total concentration
349	grid(ix,jy,kz)= &
350	grid(ix,jy,kz)*nclassunc
351	! if (grid(ix,jy,kz).gt.0. ) print*,grid(ix,jy,kz)
352	gridtotal=gridtotal+grid(ix,jy,kz)
353	! Calculate standard deviation of the mean
354	gridsigma(ix,jy,kz)= &
355	gridsigma(ix,jy,kz)* &
356	sqrt(real(nclassunc))
357	gridsigmatotal=gridsigmatotal+ &
358	gridsigma(ix,jy,kz)
359	end do
360	end do
361	end do
362
363	!*******************************************************************
364	! Generate output: may be in concentration (ng/m3) or in mixing
365	! ratio (ppt) or both
366	! Output the position and the values alternated multiplied by
367	! 1 or -1, first line is number of values, number of positions
368	! For backward simulations, the unit is seconds, stored in grid_time
369	!*******************************************************************
370
371	if (iouttype.eq.2) then ! netcdf output
372	if (option_verbose.ge.1) then
373	write(,) 'concoutput_irreg: Calling write_ncconc for main outgrid'
374	endif
375	! print*,'itime',itime
376	! call cpu_time(start)
377	call write_ncconc(itime,outnum,ks,kp,nage,tot_mu(ks,kp),0) ! 0= nest level
378	! call cpu_time(finish)
379	! print*,'write netcdf',finish-start
380
381	else ! binary or ascii output
382
383	! Concentration output
384	!*********************
385	if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
386
387	! Wet deposition
388	sp_count_i=0
389	sp_count_r=0
390	sp_fact=-1.
391	sp_zer=.true.
392	if ((ldirect.eq.1).and.(WETDEP)) then
393	do jy=0,numygrid-1
394	do ix=0,numxgrid-1
395	!oncentraion greater zero
396	if (wetgrid(ix,jy).gt.smallnum) then
397	if (sp_zer.eqv..true.) then ! first non zero value
398	sp_count_i=sp_count_i+1
399	sparse_dump_i(sp_count_i)=ix+jy*numxgrid
400	sp_zer=.false.
401	sp_fact=sp_fact*(-1.)
402	endif
403	sp_count_r=sp_count_r+1
404	sparse_dump_r(sp_count_r)= &
405	sp_fact1.e12wetgrid(ix,jy)/area(ix,jy)
406	! sparse_dump_u(sp_count_r)=
407	!+ 1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
408	else ! concentration is zero
409	sp_zer=.true.
410	endif
411	end do
412	end do
413	else
414	sp_count_i=0
415	sp_count_r=0
416	endif
417	write(unitoutgrid) sp_count_i
418	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
419	write(unitoutgrid) sp_count_r
420	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
421	! write(unitoutgrid) sp_count_u
422	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
423
424	! Dry deposition
425	sp_count_i=0
426	sp_count_r=0
427	sp_fact=-1.
428	sp_zer=.true.
429	if ((ldirect.eq.1).and.(DRYDEP)) then
430	do jy=0,numygrid-1
431	do ix=0,numxgrid-1
432	if (drygrid(ix,jy).gt.smallnum) then
433	if (sp_zer.eqv..true.) then ! first non zero value
434	sp_count_i=sp_count_i+1
435	sparse_dump_i(sp_count_i)=ix+jy*numxgrid
436	sp_zer=.false.
437	sp_fact=sp_fact*(-1.)
438	endif
439	sp_count_r=sp_count_r+1
440	sparse_dump_r(sp_count_r)= &
441	sp_fact* &
442	1.e12*drygrid(ix,jy)/area(ix,jy)
443	! sparse_dump_u(sp_count_r)=
444	!+ 1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
445	else ! concentration is zero
446	sp_zer=.true.
447	endif
448	end do
449	end do
450	else
451	sp_count_i=0
452	sp_count_r=0
453	endif
454	write(unitoutgrid) sp_count_i
455	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
456	write(unitoutgrid) sp_count_r
457	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
458	! write(,) sp_count_u
459	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
460
461	! Concentrations
462	sp_count_i=0
463	sp_count_r=0
464	sp_fact=-1.
465	sp_zer=.true.
466	do kz=1,numzgrid
467	do jy=0,numygrid-1
468	do ix=0,numxgrid-1
469	if (grid(ix,jy,kz).gt.smallnum) then
470	if (sp_zer.eqv..true.) then ! first non zero value
471	sp_count_i=sp_count_i+1
472	sparse_dump_i(sp_count_i)= &
473	ix+jynumxgrid+kznumxgrid*numygrid
474	sp_zer=.false.
475	sp_fact=sp_fact*(-1.)
476	endif
477	sp_count_r=sp_count_r+1
478	sparse_dump_r(sp_count_r)= &
479	sp_fact* &
480	grid(ix,jy,kz)* &
481	factor3d(ix,jy,kz)/tot_mu(ks,kp)
482	! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
483	! + write (,) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
484	! sparse_dump_u(sp_count_r)=
485	!+ ,gridsigma(ix,jy,kz,ks,kp,nage)*
486	!+ factor(ix,jy,kz)/tot_mu(ks,kp)
487	else ! concentration is zero
488	sp_zer=.true.
489	endif
490	end do
491	end do
492	end do
493	write(unitoutgrid) sp_count_i
494	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
495	write(unitoutgrid) sp_count_r
496	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
497	! write(unitoutgrid) sp_count_u
498	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
499
500
501
502	endif ! concentration output
503
504	! Mixing ratio output
505	!********************
506
507	if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
508
509	! Wet deposition
510	sp_count_i=0
511	sp_count_r=0
512	sp_fact=-1.
513	sp_zer=.true.
514	if ((ldirect.eq.1).and.(WETDEP)) then
515	do jy=0,numygrid-1
516	do ix=0,numxgrid-1
517	if (wetgrid(ix,jy).gt.smallnum) then
518	if (sp_zer.eqv..true.) then ! first non zero value
519	sp_count_i=sp_count_i+1
520	sparse_dump_i(sp_count_i)= &
521	ix+jy*numxgrid
522	sp_zer=.false.
523	sp_fact=sp_fact*(-1.)
524	endif
525	sp_count_r=sp_count_r+1
526	sparse_dump_r(sp_count_r)= &
527	sp_fact* &
528	1.e12*wetgrid(ix,jy)/area(ix,jy)
529	! sparse_dump_u(sp_count_r)=
530	! + ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
531	else ! concentration is zero
532	sp_zer=.true.
533	endif
534	end do
535	end do
536	else
537	sp_count_i=0
538	sp_count_r=0
539	endif
540	write(unitoutgridppt) sp_count_i
541	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
542	write(unitoutgridppt) sp_count_r
543	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
544	! write(unitoutgridppt) sp_count_u
545	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
546
547	! Dry deposition
548	sp_count_i=0
549	sp_count_r=0
550	sp_fact=-1.
551	sp_zer=.true.
552	if ((ldirect.eq.1).and.(DRYDEP)) then
553	do jy=0,numygrid-1
554	do ix=0,numxgrid-1
555	if (drygrid(ix,jy).gt.smallnum) then
556	if (sp_zer.eqv..true.) then ! first non zero value
557	sp_count_i=sp_count_i+1
558	sparse_dump_i(sp_count_i)= &
559	ix+jy*numxgrid
560	sp_zer=.false.
561	sp_fact=sp_fact*(-1)
562	endif
563	sp_count_r=sp_count_r+1
564	sparse_dump_r(sp_count_r)= &
565	sp_fact* &
566	1.e12*drygrid(ix,jy)/area(ix,jy)
567	! sparse_dump_u(sp_count_r)=
568	! + ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
569	else ! concentration is zero
570	sp_zer=.true.
571	endif
572	end do
573	end do
574	else
575	sp_count_i=0
576	sp_count_r=0
577	endif
578	write(unitoutgridppt) sp_count_i
579	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
580	write(unitoutgridppt) sp_count_r
581	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
582	! write(unitoutgridppt) sp_count_u
583	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
584
585
586	! Mixing ratios
587	sp_count_i=0
588	sp_count_r=0
589	sp_fact=-1.
590	sp_zer=.true.
591	do kz=1,numzgrid
592	do jy=0,numygrid-1
593	do ix=0,numxgrid-1
594	if (grid(ix,jy,kz).gt.smallnum) then
595	if (sp_zer.eqv..true.) then ! first non zero value
596	sp_count_i=sp_count_i+1
597	sparse_dump_i(sp_count_i)= &
598	ix+jynumxgrid+kznumxgrid*numygrid
599	sp_zer=.false.
600	sp_fact=sp_fact*(-1.)
601	endif
602	sp_count_r=sp_count_r+1
603	sparse_dump_r(sp_count_r)= &
604	sp_fact* &
605	1.e12*grid(ix,jy,kz) &
606	/volume(ix,jy,kz)/outnum* &
607	weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
608	! sparse_dump_u(sp_count_r)=
609	!+ ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
610	!+ outnum*weightair/weightmolar(ks)/
611	!+ densityoutgrid(ix,jy,kz)
612	else ! concentration is zero
613	sp_zer=.true.
614	endif
615	end do
616	end do
617	end do
618	write(unitoutgridppt) sp_count_i
619	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
620	write(unitoutgridppt) sp_count_r
621	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
622	! write(unitoutgridppt) sp_count_u
623	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
624
625	endif ! output for ppt
626
627	endif ! iouttype.eq.2
628
629	end do
630	end do
631
632	if((iouttype.eq.0).or.(iouttype.eq.1)) then ! binary or ascii output
633	close(unitoutgridppt)
634	close(unitoutgrid)
635	endif
636
637	end do
638
639	if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
640	if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
641	wetgridtotal
642	if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
643	drygridtotal
644
645	! Dump of receptor concentrations
646
647	if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then
648	write(unitoutreceptppt) itime
649	do ks=1,nspec
650	write(unitoutreceptppt) (1.e12creceptor(i,ks)/outnum &
651	weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
652	end do
653	endif
654
655	! Dump of receptor concentrations
656
657	if (numreceptor.gt.0) then
658	write(unitoutrecept) itime
659	do ks=1,nspec
660	write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
661	i=1,numreceptor)
662	end do
663	endif
664
665	do ks=1,nspec
666	do kp=1,maxpointspec_act
667	do i=1,numreceptor
668	creceptor(i,ks)=0.
669	end do
670	do jy=0,numygrid-1
671	do ix=0,numxgrid-1
672	do l=1,nclassunc
673	do nage=1,nageclass
674	do kz=1,numzgrid
675	gridunc(ix,jy,kz,ks,kp,l,nage)=0.
676	end do
677	end do
678	end do
679	end do
680	end do
681	end do
682	end do
683
684
685	end subroutine concoutput_irreg
686

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

Download in other formats:

Original Format