source: flexpart.git/src/concoutput.f90 @ 77778f8

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie
Last change on this file since 77778f8 was 20963b1, checked in by Espen Sollum ATMOS <eso@…>, 6 years ago

Backwards deposition for the MPI version

  • Property mode set to 100644
File size: 24.2 KB
RevLine 
[e200b7a]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
22subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
[b069789]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!*****************************************************************************
[e200b7a]59
60  use unc_mod
61  use point_mod
62  use outg_mod
63  use par_mod
64  use com_mod
[6a678e3]65  use mean_mod
[e200b7a]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
[b069789]75!real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
76!    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
77!    +    maxageclass)
78!real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
79!    +       maxageclass)
80!real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
81!    +       maxpointspec_act,maxageclass)
82!real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
83!    +       maxpointspec_act,maxageclass),
84!    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
85!    +     maxpointspec_act,maxageclass),
86!    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
87!    +     maxpointspec_act,maxageclass)
88!real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
89!real sparse_dump_r(numxgrid*numygrid*numzgrid)
90!integer sparse_dump_i(numxgrid*numygrid*numzgrid)
91
92!real sparse_dump_u(numxgrid*numygrid*numzgrid)
[6a678e3]93  real(dep_prec) :: auxgrid(nclassunc)
94  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
95  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
96  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
[e200b7a]97  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
98  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
99  real,parameter :: weightair=28.97
100  logical :: sp_zer
[b069789]101  logical,save :: init=.true.
[e200b7a]102  character :: adate*8,atime*6
103  character(len=3) :: anspec
[5f9d14a]104  integer :: mind
105! mind        eso:added to ensure identical results between 2&3-fields versions
[b069789]106  character(LEN=8),save :: file_stat='REPLACE'
107  logical :: ldates_file
108  integer :: ierr
109  character(LEN=100) :: dates_char
[e200b7a]110
[b069789]111! Determine current calendar date, needed for the file name
112!**********************************************************
[e200b7a]113
114  jul=bdate+real(itime,kind=dp)/86400._dp
115  call caldate(jul,jjjjmmdd,ihmmss)
116  write(adate,'(i8.8)') jjjjmmdd
117  write(atime,'(i6.6)') ihmmss
[b069789]118
119! Overwrite existing dates file on first call, later append to it
120! This fixes a bug where the dates file kept growing across multiple runs
121
[6b22af9]122! If 'dates' file exists in output directory, make a backup
[b069789]123  inquire(file=path(2)(1:length(2))//'dates', exist=ldates_file)
124  if (ldates_file.and.init) then
125    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
126         &access='sequential', status='old', action='read', iostat=ierr)
127    open(unit=unittmp, file=path(2)(1:length(2))//'dates.bak', access='sequential', &
128         &status='replace', action='write', form='formatted', iostat=ierr)
129    do while (.true.)
130      read(unitdates, '(a)', iostat=ierr) dates_char
131      if (ierr.ne.0) exit
132      write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
133    end do
134    close(unit=unitdates)
135    close(unit=unittmp)
136  end if
137
138  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND', STATUS=file_stat)
[e200b7a]139  write(unitdates,'(a)') adate//atime
[f13406c]140  close(unitdates) 
[e200b7a]141
[20963b1]142  ! Overwrite existing dates file on first call, later append to it
143  ! This fixes a bug where the dates file kept growing across multiple runs
[478e9e6]144  IF (init) THEN
145    file_stat='OLD'
146    init=.false.
147  END IF
148
149
[b069789]150! For forward simulations, output fields have dimension MAXSPEC,
151! for backward simulations, output fields have dimension MAXPOINT.
152! Thus, make loops either about nspec, or about numpoint
153!*****************************************************************
[e200b7a]154
155
156  if (ldirect.eq.1) then
157    do ks=1,nspec
158      do kp=1,maxpointspec_act
159        tot_mu(ks,kp)=1
160      end do
161    end do
162  else
163    do ks=1,nspec
164      do kp=1,maxpointspec_act
165        tot_mu(ks,kp)=xmass(kp,ks)
166      end do
167    end do
168  endif
169
170
[b069789]171!*******************************************************************
172! Compute air density: sufficiently accurate to take it
173! from coarse grid at some time
174! Determine center altitude of output layer, and interpolate density
175! data to that altitude
176!*******************************************************************
[e200b7a]177
[5f9d14a]178  mind=memind(2)
[e200b7a]179  do kz=1,numzgrid
180    if (kz.eq.1) then
181      halfheight=outheight(1)/2.
182    else
183      halfheight=(outheight(kz)+outheight(kz-1))/2.
184    endif
185    do kzz=2,nz
186      if ((height(kzz-1).lt.halfheight).and. &
187           (height(kzz).gt.halfheight)) goto 46
188    end do
[b069789]18946  kzz=max(min(kzz,nz),2)
[e200b7a]190    dz1=halfheight-height(kzz-1)
191    dz2=height(kzz)-halfheight
192    dz=dz1+dz2
193    do jy=0,numygrid-1
194      do ix=0,numxgrid-1
195        xl=outlon0+real(ix)*dxout
196        yl=outlat0+real(jy)*dyout
197        xl=(xl-xlon0)/dx
[f13406c]198        yl=(yl-ylat0)/dy !v9.1.1
[e200b7a]199        iix=max(min(nint(xl),nxmin1),0)
200        jjy=max(min(nint(yl),nymin1),0)
[b069789]201! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
202!      rho(iix,jjy,kzz-1,2)*dz2)/dz
[5f9d14a]203        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
204             rho(iix,jjy,kzz-1,mind)*dz2)/dz
[e200b7a]205      end do
206    end do
207  end do
208
[5f9d14a]209  do i=1,numreceptor
210    xl=xreceptor(i)
211    yl=yreceptor(i)
212    iix=max(min(nint(xl),nxmin1),0)
213    jjy=max(min(nint(yl),nymin1),0)
[b069789]214!densityoutrecept(i)=rho(iix,jjy,1,2)
[5f9d14a]215    densityoutrecept(i)=rho(iix,jjy,1,mind)
216  end do
[e200b7a]217
218
[b069789]219! Output is different for forward and backward simulations
220  do kz=1,numzgrid
221    do jy=0,numygrid-1
222      do ix=0,numxgrid-1
223        if (ldirect.eq.1) then
224          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
225        else
226          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
227        endif
[e200b7a]228      end do
229    end do
[b069789]230  end do
[e200b7a]231
[b069789]232!*********************************************************************
233! Determine the standard deviation of the mean concentration or mixing
234! ratio (uncertainty of the output) and the dry and wet deposition
235!*********************************************************************
[e200b7a]236
237  gridtotal=0.
238  gridsigmatotal=0.
239  gridtotalunc=0.
240  wetgridtotal=0.
241  wetgridsigmatotal=0.
242  wetgridtotalunc=0.
243  drygridtotal=0.
244  drygridsigmatotal=0.
245  drygridtotalunc=0.
246
247  do ks=1,nspec
248
[b069789]249    write(anspec,'(i3.3)') ks
[e200b7a]250
[54cbd6c]251    if (DRYBKDEP.or.WETBKDEP) then !scavdep output
252      if (DRYBKDEP) &
253      open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_'//adate// &
[b069789]254           atime//'_'//anspec,form='unformatted')
[54cbd6c]255      if (WETBKDEP) &
256      open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_'//adate// &
[462f74b]257           atime//'_'//anspec,form='unformatted')
258      write(unitoutgrid) itime
[54cbd6c]259    else
260      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
261        if (ldirect.eq.1) then
262          open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
[b069789]263             atime//'_'//anspec,form='unformatted')
[54cbd6c]264        else
265          open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
[b069789]266             atime//'_'//anspec,form='unformatted')
[54cbd6c]267        endif
268        write(unitoutgrid) itime
[b069789]269      endif
[54cbd6c]270      if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
271        open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
[b069789]272           atime//'_'//anspec,form='unformatted')
[54cbd6c]273        write(unitoutgridppt) itime
274      endif
275    endif ! if deposition output
[e200b7a]276
[b069789]277    do kp=1,maxpointspec_act
278      do nage=1,nageclass
[e200b7a]279
[b069789]280        do jy=0,numygrid-1
281          do ix=0,numxgrid-1
[e200b7a]282
[b069789]283! WET DEPOSITION
284            if ((WETDEP).and.(ldirect.gt.0)) then
285              do l=1,nclassunc
286                auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
287              end do
288              call mean(auxgrid,wetgrid(ix,jy), &
289                   wetgridsigma(ix,jy),nclassunc)
290! Multiply by number of classes to get total concentration
291              wetgrid(ix,jy)=wetgrid(ix,jy) &
292                   *nclassunc
293              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
294! Calculate standard deviation of the mean
295              wetgridsigma(ix,jy)= &
296                   wetgridsigma(ix,jy)* &
297                   sqrt(real(nclassunc))
298              wetgridsigmatotal=wetgridsigmatotal+ &
299                   wetgridsigma(ix,jy)
300            endif
301
302! DRY DEPOSITION
303            if ((DRYDEP).and.(ldirect.gt.0)) then
304              do l=1,nclassunc
305                auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
306              end do
307              call mean(auxgrid,drygrid(ix,jy), &
308                   drygridsigma(ix,jy),nclassunc)
309! Multiply by number of classes to get total concentration
310              drygrid(ix,jy)=drygrid(ix,jy)* &
311                   nclassunc
312              drygridtotal=drygridtotal+drygrid(ix,jy)
313! Calculate standard deviation of the mean
314              drygridsigma(ix,jy)= &
315                   drygridsigma(ix,jy)* &
316                   sqrt(real(nclassunc))
[20963b1]317              drygridsigmatotal=drygridsigmatotal+ &
[b069789]318                   drygridsigma(ix,jy)
319            endif
320
321! CONCENTRATION OR MIXING RATIO
322            do kz=1,numzgrid
323              do l=1,nclassunc
324                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
325              end do
326              call mean(auxgrid,grid(ix,jy,kz), &
327                   gridsigma(ix,jy,kz),nclassunc)
328! Multiply by number of classes to get total concentration
329              grid(ix,jy,kz)= &
330                   grid(ix,jy,kz)*nclassunc
331              gridtotal=gridtotal+grid(ix,jy,kz)
332! Calculate standard deviation of the mean
333              gridsigma(ix,jy,kz)= &
334                   gridsigma(ix,jy,kz)* &
335                   sqrt(real(nclassunc))
336              gridsigmatotal=gridsigmatotal+ &
337                   gridsigma(ix,jy,kz)
[e200b7a]338            end do
[b069789]339          end do
[e200b7a]340        end do
341
342
343
344
[b069789]345!*******************************************************************
346! Generate output: may be in concentration (ng/m3) or in mixing
347! ratio (ppt) or both
348! Output the position and the values alternated multiplied by
349! 1 or -1, first line is number of values, number of positions
350! For backward simulations, the unit is seconds, stored in grid_time
351!*******************************************************************
[e200b7a]352
[b069789]353! Concentration output
354!*********************
[462f74b]355        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5).or.(iout.eq.6)) then
[e200b7a]356
[b069789]357! Wet deposition
358          sp_count_i=0
359          sp_count_r=0
360          sp_fact=-1.
361          sp_zer=.true.
362          if ((ldirect.eq.1).and.(WETDEP)) then
363            do jy=0,numygrid-1
364              do ix=0,numxgrid-1
365!oncentraion greater zero
366                if (wetgrid(ix,jy).gt.smallnum) then
367                  if (sp_zer.eqv..true.) then ! first non zero value
[e200b7a]368                    sp_count_i=sp_count_i+1
369                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
370                    sp_zer=.false.
371                    sp_fact=sp_fact*(-1.)
[b069789]372                  endif
373                  sp_count_r=sp_count_r+1
374                  sparse_dump_r(sp_count_r)= &
375                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
376!                sparse_dump_u(sp_count_r)=
377!+                1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
378                else ! concentration is zero
[e200b7a]379                  sp_zer=.true.
[b069789]380                endif
381              end do
[e200b7a]382            end do
[b069789]383          else
[e200b7a]384            sp_count_i=0
385            sp_count_r=0
[b069789]386          endif
387          write(unitoutgrid) sp_count_i
388          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
389          write(unitoutgrid) sp_count_r
390          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
391!       write(unitoutgrid) sp_count_u
392!       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
393
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
[e200b7a]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.)
[b069789]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,ks,kp,nage)/area(ix,jy)
415                else ! concentration is zero
[e200b7a]416                  sp_zer=.true.
[b069789]417                endif
418              end do
[e200b7a]419            end do
[b069789]420          else
[e200b7a]421            sp_count_i=0
422            sp_count_r=0
[b069789]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(*,*) sp_count_u
429!       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
[e200b7a]430
431
432
[b069789]433! Concentrations
434          sp_count_i=0
435          sp_count_r=0
436          sp_fact=-1.
437          sp_zer=.true.
[e200b7a]438          do kz=1,numzgrid
439            do jy=0,numygrid-1
440              do ix=0,numxgrid-1
441                if (grid(ix,jy,kz).gt.smallnum) then
442                  if (sp_zer.eqv..true.) then ! first non zero value
443                    sp_count_i=sp_count_i+1
444                    sparse_dump_i(sp_count_i)= &
445                         ix+jy*numxgrid+kz*numxgrid*numygrid
446                    sp_zer=.false.
447                    sp_fact=sp_fact*(-1.)
[b069789]448                  endif
449                  sp_count_r=sp_count_r+1
[08a38b5]450                  if (lparticlecountoutput) then
451                    sparse_dump_r(sp_count_r)= &
452                         sp_fact* &
453                         grid(ix,jy,kz)
454                  else
455                    sparse_dump_r(sp_count_r)= &
456                         sp_fact* &
457                         grid(ix,jy,kz)* &
458                         factor3d(ix,jy,kz)/tot_mu(ks,kp)
459                  end if
460
461
[b069789]462!                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
463!    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
464!                sparse_dump_u(sp_count_r)=
465!+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
466!+               factor(ix,jy,kz)/tot_mu(ks,kp)
467                else ! concentration is zero
[e200b7a]468                  sp_zer=.true.
[b069789]469                endif
[e200b7a]470              end do
471            end do
472          end do
[b069789]473          write(unitoutgrid) sp_count_i
474          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
475          write(unitoutgrid) sp_count_r
476          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
477!       write(unitoutgrid) sp_count_u
478!       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
[e200b7a]479
480
481
[b069789]482        endif !  concentration output
[e200b7a]483
[b069789]484! Mixing ratio output
485!********************
[e200b7a]486
[b069789]487        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
[e200b7a]488
[b069789]489! Wet deposition
490          sp_count_i=0
491          sp_count_r=0
492          sp_fact=-1.
493          sp_zer=.true.
494          if ((ldirect.eq.1).and.(WETDEP)) then
495            do jy=0,numygrid-1
496              do ix=0,numxgrid-1
[e200b7a]497                if (wetgrid(ix,jy).gt.smallnum) then
498                  if (sp_zer.eqv..true.) then ! first non zero value
499                    sp_count_i=sp_count_i+1
500                    sparse_dump_i(sp_count_i)= &
501                         ix+jy*numxgrid
502                    sp_zer=.false.
503                    sp_fact=sp_fact*(-1.)
[b069789]504                  endif
505                  sp_count_r=sp_count_r+1
506                  sparse_dump_r(sp_count_r)= &
507                       sp_fact* &
508                       1.e12*wetgrid(ix,jy)/area(ix,jy)
509!                sparse_dump_u(sp_count_r)=
510!    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
511                else ! concentration is zero
[e200b7a]512                  sp_zer=.true.
[b069789]513                endif
514              end do
[e200b7a]515            end do
[b069789]516          else
517            sp_count_i=0
518            sp_count_r=0
519          endif
520          write(unitoutgridppt) sp_count_i
521          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
522          write(unitoutgridppt) sp_count_r
523          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
524!       write(unitoutgridppt) sp_count_u
525!       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
526
527
528! Dry deposition
529          sp_count_i=0
530          sp_count_r=0
531          sp_fact=-1.
532          sp_zer=.true.
533          if ((ldirect.eq.1).and.(DRYDEP)) then
534            do jy=0,numygrid-1
535              do ix=0,numxgrid-1
[e200b7a]536                if (drygrid(ix,jy).gt.smallnum) then
537                  if (sp_zer.eqv..true.) then ! first non zero value
538                    sp_count_i=sp_count_i+1
539                    sparse_dump_i(sp_count_i)= &
540                         ix+jy*numxgrid
541                    sp_zer=.false.
542                    sp_fact=sp_fact*(-1)
[b069789]543                  endif
544                  sp_count_r=sp_count_r+1
545                  sparse_dump_r(sp_count_r)= &
546                       sp_fact* &
547                       1.e12*drygrid(ix,jy)/area(ix,jy)
548!                sparse_dump_u(sp_count_r)=
549!    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
550                else ! concentration is zero
[e200b7a]551                  sp_zer=.true.
[b069789]552                endif
553              end do
[e200b7a]554            end do
[b069789]555          else
556            sp_count_i=0
557            sp_count_r=0
558          endif
559          write(unitoutgridppt) sp_count_i
560          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
561          write(unitoutgridppt) sp_count_r
562          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
563!       write(unitoutgridppt) sp_count_u
564!       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
565
566
567! Mixing ratios
568          sp_count_i=0
569          sp_count_r=0
570          sp_fact=-1.
571          sp_zer=.true.
[e200b7a]572          do kz=1,numzgrid
573            do jy=0,numygrid-1
574              do ix=0,numxgrid-1
575                if (grid(ix,jy,kz).gt.smallnum) then
576                  if (sp_zer.eqv..true.) then ! first non zero value
577                    sp_count_i=sp_count_i+1
578                    sparse_dump_i(sp_count_i)= &
579                         ix+jy*numxgrid+kz*numxgrid*numygrid
580                    sp_zer=.false.
581                    sp_fact=sp_fact*(-1.)
[b069789]582                  endif
583                  sp_count_r=sp_count_r+1
584                  sparse_dump_r(sp_count_r)= &
585                       sp_fact* &
586                       1.e12*grid(ix,jy,kz) &
587                       /volume(ix,jy,kz)/outnum* &
588                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
589!                sparse_dump_u(sp_count_r)=
590!+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
591!+              outnum*weightair/weightmolar(ks)/
592!+              densityoutgrid(ix,jy,kz)
593                else ! concentration is zero
[e200b7a]594                  sp_zer=.true.
[b069789]595                endif
[e200b7a]596              end do
597            end do
598          end do
[b069789]599          write(unitoutgridppt) sp_count_i
600          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
601          write(unitoutgridppt) sp_count_r
602          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
603!       write(unitoutgridppt) sp_count_u
604!       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
[e200b7a]605
[b069789]606        endif ! output for ppt
[e200b7a]607
[b069789]608      end do
609    end do
[e200b7a]610
611    close(unitoutgridppt)
612    close(unitoutgrid)
613
614  end do
615
616  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
617  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
618       wetgridtotal
619  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
620       drygridtotal
621
[b069789]622! Dump of receptor concentrations
[e200b7a]623
[b069789]624  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
625    write(unitoutreceptppt) itime
626    do ks=1,nspec
627      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
628           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
629    end do
630  endif
[e200b7a]631
[b069789]632! Dump of receptor concentrations
[e200b7a]633
[b069789]634  if (numreceptor.gt.0) then
635    write(unitoutrecept) itime
636    do ks=1,nspec
637      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
638           i=1,numreceptor)
639    end do
640  endif
[e200b7a]641
642
643
[b069789]644! Reinitialization of grid
645!*************************
[e200b7a]646
[16b61a5]647! do ks=1,nspec
648!   do kp=1,maxpointspec_act
649!     do i=1,numreceptor
650!       creceptor(i,ks)=0.
651!     end do
652!     do jy=0,numygrid-1
653!       do ix=0,numxgrid-1
654!         do l=1,nclassunc
655!           do nage=1,nageclass
656!             do kz=1,numzgrid
657!               gridunc(ix,jy,kz,ks,kp,l,nage)=0.
658!             end do
659!           end do
660!         end do
661!       end do
662!     end do
663!   end do
664! end do
[db712a8]665  creceptor(:,:)=0.
666  gridunc(:,:,:,:,:,:,:)=0.
[e200b7a]667
668
669end subroutine concoutput
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG