Context Navigation

concoutput_mpi.f90 @ 26f6039

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie

Last change on this file since 26f6039 was 6a678e3, checked in by Espen Sollum ATMOS <eso@…>, 8 years ago
Added option to use double precision for calculating the deposition fields
Property mode set to `100644`
File size: 24.0 KB

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

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

Download in other formats:

Original Format