97 integer :: j,ks,kp,l,n,itime,nstop,nstop1,metdata_format
99 integer :: loutnext,loutstart,loutend
100 integer :: ix,jy,ldeltat,itage,nage
101 real :: outnum,weight,prob(maxspec)
102 real :: uap(maxpart),ucp(maxpart),uzp(maxpart),decfact
103 real :: us(maxpart),vs(maxpart),ws(maxpart)
104 integer(kind=2) :: cbt(maxpart)
105 real :: drydeposit(maxspec),gridtotalunc,wetgridtotalunc
106 real :: drygridtotalunc,xold,yold,zold,xmassfract
119 loutstart=loutnext-loutaver/2
120 loutend=loutnext+loutaver/2
131 do itime=0,ideltas,lsynctime
144 if (wetdep .and. itime .ne. 0 .and. numpart .gt. 0) &
145 call
wetdepo(itime,lsynctime,loutnext)
147 if (ohrea .and. itime .ne. 0 .and. numpart .gt. 0) &
150 if (assspec .and. itime .ne. 0 .and. numpart .gt. 0)
then
151 stop
'associated species not yet implemented!'
158 if (metdata_format.eq.ecmwf_metdata)
then
159 if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(itime.lt.0)) &
162 if (metdata_format.eq.gfs_metdata)
then
163 if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(itime.lt.0)) &
171 #ifdef TESTUSEGETFPFIELDS
175 if ( preprocessed_metdata.eq.1 )
then
178 call
getfields(itime,nstop1,metdata_format)
181 if (nstop1.gt.1) stop
'NO METEO FIELDS AVAILABLE'
185 if (mdomainfill.ge.1)
then
199 if (metdata_format.eq.ecmwf_metdata)
then
200 if ((ldirect.eq.1).and.(lconvection.eq.1)) &
203 if (metdata_format.eq.gfs_metdata)
then
204 if ((ldirect.eq.1).and.(lconvection.eq.1)) &
213 if (dep.and.(itime.eq.loutnext).and.(ldirect.gt.0))
then
215 do kp=1,maxpointspec_act
216 if (decay(ks).gt.0.)
then
222 wetgridunc(ix,jy,ks,kp,l,nage)= &
223 wetgridunc(ix,jy,ks,kp,l,nage)* &
224 exp(-1.*outstep*decay(ks))
225 drygridunc(ix,jy,ks,kp,l,nage)= &
226 drygridunc(ix,jy,ks,kp,l,nage)* &
227 exp(-1.*outstep*decay(ks))
231 if (nested_output.eq.1)
then
234 wetgriduncn(ix,jy,ks,kp,l,nage)= &
235 wetgriduncn(ix,jy,ks,kp,l,nage)* &
236 exp(-1.*outstep*decay(ks))
237 drygriduncn(ix,jy,ks,kp,l,nage)= &
238 drygriduncn(ix,jy,ks,kp,l,nage)* &
239 exp(-1.*outstep*decay(ks))
294 if ((ldirect*itime.ge.ldirect*loutstart).and. &
295 (ldirect*itime.le.ldirect*loutend))
then
296 if (mod(itime-loutstart,loutsample).eq.0)
then
302 if ((itime.eq.loutstart).or.(itime.eq.loutend))
then
312 if ((mquasilag.eq.1).and.(itime.eq.(loutstart+loutend)/2)) &
320 if ((itime.eq.loutend).and.(outnum.gt.0.))
then
321 if ((iout.le.3.).or.(iout.eq.5))
then
323 wetgridtotalunc,drygridtotalunc)
327 if ((iout.eq.4).or.(iout.eq.5)) call
plumetraj(itime)
329 write(*,45) itime,numpart,gridtotalunc,wetgridtotalunc, &
331 45
format(i9,
' SECONDS SIMULATED: ',i8, &
332 ' PARTICLES: Uncertainty: ',3f7.3)
334 loutnext=loutnext+loutstep
335 loutstart=loutnext-loutaver/2
336 loutend=loutnext+loutaver/2
337 if (itime.eq.loutstart)
then
350 if (ldirect*itime.ge.ldirect*itsplit)
then
353 if (ldirect*itime.ge.ldirect*itrasplit(j))
then
354 if (n.lt.maxpart)
then
356 itrasplit(j)=2*(itrasplit(j)-itramem(j))+itramem(j)
357 itrasplit(n)=itrasplit(j)
358 itramem(n)=itramem(j)
374 xmass1(j,ks)=xmass1(j,ks)/2.
375 xmass1(n,ks)=xmass1(j,ks)
386 if (itime.eq.ideltas)
exit
391 if (itime.lt.loutnext)
then
392 ldeltat=itime-(loutnext-loutstep)
394 ldeltat=itime-loutnext
407 if (itra1(j).eq.itime)
then
409 if (ioutputforeachrelease.eq.1)
then
415 itage=abs(itra1(j)-itramem(j))
417 if (itage.lt.lage(nage))
exit
423 if ((itramem(j).eq.itime).or.(itime.eq.0)) &
424 call
initialize(itime,idt(j),uap(j),ucp(j),uzp(j), &
425 us(j),vs(j),ws(j),xtra1(j),ytra1(j),ztra1(j),cbt(j))
437 call
advance(itime,npoint(j),idt(j),uap(j),ucp(j),uzp(j), &
438 us(j),vs(j),ws(j),nstop,xtra1(j),ytra1(j),ztra1(j),prob, &
444 if (iflux.eq.1) call
calcfluxes(nage,j,xold,yold,zold)
455 itra1(j)=itime+lsynctime
465 if (decay(ks).gt.0.)
then
466 decfact=exp(-
real(abs(lsynctime))*decay(ks))
471 if (drydepspec(ks))
then
472 drydeposit(ks)=xmass1(j,ks)*prob(ks)*decfact
473 xmass1(j,ks)=xmass1(j,ks)*(1.-prob(ks))*decfact
474 if (decay(ks).gt.0.)
then
475 drydeposit(ks)=drydeposit(ks)* &
476 exp(
real(abs(ldeltat))*decay(ks))
479 xmass1(j,ks)=xmass1(j,ks)*decfact
483 if (mdomainfill.eq.0)
then
484 if (xmass(npoint(j),ks).gt.0.) &
485 xmassfract=max(xmassfract,
real(npart(npoint(j)))* &
486 xmass1(j,ks)/xmass(npoint(j),ks))
492 if (xmassfract.lt.0.0001)
then
498 if (drydep.AND.(ldirect.eq.1))
then
500 real(ytra1(j)),nage,kp)
502 nclass(j),drydeposit,
real(xtra1(j)),
real(ytra1(j)), &
509 if (abs(itra1(j)-itramem(j)).ge.lage(nageclass))
then
510 if (linit_cond.ge.1) &
542 if (ohrea.eqv..true.)
then
543 deallocate(oh_field,oh_field_height)
545 if (ldirect.gt.0)
then
546 deallocate(drygridunc,wetgridunc)
549 deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2,xmass)
550 deallocate(ireleasestart,ireleaseend,npart,kindz)
551 deallocate(xmasssave)
552 if (nested_output.eq.1)
then
553 deallocate(orooutn, arean, volumen)
554 if (ldirect.gt.0)
then
555 deallocate(griduncn,drygriduncn,wetgriduncn)
558 deallocate(outheight,outheighthalf)
559 deallocate(oroout, area, volume)
subroutine partoutput(itime)
subroutine releaseparticles(itime)
subroutine calcfluxes(nage, jpart, xold, yold, zold)
subroutine concoutput_nest(itime, outnum)
subroutine drydepokernel_nest(nunc, deposit, x, y, nage, kp)
subroutine boundcond_domainfill(itime, loutend)
subroutine partoutput_short(itime)
subroutine getfields(itime, nstop, metdata_format)
subroutine ohreaction(itime, ltsample, loutnext)
subroutine concoutput(itime, outnum, gridtotalunc, wetgridtotalunc, drygridtotalunc)
subroutine convmix_gfs(itime)
subroutine advance(itime, nrelpoint, ldt, up, vp, wp, usigold, vsigold, wsigold, nstop, xt, yt, zt, prob, icbt)
subroutine timemanager(metdata_format)
subroutine plumetraj(itime)
subroutine init_domainfill
subroutine initial_cond_output(itime)
subroutine convmix_ecmwf(itime)
subroutine fluxoutput(itime)
subroutine getfpfields(itime, nstop, metdata_format)
subroutine initialize(itime, ldt, up, vp, wp, usigold, vsigold, wsigold, xt, yt, zt, icbt)
subroutine drydepokernel(nunc, deposit, x, y, nage, kp)
subroutine conccalc(itime, weight)
subroutine initial_cond_calc(itime, i)
subroutine wetdepo(itime, ltsample, loutnext)