22 subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
69 integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
70 integer :: sp_count_i,sp_count_r
72 real :: outnum,densityoutrecept(maxreceptor),xl,yl
92 real :: auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
93 real :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
94 real :: drygridtotal,drygridsigmatotal,drygridtotalunc
95 real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
96 real,
parameter :: smallnum = tiny(0.0)
97 real,
parameter :: weightair=28.97
99 character :: adate*8,atime*6
100 character(len=3) :: anspec
106 jul=bdate+
real(itime,kind=dp)/86400._dp
107 call
caldate(jul,jjjjmmdd,ihmmss)
108 write(adate,
'(i8.8)') jjjjmmdd
109 write(atime,
'(i6.6)') ihmmss
110 write(unitdates,
'(a)') adate//atime
119 if (ldirect.eq.1)
then
121 do kp=1,maxpointspec_act
127 do kp=1,maxpointspec_act
128 #if defined WITH_CTBTO_PATCHES
131 tot_mu(ks,kp)=xmass(kp,ks)
147 halfheight=outheight(1)/2.
149 halfheight=(outheight(kz)+outheight(kz-1))/2.
152 if ((height(kzz-1).lt.halfheight).and. &
153 (height(kzz).gt.halfheight)) goto 46
155 46 kzz=max(min(kzz,nz),2)
156 dz1=halfheight-height(kzz-1)
157 dz2=height(kzz)-halfheight
161 xl=outlon0+
real(ix)*dxout
162 yl=outlat0+
real(jy)*dyout
165 iix=max(min(nint(xl),nxmin1),0)
166 jjy=max(min(nint(yl),nymin1),0)
167 densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
168 rho(iix,jjy,kzz-1,2)*dz2)/dz
176 iix=max(min(nint(xl),nxmin1),0)
177 jjy=max(min(nint(yl),nymin1),0)
178 densityoutrecept(i)=rho(iix,jjy,1,2)
186 if (ldirect.eq.1)
then
187 factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
189 #if defined WITH_CTBTO_PATCHES
190 factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
192 factor3d(ix,jy,kz)=
real(abs(loutaver))/outnum
216 write(anspec,
'(i3.3)') ks
217 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5))
then
218 if (ldirect.eq.1)
then
219 open(unitoutgrid,file=path(2)(1:length(2))//
'grid_conc_'//adate// &
220 atime//
'_'//anspec,form=
'unformatted')
222 open(unitoutgrid,file=path(2)(1:length(2))//
'grid_time_'//adate// &
223 atime//
'_'//anspec,form=
'unformatted')
225 write(unitoutgrid) itime
228 if ((iout.eq.2).or.(iout.eq.3))
then
229 open(unitoutgridppt,file=path(2)(1:length(2))//
'grid_pptv_'//adate// &
230 atime//
'_'//anspec,form=
'unformatted')
232 write(unitoutgridppt) itime
235 do kp=1,maxpointspec_act
242 if ((wetdep).and.(ldirect.gt.0))
then
244 auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
246 call
mean(auxgrid,wetgrid(ix,jy), &
247 wetgridsigma(ix,jy),nclassunc)
249 wetgrid(ix,jy)=wetgrid(ix,jy) &
251 wetgridtotal=wetgridtotal+wetgrid(ix,jy)
253 wetgridsigma(ix,jy)= &
254 wetgridsigma(ix,jy)* &
255 sqrt(
real(nclassunc))
256 wetgridsigmatotal=wetgridsigmatotal+ &
261 if ((drydep).and.(ldirect.gt.0))
then
263 auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
265 call
mean(auxgrid,drygrid(ix,jy), &
266 drygridsigma(ix,jy),nclassunc)
268 drygrid(ix,jy)=drygrid(ix,jy)* &
270 drygridtotal=drygridtotal+drygrid(ix,jy)
272 drygridsigma(ix,jy)= &
273 drygridsigma(ix,jy)* &
274 sqrt(
real(nclassunc))
275 125 drygridsigmatotal=drygridsigmatotal+ &
282 auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
284 call
mean(auxgrid,grid(ix,jy,kz), &
285 gridsigma(ix,jy,kz),nclassunc)
288 grid(ix,jy,kz)*nclassunc
289 gridtotal=gridtotal+grid(ix,jy,kz)
291 gridsigma(ix,jy,kz)= &
292 gridsigma(ix,jy,kz)* &
293 sqrt(
real(nclassunc))
294 gridsigmatotal=gridsigmatotal+ &
313 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5))
then
320 if ((ldirect.eq.1).and.(wetdep))
then
324 if (wetgrid(ix,jy).gt.smallnum)
then
325 if (sp_zer.eqv..true.)
then
326 sp_count_i=sp_count_i+1
327 sparse_dump_i(sp_count_i)=ix+jy*numxgrid
329 sp_fact=sp_fact*(-1.)
331 sp_count_r=sp_count_r+1
332 sparse_dump_r(sp_count_r)= &
333 sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
345 write(unitoutgrid) sp_count_i
346 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
347 write(unitoutgrid) sp_count_r
348 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
357 if ((ldirect.eq.1).and.(drydep))
then
360 if (drygrid(ix,jy).gt.smallnum)
then
361 if (sp_zer.eqv..true.)
then
362 sp_count_i=sp_count_i+1
363 sparse_dump_i(sp_count_i)=ix+jy*numxgrid
365 sp_fact=sp_fact*(-1.)
367 sp_count_r=sp_count_r+1
368 sparse_dump_r(sp_count_r)= &
370 1.e12*drygrid(ix,jy)/area(ix,jy)
382 write(unitoutgrid) sp_count_i
383 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
384 write(unitoutgrid) sp_count_r
385 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
399 if (grid(ix,jy,kz).gt.smallnum)
then
400 if (sp_zer.eqv..true.)
then
401 sp_count_i=sp_count_i+1
402 sparse_dump_i(sp_count_i)= &
403 ix+jy*numxgrid+kz*numxgrid*numygrid
405 sp_fact=sp_fact*(-1.)
407 sp_count_r=sp_count_r+1
408 sparse_dump_r(sp_count_r)= &
411 factor3d(ix,jy,kz)/tot_mu(ks,kp)
423 write(unitoutgrid) sp_count_i
424 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
425 write(unitoutgrid) sp_count_r
426 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
437 if ((iout.eq.2).or.(iout.eq.3))
then
444 if ((ldirect.eq.1).and.(wetdep))
then
447 if (wetgrid(ix,jy).gt.smallnum)
then
448 if (sp_zer.eqv..true.)
then
449 sp_count_i=sp_count_i+1
450 sparse_dump_i(sp_count_i)= &
453 sp_fact=sp_fact*(-1.)
455 sp_count_r=sp_count_r+1
456 sparse_dump_r(sp_count_r)= &
458 1.e12*wetgrid(ix,jy)/area(ix,jy)
470 write(unitoutgridppt) sp_count_i
471 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
472 write(unitoutgridppt) sp_count_r
473 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
483 if ((ldirect.eq.1).and.(drydep))
then
486 if (drygrid(ix,jy).gt.smallnum)
then
487 if (sp_zer.eqv..true.)
then
488 sp_count_i=sp_count_i+1
489 sparse_dump_i(sp_count_i)= &
494 sp_count_r=sp_count_r+1
495 sparse_dump_r(sp_count_r)= &
497 1.e12*drygrid(ix,jy)/area(ix,jy)
509 write(unitoutgridppt) sp_count_i
510 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
511 write(unitoutgridppt) sp_count_r
512 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
525 if (grid(ix,jy,kz).gt.smallnum)
then
526 if (sp_zer.eqv..true.)
then
527 sp_count_i=sp_count_i+1
528 sparse_dump_i(sp_count_i)= &
529 ix+jy*numxgrid+kz*numxgrid*numygrid
531 sp_fact=sp_fact*(-1.)
533 sp_count_r=sp_count_r+1
534 sparse_dump_r(sp_count_r)= &
536 1.e12*grid(ix,jy,kz) &
537 /volume(ix,jy,kz)/outnum* &
538 weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
549 write(unitoutgridppt) sp_count_i
550 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
551 write(unitoutgridppt) sp_count_r
552 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
561 close(unitoutgridppt)
566 if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
567 if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
569 if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
574 if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) )
then
575 write(unitoutreceptppt) itime
577 write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
578 weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
584 if (numreceptor.gt.0)
then
585 write(unitoutrecept) itime
587 write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
598 do kp=1,maxpointspec_act
607 gridunc(ix,jy,kz,ks,kp,l,nage)=0.
subroutine caldate(juldate, yyyymmdd, hhmiss)
subroutine concoutput(itime, outnum, gridtotalunc, wetgridtotalunc, drygridtotalunc)
subroutine mean(x, xm, xs, number)