Context Navigation

concoutput_surf.f90 @ 2eefa58

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

Last change on this file since 2eefa58 was 2eefa58, checked in by Espen Sollum ATMOS <eso@…>, 5 years ago
Added Ronas changes for inversion output
Property mode set to `100644`
File size: 25.6 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_surf(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	!*****************************************************************************
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	! tot_mu 1 for forward, initial mass mixing ration for backw. runs *
57	! *
58	!*****************************************************************************
59
60	use unc_mod
61	use point_mod
62	use outg_mod
63	use par_mod
64	use com_mod
65	use mean_mod
66
67	implicit none
68
69	real(kind=dp) :: jul
70	integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
71	integer :: sp_count_i,sp_count_r
72	real :: sp_fact
73	real :: outnum,densityoutrecept(maxreceptor),xl,yl
74	! RLT
75	real :: densitydryrecept(maxreceptor)
76	real :: factor_dryrecept(maxreceptor)
77
78	!real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
79	! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
80	! + maxageclass)
81	!real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
82	! + maxageclass)
83	!real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
84	! + maxpointspec_act,maxageclass)
85	!real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
86	! + maxpointspec_act,maxageclass),
87	! + drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
88	! + maxpointspec_act,maxageclass),
89	! + wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
90	! + maxpointspec_act,maxageclass)
91	!real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
92	!real sparse_dump_r(numxgridnumygridnumzgrid)
93	!integer sparse_dump_i(numxgridnumygridnumzgrid)
94
95	!real sparse_dump_u(numxgridnumygridnumzgrid)
96	real(dep_prec) :: auxgrid(nclassunc)
97	real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
98	real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
99	real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
100	real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
101	real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
102	real,parameter :: weightair=28.97
103	logical :: sp_zer
104	character :: adate8,atime6
105	character(len=3) :: anspec
106	logical :: lexist
107
108
109	if (verbosity.eq.1) then
110	print*,'inside concoutput_surf '
111	CALL SYSTEM_CLOCK(count_clock)
112	WRITE(,) 'SYSTEM_CLOCK',count_clock - count_clock0
113	endif
114
115	! Determine current calendar date, needed for the file name
116	!**********************************************************
117
118	jul=bdate+real(itime,kind=dp)/86400._dp
119	call caldate(jul,jjjjmmdd,ihmmss)
120	write(adate,'(i8.8)') jjjjmmdd
121	write(atime,'(i6.6)') ihmmss
122	!write(unitdates,'(a)') adate//atime
123
124	open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
125	write(unitdates,'(a)') adate//atime
126	close(unitdates)
127
128	! For forward simulations, output fields have dimension MAXSPEC,
129	! for backward simulations, output fields have dimension MAXPOINT.
130	! Thus, make loops either about nspec, or about numpoint
131	!*****************************************************************
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	if (verbosity.eq.1) then
150	print*,'concoutput_surf 2'
151	CALL SYSTEM_CLOCK(count_clock)
152	WRITE(,) 'SYSTEM_CLOCK',count_clock - count_clock0
153	endif
154
155	!*******************************************************************
156	! Compute air density: sufficiently accurate to take it
157	! from coarse grid at some time
158	! Determine center altitude of output layer, and interpolate density
159	! data to that altitude
160	!*******************************************************************
161
162	do kz=1,numzgrid
163	if (kz.eq.1) then
164	halfheight=outheight(1)/2.
165	else
166	halfheight=(outheight(kz)+outheight(kz-1))/2.
167	endif
168	do kzz=2,nz
169	if ((height(kzz-1).lt.halfheight).and. &
170	(height(kzz).gt.halfheight)) goto 46
171	end do
172	46 kzz=max(min(kzz,nz),2)
173	dz1=halfheight-height(kzz-1)
174	dz2=height(kzz)-halfheight
175	dz=dz1+dz2
176	do jy=0,numygrid-1
177	do ix=0,numxgrid-1
178	xl=outlon0+real(ix)*dxout
179	yl=outlat0+real(jy)*dyout
180	xl=(xl-xlon0)/dx
181	yl=(yl-ylat0)/dy
182	iix=max(min(nint(xl),nxmin1),0)
183	jjy=max(min(nint(yl),nymin1),0)
184	densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
185	rho(iix,jjy,kzz-1,2)*dz2)/dz
186	! RLT
187	densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
188	rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
189	end do
190	end do
191	end do
192
193	do i=1,numreceptor
194	xl=xreceptor(i)
195	yl=yreceptor(i)
196	iix=max(min(nint(xl),nxmin1),0)
197	jjy=max(min(nint(yl),nymin1),0)
198	densityoutrecept(i)=rho(iix,jjy,1,2)
199	! RLT
200	densitydryrecept(i)=rho_dry(iix,jjy,1,2)
201	end do
202
203	! RLT
204	! conversion factor for output relative to dry air
205	factor_drygrid=densityoutgrid/densitydrygrid
206	factor_dryrecept=densityoutrecept/densitydryrecept
207
208	! Output is different for forward and backward simulations
209	do kz=1,numzgrid
210	do jy=0,numygrid-1
211	do ix=0,numxgrid-1
212	if (ldirect.eq.1) then
213	factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
214	else
215	factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
216	endif
217	end do
218	end do
219	end do
220
221	!*********************************************************************
222	! Determine the standard deviation of the mean concentration or mixing
223	! ratio (uncertainty of the output) and the dry and wet deposition
224	!*********************************************************************
225
226	if (verbosity.eq.1) then
227	print*,'concoutput_surf 3 (sd)'
228	CALL SYSTEM_CLOCK(count_clock)
229	WRITE(,) 'SYSTEM_CLOCK',count_clock - count_clock0
230	endif
231	gridtotal=0.
232	gridsigmatotal=0.
233	gridtotalunc=0.
234	wetgridtotal=0.
235	wetgridsigmatotal=0.
236	wetgridtotalunc=0.
237	drygridtotal=0.
238	drygridsigmatotal=0.
239	drygridtotalunc=0.
240
241	do ks=1,nspec
242
243	write(anspec,'(i3.3)') ks
244	if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
245	if (ldirect.eq.1) then
246	open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
247	atime//'_'//anspec,form='unformatted')
248	else
249	open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
250	atime//'_'//anspec,form='unformatted')
251	endif
252	write(unitoutgrid) itime
253	endif
254
255	if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
256	open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
257	atime//'_'//anspec,form='unformatted')
258
259	write(unitoutgridppt) itime
260	endif
261
262	do kp=1,maxpointspec_act
263	do nage=1,nageclass
264
265	do jy=0,numygrid-1
266	do ix=0,numxgrid-1
267
268	! WET DEPOSITION
269	if ((WETDEP).and.(ldirect.gt.0)) then
270	do l=1,nclassunc
271	auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
272	end do
273	call mean(auxgrid,wetgrid(ix,jy), &
274	wetgridsigma(ix,jy),nclassunc)
275	! Multiply by number of classes to get total concentration
276	wetgrid(ix,jy)=wetgrid(ix,jy) &
277	*nclassunc
278	wetgridtotal=wetgridtotal+wetgrid(ix,jy)
279	! Calculate standard deviation of the mean
280	wetgridsigma(ix,jy)= &
281	wetgridsigma(ix,jy)* &
282	sqrt(real(nclassunc))
283	wetgridsigmatotal=wetgridsigmatotal+ &
284	wetgridsigma(ix,jy)
285	endif
286
287	! DRY DEPOSITION
288	if ((DRYDEP).and.(ldirect.gt.0)) then
289	do l=1,nclassunc
290	auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
291	end do
292	call mean(auxgrid,drygrid(ix,jy), &
293	drygridsigma(ix,jy),nclassunc)
294	! Multiply by number of classes to get total concentration
295	drygrid(ix,jy)=drygrid(ix,jy)* &
296	nclassunc
297	drygridtotal=drygridtotal+drygrid(ix,jy)
298	! Calculate standard deviation of the mean
299	drygridsigma(ix,jy)= &
300	drygridsigma(ix,jy)* &
301	sqrt(real(nclassunc))
302	125 drygridsigmatotal=drygridsigmatotal+ &
303	drygridsigma(ix,jy)
304	endif
305
306	! CONCENTRATION OR MIXING RATIO
307	do kz=1,numzgrid
308	do l=1,nclassunc
309	auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
310	end do
311	call mean(auxgrid,grid(ix,jy,kz), &
312	gridsigma(ix,jy,kz),nclassunc)
313	! Multiply by number of classes to get total concentration
314	grid(ix,jy,kz)= &
315	grid(ix,jy,kz)*nclassunc
316	gridtotal=gridtotal+grid(ix,jy,kz)
317	! Calculate standard deviation of the mean
318	gridsigma(ix,jy,kz)= &
319	gridsigma(ix,jy,kz)* &
320	sqrt(real(nclassunc))
321	gridsigmatotal=gridsigmatotal+ &
322	gridsigma(ix,jy,kz)
323	end do
324	end do
325	end do
326
327
328	!*******************************************************************
329	! Generate output: may be in concentration (ng/m3) or in mixing
330	! ratio (ppt) or both
331	! Output the position and the values alternated multiplied by
332	! 1 or -1, first line is number of values, number of positions
333	! For backward simulations, the unit is seconds, stored in grid_time
334	!*******************************************************************
335
336	if (verbosity.eq.1) then
337	print*,'concoutput_surf 4 (output)'
338	CALL SYSTEM_CLOCK(count_clock)
339	WRITE(,) 'SYSTEM_CLOCK',count_clock - count_clock0
340	endif
341
342	! Concentration output
343	!*********************
344
345	if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
346
347	if (verbosity.eq.1) then
348	print*,'concoutput_surf (Wet deposition)'
349	CALL SYSTEM_CLOCK(count_clock)
350	WRITE(,) 'SYSTEM_CLOCK',count_clock - count_clock0
351	endif
352
353	! Wet deposition
354	sp_count_i=0
355	sp_count_r=0
356	sp_fact=-1.
357	sp_zer=.true.
358	if ((ldirect.eq.1).and.(WETDEP)) then
359	do jy=0,numygrid-1
360	do ix=0,numxgrid-1
361	! concentraion greater zero
362	if (wetgrid(ix,jy).gt.smallnum) then
363	if (sp_zer.eqv..true.) then ! first non zero value
364	sp_count_i=sp_count_i+1
365	sparse_dump_i(sp_count_i)=ix+jy*numxgrid
366	sp_zer=.false.
367	sp_fact=sp_fact*(-1.)
368	endif
369	sp_count_r=sp_count_r+1
370	sparse_dump_r(sp_count_r)= &
371	sp_fact1.e12wetgrid(ix,jy)/area(ix,jy)
372	sparse_dump_u(sp_count_r)= &
373	1.e12*wetgridsigma(ix,jy)/area(ix,jy)
374	else ! concentration is zero
375	sp_zer=.true.
376	endif
377	end do
378	end do
379	else
380	sp_count_i=0
381	sp_count_r=0
382	endif
383	write(unitoutgrid) sp_count_i
384	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
385	write(unitoutgrid) sp_count_r
386	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
387	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
388
389	if (verbosity.eq.1) then
390	print*,'concoutput_surf (Dry deposition)'
391	CALL SYSTEM_CLOCK(count_clock)
392	WRITE(,) 'SYSTEM_CLOCK',count_clock - count_clock0
393	endif
394	! Dry deposition
395	sp_count_i=0
396	sp_count_r=0
397	sp_fact=-1.
398	sp_zer=.true.
399	if ((ldirect.eq.1).and.(DRYDEP)) then
400	do jy=0,numygrid-1
401	do ix=0,numxgrid-1
402	if (drygrid(ix,jy).gt.smallnum) then
403	if (sp_zer.eqv..true.) then ! first non zero value
404	sp_count_i=sp_count_i+1
405	sparse_dump_i(sp_count_i)=ix+jy*numxgrid
406	sp_zer=.false.
407	sp_fact=sp_fact*(-1.)
408	endif
409	sp_count_r=sp_count_r+1
410	sparse_dump_r(sp_count_r)= &
411	sp_fact* &
412	1.e12*drygrid(ix,jy)/area(ix,jy)
413	sparse_dump_u(sp_count_r)= &
414	1.e12*drygridsigma(ix,jy)/area(ix,jy)
415	else ! concentration is zero
416	sp_zer=.true.
417	endif
418	end do
419	end do
420	else
421	sp_count_i=0
422	sp_count_r=0
423	endif
424	write(unitoutgrid) sp_count_i
425	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
426	write(unitoutgrid) sp_count_r
427	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
428	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
429
430	if (verbosity.eq.1) then
431	print*,'concoutput_surf (Concentrations)'
432	CALL SYSTEM_CLOCK(count_clock)
433	WRITE(,) 'SYSTEM_CLOCK',count_clock - count_clock0
434	endif
435
436	! Concentrations
437
438	! surf_only write only 1st layer
439
440	sp_count_i=0
441	sp_count_r=0
442	sp_fact=-1.
443	sp_zer=.true.
444	do kz=1,1
445	do jy=0,numygrid-1
446	do ix=0,numxgrid-1
447	if (grid(ix,jy,kz).gt.smallnum) then
448	if (sp_zer.eqv..true.) then ! first non zero value
449	sp_count_i=sp_count_i+1
450	sparse_dump_i(sp_count_i)= &
451	ix+jynumxgrid+kznumxgrid*numygrid
452	sp_zer=.false.
453	sp_fact=sp_fact*(-1.)
454	endif
455	sp_count_r=sp_count_r+1
456	sparse_dump_r(sp_count_r)= &
457	sp_fact* &
458	grid(ix,jy,kz)* &
459	factor3d(ix,jy,kz)/tot_mu(ks,kp)
460	! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
461	! + write (,) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
462	sparse_dump_u(sp_count_r)= &
463	gridsigma(ix,jy,kz)* &
464	factor3d(ix,jy,kz)/tot_mu(ks,kp)
465	else ! concentration is zero
466	sp_zer=.true.
467	endif
468	end do
469	end do
470	end do
471	write(unitoutgrid) sp_count_i
472	write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
473	write(unitoutgrid) sp_count_r
474	write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
475	! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
476
477	endif ! concentration output
478
479	! Mixing ratio output
480	!********************
481
482	if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
483
484	! Wet deposition
485	sp_count_i=0
486	sp_count_r=0
487	sp_fact=-1.
488	sp_zer=.true.
489	if ((ldirect.eq.1).and.(WETDEP)) then
490	do jy=0,numygrid-1
491	do ix=0,numxgrid-1
492	if (wetgrid(ix,jy).gt.smallnum) then
493	if (sp_zer.eqv..true.) then ! first non zero value
494	sp_count_i=sp_count_i+1
495	sparse_dump_i(sp_count_i)= &
496	ix+jy*numxgrid
497	sp_zer=.false.
498	sp_fact=sp_fact*(-1.)
499	endif
500	sp_count_r=sp_count_r+1
501	sparse_dump_r(sp_count_r)= &
502	sp_fact* &
503	1.e12*wetgrid(ix,jy)/area(ix,jy)
504	sparse_dump_u(sp_count_r)= &
505	1.e12*wetgridsigma(ix,jy)/area(ix,jy)
506	else ! concentration is zero
507	sp_zer=.true.
508	endif
509	end do
510	end do
511	else
512	sp_count_i=0
513	sp_count_r=0
514	endif
515	write(unitoutgridppt) sp_count_i
516	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
517	write(unitoutgridppt) sp_count_r
518	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
519	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
520
521
522	! Dry deposition
523	sp_count_i=0
524	sp_count_r=0
525	sp_fact=-1.
526	sp_zer=.true.
527	if ((ldirect.eq.1).and.(DRYDEP)) then
528	do jy=0,numygrid-1
529	do ix=0,numxgrid-1
530	if (drygrid(ix,jy).gt.smallnum) then
531	if (sp_zer.eqv..true.) then ! first non zero value
532	sp_count_i=sp_count_i+1
533	sparse_dump_i(sp_count_i)= &
534	ix+jy*numxgrid
535	sp_zer=.false.
536	sp_fact=sp_fact*(-1)
537	endif
538	sp_count_r=sp_count_r+1
539	sparse_dump_r(sp_count_r)= &
540	sp_fact* &
541	1.e12*drygrid(ix,jy)/area(ix,jy)
542	sparse_dump_u(sp_count_r)= &
543	1.e12*drygridsigma(ix,jy)/area(ix,jy)
544	else ! concentration is zero
545	sp_zer=.true.
546	endif
547	end do
548	end do
549	else
550	sp_count_i=0
551	sp_count_r=0
552	endif
553	write(unitoutgridppt) sp_count_i
554	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
555	write(unitoutgridppt) sp_count_r
556	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
557	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
558
559
560	! Mixing ratios
561
562	! surf_only write only 1st layer
563
564	sp_count_i=0
565	sp_count_r=0
566	sp_fact=-1.
567	sp_zer=.true.
568	do kz=1,1
569	do jy=0,numygrid-1
570	do ix=0,numxgrid-1
571	if (grid(ix,jy,kz).gt.smallnum) then
572	if (sp_zer.eqv..true.) then ! first non zero value
573	sp_count_i=sp_count_i+1
574	sparse_dump_i(sp_count_i)= &
575	ix+jynumxgrid+kznumxgrid*numygrid
576	sp_zer=.false.
577	sp_fact=sp_fact*(-1.)
578	endif
579	sp_count_r=sp_count_r+1
580	sparse_dump_r(sp_count_r)= &
581	sp_fact* &
582	1.e12*grid(ix,jy,kz) &
583	/volume(ix,jy,kz)/outnum* &
584	weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
585	sparse_dump_u(sp_count_r)= &
586	1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
587	outnum*weightair/weightmolar(ks)/ &
588	densityoutgrid(ix,jy,kz)
589	else ! concentration is zero
590	sp_zer=.true.
591	endif
592	end do
593	end do
594	end do
595	write(unitoutgridppt) sp_count_i
596	write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
597	write(unitoutgridppt) sp_count_r
598	write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
599	! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
600
601	endif ! output for ppt
602
603	end do
604	end do
605
606	close(unitoutgridppt)
607	close(unitoutgrid)
608
609	end do
610
611	! RLT Aug 2017
612	! Write out conversion factor for dry air
613	inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
614	if (lexist) then
615	! open and append
616	open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
617	status='old',action='write',access='append')
618	else
619	! create new
620	open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
621	status='new',action='write')
622	endif
623	sp_count_i=0
624	sp_count_r=0
625	sp_fact=-1.
626	sp_zer=.true.
627	do kz=1,1
628	do jy=0,numygrid-1
629	do ix=0,numxgrid-1
630	if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
631	if (sp_zer.eqv..true.) then ! first value not equal to one
632	sp_count_i=sp_count_i+1
633	sparse_dump_i(sp_count_i)= &
634	ix+jynumxgrid+kznumxgrid*numygrid
635	sp_zer=.false.
636	sp_fact=sp_fact*(-1.)
637	endif
638	sp_count_r=sp_count_r+1
639	sparse_dump_r(sp_count_r)= &
640	sp_fact*factor_drygrid(ix,jy,kz)
641	else ! factor is one
642	sp_zer=.true.
643	endif
644	end do
645	end do
646	end do
647	write(unitoutfactor) sp_count_i
648	write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
649	write(unitoutfactor) sp_count_r
650	write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
651	close(unitoutfactor)
652
653
654	if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
655	if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
656	wetgridtotal
657	if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
658	drygridtotal
659
660	! Dump of receptor concentrations
661
662	if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then
663	write(unitoutreceptppt) itime
664	do ks=1,nspec
665	write(unitoutreceptppt) (1.e12creceptor(i,ks)/outnum &
666	weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
667	end do
668	endif
669
670	! Dump of receptor concentrations
671
672	if (numreceptor.gt.0) then
673	write(unitoutrecept) itime
674	do ks=1,nspec
675	write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
676	i=1,numreceptor)
677	end do
678	endif
679
680	! RLT Aug 2017
681	! Write out conversion factor for dry air
682	if (numreceptor.gt.0) then
683	inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
684	if (lexist) then
685	! open and append
686	open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
687	status='old',action='write',access='append')
688	else
689	! create new
690	open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
691	status='new',action='write')
692	endif
693	write(unitoutfactor) itime
694	write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
695	close(unitoutfactor)
696	endif
697
698	! Reinitialization of grid
699	!*************************
700
701	do ks=1,nspec
702	do kp=1,maxpointspec_act
703	do i=1,numreceptor
704	creceptor(i,ks)=0.
705	end do
706	do jy=0,numygrid-1
707	do ix=0,numxgrid-1
708	do l=1,nclassunc
709	do nage=1,nageclass
710	do kz=1,numzgrid
711	gridunc(ix,jy,kz,ks,kp,l,nage)=0.
712	end do
713	end do
714	end do
715	end do
716	end do
717	end do
718	end do
719
720
721	end subroutine concoutput_surf

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

Download in other formats:

Original Format