concoutput.f90 24.2 KB
Newer Older
Matthias Langer's avatar
 
Matthias Langer committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
!**********************************************************************
! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
!                                                                     *
! This file is part of FLEXPART.                                      *
!                                                                     *
! FLEXPART is free software: you can redistribute it and/or modify    *
! it under the terms of the GNU General Public License as published by*
! the Free Software Foundation, either version 3 of the License, or   *
! (at your option) any later version.                                 *
!                                                                     *
! FLEXPART is distributed in the hope that it will be useful,         *
! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
! GNU General Public License for more details.                        *
!                                                                     *
! You should have received a copy of the GNU General Public License   *
! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
!**********************************************************************

subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
     drygridtotalunc)
!                        i     i          o             o
!       o
!*****************************************************************************
!                                                                            *
!     Output of the concentration grid and the receptor concentrations.      *
!                                                                            *
!     Author: A. Stohl                                                       *
!                                                                            *
!     24 May 1995                                                            *
!                                                                            *
!     13 April 1999, Major update: if output size is smaller, dump output    *
!                    in sparse matrix format; additional output of           *
!                    uncertainty                                             *
!                                                                            *
!     05 April 2000, Major update: output of age classes; output for backward*
!                    runs is time spent in grid cell times total mass of     *
!                    species.                                                *
!                                                                            *
!     17 February 2002, Appropriate dimensions for backward and forward runs *
!                       are now specified in file par_mod                    *
!                                                                            *
!     June 2006, write grid in sparse matrix with a single write command     *
!                in order to save disk space                                 *
!                                                                            *
!     2008 new sparse matrix format                                          *
!                                                                            *
!*****************************************************************************
!                                                                            *
! Variables:                                                                 *
! outnum          number of samples                                          *
! ncells          number of cells with non-zero concentrations               *
! sparse          .true. if in sparse matrix format, else .false.            *
! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
!                                                                            *
!*****************************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
59
60
61
62
63
64

  use unc_mod
  use point_mod
  use outg_mod
  use par_mod
  use com_mod
65
  use mean_mod
Matthias Langer's avatar
 
Matthias Langer committed
66
67
68
69
70
71
72
73
74

  implicit none

  real(kind=dp) :: jul
  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
  integer :: sp_count_i,sp_count_r
  real :: sp_fact
  real :: outnum,densityoutrecept(maxreceptor),xl,yl

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
!real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
!    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
!    +    maxageclass)
!real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
!    +       maxageclass)
!real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
!    +       maxpointspec_act,maxageclass)
!real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
!    +       maxpointspec_act,maxageclass),
!    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
!    +     maxpointspec_act,maxageclass),
!    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
!    +     maxpointspec_act,maxageclass)
!real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
!real sparse_dump_r(numxgrid*numygrid*numzgrid)
!integer sparse_dump_i(numxgrid*numygrid*numzgrid)

!real sparse_dump_u(numxgrid*numygrid*numzgrid)
93
94
95
96
  real(dep_prec) :: auxgrid(nclassunc)
  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
Matthias Langer's avatar
 
Matthias Langer committed
97
98
99
100
  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
  real,parameter :: weightair=28.97
  logical :: sp_zer
101
  logical,save :: init=.true.
Matthias Langer's avatar
 
Matthias Langer committed
102
103
  character :: adate*8,atime*6
  character(len=3) :: anspec
Espen Sollum's avatar
Espen Sollum committed
104
105
  integer :: mind
! mind        eso:added to ensure identical results between 2&3-fields versions
106
107
108
109
  character(LEN=8),save :: file_stat='REPLACE'
  logical :: ldates_file
  integer :: ierr
  character(LEN=100) :: dates_char
Matthias Langer's avatar
 
Matthias Langer committed
110

111
112
! Determine current calendar date, needed for the file name
!**********************************************************
Matthias Langer's avatar
 
Matthias Langer committed
113
114
115
116
117

  jul=bdate+real(itime,kind=dp)/86400._dp
  call caldate(jul,jjjjmmdd,ihmmss)
  write(adate,'(i8.8)') jjjjmmdd
  write(atime,'(i6.6)') ihmmss
118
119
120
121

! Overwrite existing dates file on first call, later append to it
! This fixes a bug where the dates file kept growing across multiple runs

122
! If 'dates' file exists in output directory, make a backup
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
  inquire(file=path(2)(1:length(2))//'dates', exist=ldates_file)
  if (ldates_file.and.init) then
    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
         &access='sequential', status='old', action='read', iostat=ierr)
    open(unit=unittmp, file=path(2)(1:length(2))//'dates.bak', access='sequential', &
         &status='replace', action='write', form='formatted', iostat=ierr)
    do while (.true.)
      read(unitdates, '(a)', iostat=ierr) dates_char
      if (ierr.ne.0) exit
      write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
    end do
    close(unit=unitdates)
    close(unit=unittmp)
  end if

  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND', STATUS=file_stat)
Matthias Langer's avatar
 
Matthias Langer committed
139
  write(unitdates,'(a)') adate//atime
140
  close(unitdates)  
Matthias Langer's avatar
 
Matthias Langer committed
141

142
143
  ! Overwrite existing dates file on first call, later append to it
  ! This fixes a bug where the dates file kept growing across multiple runs
144
145
146
147
148
149
  IF (init) THEN
    file_stat='OLD'
    init=.false.
  END IF


150
151
152
153
! For forward simulations, output fields have dimension MAXSPEC,
! for backward simulations, output fields have dimension MAXPOINT.
! Thus, make loops either about nspec, or about numpoint
!*****************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170


  if (ldirect.eq.1) then
    do ks=1,nspec
      do kp=1,maxpointspec_act
        tot_mu(ks,kp)=1
      end do
    end do
  else
    do ks=1,nspec
      do kp=1,maxpointspec_act
        tot_mu(ks,kp)=xmass(kp,ks)
      end do
    end do
  endif


171
172
173
174
175
176
!*******************************************************************
! Compute air density: sufficiently accurate to take it
! from coarse grid at some time
! Determine center altitude of output layer, and interpolate density
! data to that altitude
!*******************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
177

Espen Sollum's avatar
Espen Sollum committed
178
  mind=memind(2)
Matthias Langer's avatar
 
Matthias Langer committed
179
180
181
182
183
184
185
186
187
188
  do kz=1,numzgrid
    if (kz.eq.1) then
      halfheight=outheight(1)/2.
    else
      halfheight=(outheight(kz)+outheight(kz-1))/2.
    endif
    do kzz=2,nz
      if ((height(kzz-1).lt.halfheight).and. &
           (height(kzz).gt.halfheight)) goto 46
    end do
189
46  kzz=max(min(kzz,nz),2)
Matthias Langer's avatar
 
Matthias Langer committed
190
191
192
193
194
195
196
197
    dz1=halfheight-height(kzz-1)
    dz2=height(kzz)-halfheight
    dz=dz1+dz2
    do jy=0,numygrid-1
      do ix=0,numxgrid-1
        xl=outlon0+real(ix)*dxout
        yl=outlat0+real(jy)*dyout
        xl=(xl-xlon0)/dx
198
        yl=(yl-ylat0)/dy !v9.1.1 
Matthias Langer's avatar
 
Matthias Langer committed
199
200
        iix=max(min(nint(xl),nxmin1),0)
        jjy=max(min(nint(yl),nymin1),0)
201
202
! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
!      rho(iix,jjy,kzz-1,2)*dz2)/dz
Espen Sollum's avatar
Espen Sollum committed
203
204
        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
             rho(iix,jjy,kzz-1,mind)*dz2)/dz
Matthias Langer's avatar
 
Matthias Langer committed
205
206
207
208
      end do
    end do
  end do

Espen Sollum's avatar
Espen Sollum committed
209
210
211
212
213
  do i=1,numreceptor
    xl=xreceptor(i)
    yl=yreceptor(i)
    iix=max(min(nint(xl),nxmin1),0)
    jjy=max(min(nint(yl),nymin1),0)
214
!densityoutrecept(i)=rho(iix,jjy,1,2)
Espen Sollum's avatar
Espen Sollum committed
215
216
    densityoutrecept(i)=rho(iix,jjy,1,mind)
  end do
Matthias Langer's avatar
 
Matthias Langer committed
217
218


219
220
221
222
223
224
225
226
227
! Output is different for forward and backward simulations
  do kz=1,numzgrid
    do jy=0,numygrid-1
      do ix=0,numxgrid-1
        if (ldirect.eq.1) then
          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
        else
          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
        endif
Matthias Langer's avatar
 
Matthias Langer committed
228
229
      end do
    end do
230
  end do
Matthias Langer's avatar
 
Matthias Langer committed
231

232
233
234
235
!*********************************************************************
! Determine the standard deviation of the mean concentration or mixing
! ratio (uncertainty of the output) and the dry and wet deposition
!*********************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
236
237
238
239
240
241
242
243
244
245
246
247
248

  gridtotal=0.
  gridsigmatotal=0.
  gridtotalunc=0.
  wetgridtotal=0.
  wetgridsigmatotal=0.
  wetgridtotalunc=0.
  drygridtotal=0.
  drygridsigmatotal=0.
  drygridtotalunc=0.

  do ks=1,nspec

249
    write(anspec,'(i3.3)') ks
Matthias Langer's avatar
 
Matthias Langer committed
250

251
252
253
    if (DRYBKDEP.or.WETBKDEP) then !scavdep output
      if (DRYBKDEP) & 
      open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_'//adate// &
254
           atime//'_'//anspec,form='unformatted')
255
256
      if (WETBKDEP) & 
      open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_'//adate// &
257
258
           atime//'_'//anspec,form='unformatted')
      write(unitoutgrid) itime
259
260
261
262
    else
      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
        if (ldirect.eq.1) then
          open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
263
             atime//'_'//anspec,form='unformatted')
264
265
        else
          open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
266
             atime//'_'//anspec,form='unformatted')
267
268
        endif
        write(unitoutgrid) itime
269
      endif
270
271
      if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
        open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
272
           atime//'_'//anspec,form='unformatted')
273
274
275
        write(unitoutgridppt) itime
      endif
    endif ! if deposition output
Matthias Langer's avatar
 
Matthias Langer committed
276

277
278
    do kp=1,maxpointspec_act
      do nage=1,nageclass
Matthias Langer's avatar
 
Matthias Langer committed
279

280
281
        do jy=0,numygrid-1
          do ix=0,numxgrid-1
Matthias Langer's avatar
 
Matthias Langer committed
282

283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
! WET DEPOSITION
            if ((WETDEP).and.(ldirect.gt.0)) then
              do l=1,nclassunc
                auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
              end do
              call mean(auxgrid,wetgrid(ix,jy), &
                   wetgridsigma(ix,jy),nclassunc)
! Multiply by number of classes to get total concentration
              wetgrid(ix,jy)=wetgrid(ix,jy) &
                   *nclassunc
              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
! Calculate standard deviation of the mean
              wetgridsigma(ix,jy)= &
                   wetgridsigma(ix,jy)* &
                   sqrt(real(nclassunc))
              wetgridsigmatotal=wetgridsigmatotal+ &
                   wetgridsigma(ix,jy)
            endif

! DRY DEPOSITION
            if ((DRYDEP).and.(ldirect.gt.0)) then
              do l=1,nclassunc
                auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
              end do
              call mean(auxgrid,drygrid(ix,jy), &
                   drygridsigma(ix,jy),nclassunc)
! Multiply by number of classes to get total concentration
              drygrid(ix,jy)=drygrid(ix,jy)* &
                   nclassunc
              drygridtotal=drygridtotal+drygrid(ix,jy)
! Calculate standard deviation of the mean
              drygridsigma(ix,jy)= &
                   drygridsigma(ix,jy)* &
                   sqrt(real(nclassunc))
317
              drygridsigmatotal=drygridsigmatotal+ &
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
                   drygridsigma(ix,jy)
            endif

! CONCENTRATION OR MIXING RATIO
            do kz=1,numzgrid
              do l=1,nclassunc
                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
              end do
              call mean(auxgrid,grid(ix,jy,kz), &
                   gridsigma(ix,jy,kz),nclassunc)
! Multiply by number of classes to get total concentration
              grid(ix,jy,kz)= &
                   grid(ix,jy,kz)*nclassunc
              gridtotal=gridtotal+grid(ix,jy,kz)
! Calculate standard deviation of the mean
              gridsigma(ix,jy,kz)= &
                   gridsigma(ix,jy,kz)* &
                   sqrt(real(nclassunc))
              gridsigmatotal=gridsigmatotal+ &
                   gridsigma(ix,jy,kz)
Matthias Langer's avatar
 
Matthias Langer committed
338
            end do
339
          end do
Matthias Langer's avatar
 
Matthias Langer committed
340
341
342
343
344
        end do




345
346
347
348
349
350
351
!*******************************************************************
! Generate output: may be in concentration (ng/m3) or in mixing
! ratio (ppt) or both
! Output the position and the values alternated multiplied by
! 1 or -1, first line is number of values, number of positions
! For backward simulations, the unit is seconds, stored in grid_time
!*******************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
352

353
354
! Concentration output
!*********************
355
        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5).or.(iout.eq.6)) then
Matthias Langer's avatar
 
Matthias Langer committed
356

357
358
359
360
361
362
363
364
365
366
367
! Wet deposition
          sp_count_i=0
          sp_count_r=0
          sp_fact=-1.
          sp_zer=.true.
          if ((ldirect.eq.1).and.(WETDEP)) then
            do jy=0,numygrid-1
              do ix=0,numxgrid-1
!oncentraion greater zero
                if (wetgrid(ix,jy).gt.smallnum) then
                  if (sp_zer.eqv..true.) then ! first non zero value
Matthias Langer's avatar
 
Matthias Langer committed
368
369
370
371
                    sp_count_i=sp_count_i+1
                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
                    sp_zer=.false.
                    sp_fact=sp_fact*(-1.)
372
373
374
375
376
377
378
                  endif
                  sp_count_r=sp_count_r+1
                  sparse_dump_r(sp_count_r)= &
                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
!                sparse_dump_u(sp_count_r)=
!+                1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
                else ! concentration is zero
Matthias Langer's avatar
 
Matthias Langer committed
379
                  sp_zer=.true.
380
381
                endif
              end do
Matthias Langer's avatar
 
Matthias Langer committed
382
            end do
383
          else
Matthias Langer's avatar
 
Matthias Langer committed
384
385
            sp_count_i=0
            sp_count_r=0
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
          endif
          write(unitoutgrid) sp_count_i
          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
          write(unitoutgrid) sp_count_r
          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
!       write(unitoutgrid) sp_count_u
!       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)

! Dry deposition
          sp_count_i=0
          sp_count_r=0
          sp_fact=-1.
          sp_zer=.true.
          if ((ldirect.eq.1).and.(DRYDEP)) then
            do jy=0,numygrid-1
              do ix=0,numxgrid-1
                if (drygrid(ix,jy).gt.smallnum) then
                  if (sp_zer.eqv..true.) then ! first non zero value
Matthias Langer's avatar
 
Matthias Langer committed
404
405
406
407
                    sp_count_i=sp_count_i+1
                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
                    sp_zer=.false.
                    sp_fact=sp_fact*(-1.)
408
409
410
411
412
413
414
415
                  endif
                  sp_count_r=sp_count_r+1
                  sparse_dump_r(sp_count_r)= &
                       sp_fact* &
                       1.e12*drygrid(ix,jy)/area(ix,jy)
!                sparse_dump_u(sp_count_r)=
!+                1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
                else ! concentration is zero
Matthias Langer's avatar
 
Matthias Langer committed
416
                  sp_zer=.true.
417
418
                endif
              end do
Matthias Langer's avatar
 
Matthias Langer committed
419
            end do
420
          else
Matthias Langer's avatar
 
Matthias Langer committed
421
422
            sp_count_i=0
            sp_count_r=0
423
424
425
426
427
428
429
          endif
          write(unitoutgrid) sp_count_i
          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
          write(unitoutgrid) sp_count_r
          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
!       write(*,*) sp_count_u
!       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
Matthias Langer's avatar
 
Matthias Langer committed
430
431
432



433
434
435
436
437
! Concentrations
          sp_count_i=0
          sp_count_r=0
          sp_fact=-1.
          sp_zer=.true.
Matthias Langer's avatar
 
Matthias Langer committed
438
439
440
441
442
443
444
445
446
447
          do kz=1,numzgrid
            do jy=0,numygrid-1
              do ix=0,numxgrid-1
                if (grid(ix,jy,kz).gt.smallnum) then
                  if (sp_zer.eqv..true.) then ! first non zero value
                    sp_count_i=sp_count_i+1
                    sparse_dump_i(sp_count_i)= &
                         ix+jy*numxgrid+kz*numxgrid*numygrid
                    sp_zer=.false.
                    sp_fact=sp_fact*(-1.)
448
449
                  endif
                  sp_count_r=sp_count_r+1
450
451
452
453
454
455
456
457
458
459
460
461
                  if (lparticlecountoutput) then
                    sparse_dump_r(sp_count_r)= &
                         sp_fact* &
                         grid(ix,jy,kz)
                  else
                    sparse_dump_r(sp_count_r)= &
                         sp_fact* &
                         grid(ix,jy,kz)* &
                         factor3d(ix,jy,kz)/tot_mu(ks,kp)
                  end if


462
463
464
465
466
467
!                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
!    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
!                sparse_dump_u(sp_count_r)=
!+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
!+               factor(ix,jy,kz)/tot_mu(ks,kp)
                else ! concentration is zero
Matthias Langer's avatar
 
Matthias Langer committed
468
                  sp_zer=.true.
469
                endif
Matthias Langer's avatar
 
Matthias Langer committed
470
471
472
              end do
            end do
          end do
473
474
475
476
477
478
          write(unitoutgrid) sp_count_i
          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
          write(unitoutgrid) sp_count_r
          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
!       write(unitoutgrid) sp_count_u
!       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
Matthias Langer's avatar
 
Matthias Langer committed
479
480
481



482
        endif !  concentration output
Matthias Langer's avatar
 
Matthias Langer committed
483

484
485
! Mixing ratio output
!********************
Matthias Langer's avatar
 
Matthias Langer committed
486

487
        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
Matthias Langer's avatar
 
Matthias Langer committed
488

489
490
491
492
493
494
495
496
! Wet deposition
          sp_count_i=0
          sp_count_r=0
          sp_fact=-1.
          sp_zer=.true.
          if ((ldirect.eq.1).and.(WETDEP)) then
            do jy=0,numygrid-1
              do ix=0,numxgrid-1
Matthias Langer's avatar
 
Matthias Langer committed
497
498
499
500
501
502
503
                if (wetgrid(ix,jy).gt.smallnum) then
                  if (sp_zer.eqv..true.) then ! first non zero value
                    sp_count_i=sp_count_i+1
                    sparse_dump_i(sp_count_i)= &
                         ix+jy*numxgrid
                    sp_zer=.false.
                    sp_fact=sp_fact*(-1.)
504
505
506
507
508
509
510
511
                  endif
                  sp_count_r=sp_count_r+1
                  sparse_dump_r(sp_count_r)= &
                       sp_fact* &
                       1.e12*wetgrid(ix,jy)/area(ix,jy)
!                sparse_dump_u(sp_count_r)=
!    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
                else ! concentration is zero
Matthias Langer's avatar
 
Matthias Langer committed
512
                  sp_zer=.true.
513
514
                endif
              end do
Matthias Langer's avatar
 
Matthias Langer committed
515
            end do
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
          else
            sp_count_i=0
            sp_count_r=0
          endif
          write(unitoutgridppt) sp_count_i
          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
          write(unitoutgridppt) sp_count_r
          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
!       write(unitoutgridppt) sp_count_u
!       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)


! Dry deposition
          sp_count_i=0
          sp_count_r=0
          sp_fact=-1.
          sp_zer=.true.
          if ((ldirect.eq.1).and.(DRYDEP)) then
            do jy=0,numygrid-1
              do ix=0,numxgrid-1
Matthias Langer's avatar
 
Matthias Langer committed
536
537
538
539
540
541
542
                if (drygrid(ix,jy).gt.smallnum) then
                  if (sp_zer.eqv..true.) then ! first non zero value
                    sp_count_i=sp_count_i+1
                    sparse_dump_i(sp_count_i)= &
                         ix+jy*numxgrid
                    sp_zer=.false.
                    sp_fact=sp_fact*(-1)
543
544
545
546
547
548
549
550
                  endif
                  sp_count_r=sp_count_r+1
                  sparse_dump_r(sp_count_r)= &
                       sp_fact* &
                       1.e12*drygrid(ix,jy)/area(ix,jy)
!                sparse_dump_u(sp_count_r)=
!    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
                else ! concentration is zero
Matthias Langer's avatar
 
Matthias Langer committed
551
                  sp_zer=.true.
552
553
                endif
              end do
Matthias Langer's avatar
 
Matthias Langer committed
554
            end do
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
          else
            sp_count_i=0
            sp_count_r=0
          endif
          write(unitoutgridppt) sp_count_i
          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
          write(unitoutgridppt) sp_count_r
          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
!       write(unitoutgridppt) sp_count_u
!       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)


! Mixing ratios
          sp_count_i=0
          sp_count_r=0
          sp_fact=-1.
          sp_zer=.true.
Matthias Langer's avatar
 
Matthias Langer committed
572
573
574
575
576
577
578
579
580
581
          do kz=1,numzgrid
            do jy=0,numygrid-1
              do ix=0,numxgrid-1
                if (grid(ix,jy,kz).gt.smallnum) then
                  if (sp_zer.eqv..true.) then ! first non zero value
                    sp_count_i=sp_count_i+1
                    sparse_dump_i(sp_count_i)= &
                         ix+jy*numxgrid+kz*numxgrid*numygrid
                    sp_zer=.false.
                    sp_fact=sp_fact*(-1.)
582
583
584
585
586
587
588
589
590
591
592
593
                  endif
                  sp_count_r=sp_count_r+1
                  sparse_dump_r(sp_count_r)= &
                       sp_fact* &
                       1.e12*grid(ix,jy,kz) &
                       /volume(ix,jy,kz)/outnum* &
                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
!                sparse_dump_u(sp_count_r)=
!+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
!+              outnum*weightair/weightmolar(ks)/
!+              densityoutgrid(ix,jy,kz)
                else ! concentration is zero
Matthias Langer's avatar
 
Matthias Langer committed
594
                  sp_zer=.true.
595
                endif
Matthias Langer's avatar
 
Matthias Langer committed
596
597
598
              end do
            end do
          end do
599
600
601
602
603
604
          write(unitoutgridppt) sp_count_i
          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
          write(unitoutgridppt) sp_count_r
          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
!       write(unitoutgridppt) sp_count_u
!       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
Matthias Langer's avatar
 
Matthias Langer committed
605

606
        endif ! output for ppt
Matthias Langer's avatar
 
Matthias Langer committed
607

608
609
      end do
    end do
Matthias Langer's avatar
 
Matthias Langer committed
610
611
612
613
614
615
616
617
618
619
620
621

    close(unitoutgridppt)
    close(unitoutgrid)

  end do

  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
       wetgridtotal
  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
       drygridtotal

622
! Dump of receptor concentrations
Matthias Langer's avatar
 
Matthias Langer committed
623

624
625
626
627
628
629
630
  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
    write(unitoutreceptppt) itime
    do ks=1,nspec
      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
    end do
  endif
Matthias Langer's avatar
 
Matthias Langer committed
631

632
! Dump of receptor concentrations
Matthias Langer's avatar
 
Matthias Langer committed
633

634
635
636
637
638
639
640
  if (numreceptor.gt.0) then
    write(unitoutrecept) itime
    do ks=1,nspec
      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
           i=1,numreceptor)
    end do
  endif
Matthias Langer's avatar
 
Matthias Langer committed
641
642
643



644
645
! Reinitialization of grid
!*************************
Matthias Langer's avatar
 
Matthias Langer committed
646

647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
! do ks=1,nspec
!   do kp=1,maxpointspec_act
!     do i=1,numreceptor
!       creceptor(i,ks)=0.
!     end do
!     do jy=0,numygrid-1
!       do ix=0,numxgrid-1
!         do l=1,nclassunc
!           do nage=1,nageclass
!             do kz=1,numzgrid
!               gridunc(ix,jy,kz,ks,kp,l,nage)=0.
!             end do
!           end do
!         end do
!       end do
!     end do
!   end do
! end do
665
666
  creceptor(:,:)=0.
  gridunc(:,:,:,:,:,:,:)=0.
Matthias Langer's avatar
 
Matthias Langer committed
667
668
669


end subroutine concoutput