51 integer :: itime,ix,jy,kz,k,nage,jjjjmmdd,ihmmss,kp,i
52 integer :: ncellse(maxspec,maxageclass),ncellsw(maxspec,maxageclass)
53 integer :: ncellss(maxspec,maxageclass),ncellsn(maxspec,maxageclass)
54 integer :: ncellsu(maxspec,maxageclass),ncellsd(maxspec,maxageclass)
55 logical :: sparsee(maxspec,maxageclass),sparsew(maxspec,maxageclass)
56 logical :: sparses(maxspec,maxageclass),sparsen(maxspec,maxageclass)
57 logical :: sparseu(maxspec,maxageclass),sparsed(maxspec,maxageclass)
58 character :: adate*8,atime*6
64 jul=bdate+
real(itime,kind=dp)/86400._dp
65 call
caldate(jul,jjjjmmdd,ihmmss)
66 write(adate,
'(i8.8)') jjjjmmdd
67 write(atime,
'(i6.6)') ihmmss
70 open(unitflux,file=path(2)(1:length(2))//
'grid_flux_'//adate// &
71 atime,form=
'unformatted')
91 do kp=1,maxpointspec_act
96 if (flux(2,ix,jy,kz,k,kp,nage).gt.0) ncellse(k,nage)= &
98 if (flux(1,ix,jy,kz,k,kp,nage).gt.0) ncellsw(k,nage)= &
100 if (flux(4,ix,jy,kz,k,kp,nage).gt.0) ncellsn(k,nage)= &
102 if (flux(3,ix,jy,kz,k,kp,nage).gt.0) ncellss(k,nage)= &
104 if (flux(5,ix,jy,kz,k,kp,nage).gt.0) ncellsu(k,nage)= &
106 if (flux(6,ix,jy,kz,k,kp,nage).gt.0) ncellsd(k,nage)= &
121 if (4*ncellse(k,nage).lt.numxgrid*numygrid*numzgrid)
then
122 sparsee(k,nage)=.true.
124 sparsee(k,nage)=.false.
126 if (4*ncellsw(k,nage).lt.numxgrid*numygrid*numzgrid)
then
127 sparsew(k,nage)=.true.
129 sparsew(k,nage)=.false.
131 if (4*ncellsn(k,nage).lt.numxgrid*numygrid*numzgrid)
then
132 sparsen(k,nage)=.true.
134 sparsen(k,nage)=.false.
136 if (4*ncellss(k,nage).lt.numxgrid*numygrid*numzgrid)
then
137 sparses(k,nage)=.true.
139 sparses(k,nage)=.false.
141 if (4*ncellsu(k,nage).lt.numxgrid*numygrid*numzgrid)
then
142 sparseu(k,nage)=.true.
144 sparseu(k,nage)=.false.
146 if (4*ncellsd(k,nage).lt.numxgrid*numygrid*numzgrid)
then
147 sparsed(k,nage)=.true.
149 sparsed(k,nage)=.false.
159 write(unitflux) itime
161 do kp=1,maxpointspec_act
164 if (sparsee(k,nage))
then
169 if (flux(2,ix,jy,kz,k,kp,nage).gt.0.)
write(unitflux) &
170 ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
171 flux(2,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
175 write(unitflux) -999,999.
180 write(unitflux) (1.e12*flux(2,ix,jy,kz,k,kp,nage)/ &
181 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
186 if (sparsew(k,nage))
then
191 if (flux(1,ix,jy,kz,k,kp,nage).gt.0.)
write(unitflux) &
192 ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
193 flux(1,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
197 write(unitflux) -999,999.
202 write(unitflux) (1.e12*flux(1,ix,jy,kz,k,kp,nage)/ &
203 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
208 if (sparses(k,nage))
then
213 if (flux(3,ix,jy,kz,k,kp,nage).gt.0.)
write(unitflux) &
214 ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
215 flux(3,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
219 write(unitflux) -999,999.
224 write(unitflux) (1.e12*flux(3,ix,jy,kz,k,kp,nage)/ &
225 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
230 if (sparsen(k,nage))
then
235 if (flux(4,ix,jy,kz,k,kp,nage).gt.0.)
write(unitflux) &
236 ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
237 flux(4,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
241 write(unitflux) -999,999.
246 write(unitflux) (1.e12*flux(4,ix,jy,kz,k,kp,nage)/ &
247 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
252 if (sparseu(k,nage))
then
257 if (flux(5,ix,jy,kz,k,kp,nage).gt.0.)
write(unitflux) &
258 ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
259 flux(5,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
263 write(unitflux) -999,999.
268 write(unitflux) (1.e12*flux(5,ix,jy,kz,k,kp,nage)/ &
269 area(ix,jy)/outstep,jy=0,numygrid-1)
274 if (sparsed(k,nage))
then
279 if (flux(6,ix,jy,kz,k,kp,nage).gt.0.)
write(unitflux) &
280 ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
281 flux(6,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
285 write(unitflux) -999,999.
290 write(unitflux) (1.e12*flux(6,ix,jy,kz,k,kp,nage)/ &
291 area(ix,jy)/outstep,jy=0,numygrid-1)
308 do kp=1,maxpointspec_act
314 flux(i,ix,jy,kz,k,kp,nage)=0.
subroutine caldate(juldate, yyyymmdd, hhmiss)
subroutine fluxoutput(itime)