67 integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
68 integer :: sp_count_i,sp_count_r
70 real :: outnum,densityoutrecept(maxreceptor),xl,yl
90 real :: auxgrid(nclassunc)
91 real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
92 real,
parameter :: smallnum = tiny(0.0)
93 real,
parameter :: weightair=28.97
95 character :: adate*8,atime*6
96 character(len=3) :: anspec
102 jul=bdate+
real(itime,kind=dp)/86400._dp
103 call
caldate(jul,jjjjmmdd,ihmmss)
104 write(adate,
'(i8.8)') jjjjmmdd
105 write(atime,
'(i6.6)') ihmmss
114 if (ldirect.eq.1)
then
116 do kp=1,maxpointspec_act
122 do kp=1,maxpointspec_act
123 #if defined WITH_CTBTO_PATCHES
126 tot_mu(ks,kp)=xmass(kp,ks)
142 halfheight=outheight(1)/2.
144 halfheight=(outheight(kz)+outheight(kz-1))/2.
147 if ((height(kzz-1).lt.halfheight).and. &
148 (height(kzz).gt.halfheight)) goto 46
150 46 kzz=max(min(kzz,nz),2)
151 dz1=halfheight-height(kzz-1)
152 dz2=height(kzz)-halfheight
156 xl=outlon0n+
real(ix)*dxoutn
157 yl=outlat0n+
real(jy)*dyoutn
160 iix=max(min(nint(xl),nxmin1),0)
161 jjy=max(min(nint(yl),nymin1),0)
162 densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
163 rho(iix,jjy,kzz-1,2)*dz2)/dz
171 iix=max(min(nint(xl),nxmin1),0)
172 jjy=max(min(nint(yl),nymin1),0)
173 densityoutrecept(i)=rho(iix,jjy,1,2)
181 if (ldirect.eq.1)
then
182 factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
184 #if defined WITH_CTBTO_PATCHES
185 factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
187 factor3d(ix,jy,kz)=
real(abs(loutaver))/outnum
201 write(anspec,
'(i3.3)') ks
202 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5))
then
203 if (ldirect.eq.1)
then
204 open(unitoutgrid,file=path(2)(1:length(2))//
'grid_conc_nest_' &
206 atime//
'_'//anspec,form=
'unformatted')
208 open(unitoutgrid,file=path(2)(1:length(2))//
'grid_time_nest_' &
210 atime//
'_'//anspec,form=
'unformatted')
212 write(unitoutgrid) itime
215 if ((iout.eq.2).or.(iout.eq.3))
then
216 open(unitoutgridppt,file=path(2)(1:length(2))//
'grid_pptv_nest_' &
218 atime//
'_'//anspec,form=
'unformatted')
220 write(unitoutgridppt) itime
223 do kp=1,maxpointspec_act
230 if ((wetdep).and.(ldirect.gt.0))
then
232 auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
234 call
mean(auxgrid,wetgrid(ix,jy), &
235 wetgridsigma(ix,jy),nclassunc)
237 wetgrid(ix,jy)=wetgrid(ix,jy) &
240 wetgridsigma(ix,jy)= &
241 wetgridsigma(ix,jy)* &
242 sqrt(
real(nclassunc))
246 if ((drydep).and.(ldirect.gt.0))
then
248 auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
250 call
mean(auxgrid,drygrid(ix,jy), &
251 drygridsigma(ix,jy),nclassunc)
253 drygrid(ix,jy)=drygrid(ix,jy)* &
256 drygridsigma(ix,jy)= &
257 drygridsigma(ix,jy)* &
258 sqrt(
real(nclassunc))
264 auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
266 call
mean(auxgrid,grid(ix,jy,kz), &
267 gridsigma(ix,jy,kz),nclassunc)
270 grid(ix,jy,kz)*nclassunc
272 gridsigma(ix,jy,kz)= &
273 gridsigma(ix,jy,kz)* &
274 sqrt(
real(nclassunc))
290 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5))
then
297 if ((ldirect.eq.1).and.(wetdep))
then
301 if (wetgrid(ix,jy).gt.smallnum)
then
302 if (sp_zer.eqv..true.)
then
303 sp_count_i=sp_count_i+1
304 sparse_dump_i(sp_count_i)=ix+jy*numxgridn
306 sp_fact=sp_fact*(-1.)
308 sp_count_r=sp_count_r+1
309 sparse_dump_r(sp_count_r)= &
310 sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
322 write(unitoutgrid) sp_count_i
323 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
324 write(unitoutgrid) sp_count_r
325 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
334 if ((ldirect.eq.1).and.(drydep))
then
337 if (drygrid(ix,jy).gt.smallnum)
then
338 if (sp_zer.eqv..true.)
then
339 sp_count_i=sp_count_i+1
340 sparse_dump_i(sp_count_i)=ix+jy*numxgridn
342 sp_fact=sp_fact*(-1.)
344 sp_count_r=sp_count_r+1
345 sparse_dump_r(sp_count_r)= &
347 1.e12*drygrid(ix,jy)/arean(ix,jy)
359 write(unitoutgrid) sp_count_i
360 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
361 write(unitoutgrid) sp_count_r
362 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
376 if (grid(ix,jy,kz).gt.smallnum)
then
377 if (sp_zer.eqv..true.)
then
378 sp_count_i=sp_count_i+1
379 sparse_dump_i(sp_count_i)= &
380 ix+jy*numxgridn+kz*numxgridn*numygridn
382 sp_fact=sp_fact*(-1.)
384 sp_count_r=sp_count_r+1
385 sparse_dump_r(sp_count_r)= &
388 factor3d(ix,jy,kz)/tot_mu(ks,kp)
400 write(unitoutgrid) sp_count_i
401 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
402 write(unitoutgrid) sp_count_r
403 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
414 if ((iout.eq.2).or.(iout.eq.3))
then
421 if ((ldirect.eq.1).and.(wetdep))
then
424 if (wetgrid(ix,jy).gt.smallnum)
then
425 if (sp_zer.eqv..true.)
then
426 sp_count_i=sp_count_i+1
427 sparse_dump_i(sp_count_i)= &
430 sp_fact=sp_fact*(-1.)
432 sp_count_r=sp_count_r+1
433 sparse_dump_r(sp_count_r)= &
435 1.e12*wetgrid(ix,jy)/arean(ix,jy)
447 write(unitoutgridppt) sp_count_i
448 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
449 write(unitoutgridppt) sp_count_r
450 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
460 if ((ldirect.eq.1).and.(drydep))
then
463 if (drygrid(ix,jy).gt.smallnum)
then
464 if (sp_zer.eqv..true.)
then
465 sp_count_i=sp_count_i+1
466 sparse_dump_i(sp_count_i)= &
471 sp_count_r=sp_count_r+1
472 sparse_dump_r(sp_count_r)= &
474 1.e12*drygrid(ix,jy)/arean(ix,jy)
486 write(unitoutgridppt) sp_count_i
487 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
488 write(unitoutgridppt) sp_count_r
489 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
502 if (grid(ix,jy,kz).gt.smallnum)
then
503 if (sp_zer.eqv..true.)
then
504 sp_count_i=sp_count_i+1
505 sparse_dump_i(sp_count_i)= &
506 ix+jy*numxgridn+kz*numxgridn*numygridn
508 sp_fact=sp_fact*(-1.)
510 sp_count_r=sp_count_r+1
511 sparse_dump_r(sp_count_r)= &
513 1.e12*grid(ix,jy,kz) &
514 /volumen(ix,jy,kz)/outnum* &
515 weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
526 write(unitoutgridppt) sp_count_i
527 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
528 write(unitoutgridppt) sp_count_r
529 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
538 close(unitoutgridppt)
549 do kp=1,maxpointspec_act
558 griduncn(ix,jy,kz,ks,kp,l,nage)=0.
subroutine concoutput_nest(itime, outnum)
subroutine caldate(juldate, yyyymmdd, hhmiss)
subroutine mean(x, xm, xs, number)