Changeset 16b61a5 in flexpart.git for src/concoutput_surf.f90


Ignore:
Timestamp:
Oct 14, 2016, 3:19:00 PM (8 years ago)
Author:
Espen Sollum ATMOS <eso@…>
Branches:
master, 10.4.1_pesei, GFS_025, bugfixes+enhancements, dev, release-10, release-10.4.1, scaling-bug, univie
Children:
4c64400
Parents:
861805a
Message:

Reworked the domain-filling option (MPI). Fixed a slow loop which had errors in loop counter (MPI)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • src/concoutput_surf.f90

    r6a678e3 r16b61a5  
    2121
    2222subroutine concoutput_surf(itime,outnum,gridtotalunc,wetgridtotalunc, &
    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   !*****************************************************************************
     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!*****************************************************************************
    5959
    6060  use unc_mod
    … …  
    7373  real :: outnum,densityoutrecept(maxreceptor),xl,yl
    7474
    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)
     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)
    9393  real(dep_prec) :: auxgrid(nclassunc)
    9494  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
    … …  
    104104
    105105  if (verbosity.eq.1) then
    106      print*,'inside concoutput_surf '
    107      CALL SYSTEM_CLOCK(count_clock)
    108      WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
     106    print*,'inside concoutput_surf '
     107    CALL SYSTEM_CLOCK(count_clock)
     108    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    109109  endif
    110110
    111   ! Determine current calendar date, needed for the file name
    112   !**********************************************************
     111! Determine current calendar date, needed for the file name
     112!**********************************************************
    113113
    114114  jul=bdate+real(itime,kind=dp)/86400._dp
    … …  
    116116  write(adate,'(i8.8)') jjjjmmdd
    117117  write(atime,'(i6.6)') ihmmss
    118   !write(unitdates,'(a)') adate//atime
    119 
    120     open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
    121       write(unitdates,'(a)') adate//atime
    122     close(unitdates)
    123 
    124   ! For forward simulations, output fields have dimension MAXSPEC,
    125   ! for backward simulations, output fields have dimension MAXPOINT.
    126   ! Thus, make loops either about nspec, or about numpoint
    127   !*****************************************************************
     118!write(unitdates,'(a)') adate//atime
     119
     120  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
     121  write(unitdates,'(a)') adate//atime
     122  close(unitdates)
     123
     124! For forward simulations, output fields have dimension MAXSPEC,
     125! for backward simulations, output fields have dimension MAXPOINT.
     126! Thus, make loops either about nspec, or about numpoint
     127!*****************************************************************
    128128
    129129
    … …  
    144144
    145145  if (verbosity.eq.1) then
    146      print*,'concoutput_surf 2'
    147      CALL SYSTEM_CLOCK(count_clock)
    148      WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
     146    print*,'concoutput_surf 2'
     147    CALL SYSTEM_CLOCK(count_clock)
     148    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    149149  endif
    150150
    151   !*******************************************************************
    152   ! Compute air density: sufficiently accurate to take it
    153   ! from coarse grid at some time
    154   ! Determine center altitude of output layer, and interpolate density
    155   ! data to that altitude
    156   !*******************************************************************
     151!*******************************************************************
     152! Compute air density: sufficiently accurate to take it
     153! from coarse grid at some time
     154! Determine center altitude of output layer, and interpolate density
     155! data to that altitude
     156!*******************************************************************
    157157
    158158  do kz=1,numzgrid
    … …  
    166166           (height(kzz).gt.halfheight)) goto 46
    167167    end do
    168 46   kzz=max(min(kzz,nz),2)
     16846  kzz=max(min(kzz,nz),2)
    169169    dz1=halfheight-height(kzz-1)
    170170    dz2=height(kzz)-halfheight
    … …  
    184184  end do
    185185
    186     do i=1,numreceptor
    187       xl=xreceptor(i)
    188       yl=yreceptor(i)
    189       iix=max(min(nint(xl),nxmin1),0)
    190       jjy=max(min(nint(yl),nymin1),0)
    191       densityoutrecept(i)=rho(iix,jjy,1,2)
    192     end do
    193 
    194 
    195   ! Output is different for forward and backward simulations
    196     do kz=1,numzgrid
    197       do jy=0,numygrid-1
    198         do ix=0,numxgrid-1
    199           if (ldirect.eq.1) then
    200             factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
    201           else
    202             factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
    203           endif
    204         end do
     186  do i=1,numreceptor
     187    xl=xreceptor(i)
     188    yl=yreceptor(i)
     189    iix=max(min(nint(xl),nxmin1),0)
     190    jjy=max(min(nint(yl),nymin1),0)
     191    densityoutrecept(i)=rho(iix,jjy,1,2)
     192  end do
     193
     194
     195! Output is different for forward and backward simulations
     196  do kz=1,numzgrid
     197    do jy=0,numygrid-1
     198      do ix=0,numxgrid-1
     199        if (ldirect.eq.1) then
     200          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
     201        else
     202          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
     203        endif
    205204      end do
    206205    end do
    207 
    208   !*********************************************************************
    209   ! Determine the standard deviation of the mean concentration or mixing
    210   ! ratio (uncertainty of the output) and the dry and wet deposition
    211   !*********************************************************************
     206  end do
     207
     208!*********************************************************************
     209! Determine the standard deviation of the mean concentration or mixing
     210! ratio (uncertainty of the output) and the dry and wet deposition
     211!*********************************************************************
    212212
    213213  if (verbosity.eq.1) then
    214      print*,'concoutput_surf 3 (sd)'
    215      CALL SYSTEM_CLOCK(count_clock)
    216      WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
     214    print*,'concoutput_surf 3 (sd)'
     215    CALL SYSTEM_CLOCK(count_clock)
     216    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    217217  endif
    218218  gridtotal=0.
    … …  
    228228  do ks=1,nspec
    229229
    230   write(anspec,'(i3.3)') ks
    231   if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
    232     if (ldirect.eq.1) then
    233       open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
     230    write(anspec,'(i3.3)') ks
     231    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
     232      if (ldirect.eq.1) then
     233        open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
     234             atime//'_'//anspec,form='unformatted')
     235      else
     236        open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
     237             atime//'_'//anspec,form='unformatted')
     238      endif
     239      write(unitoutgrid) itime
     240    endif
     241
     242    if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
     243      open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
    234244           atime//'_'//anspec,form='unformatted')
    235     else
    236       open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
    237            atime//'_'//anspec,form='unformatted')
     245
     246      write(unitoutgridppt) itime
    238247    endif
    239      write(unitoutgrid) itime
    240    endif
    241 
    242   if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
    243    open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
    244         atime//'_'//anspec,form='unformatted')
    245 
    246     write(unitoutgridppt) itime
    247   endif
    248 
    249   do kp=1,maxpointspec_act
    250   do nage=1,nageclass
    251 
    252     do jy=0,numygrid-1
    253       do ix=0,numxgrid-1
    254 
    255   ! WET DEPOSITION
    256         if ((WETDEP).and.(ldirect.gt.0)) then
    257             do l=1,nclassunc
    258               auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
    259             end do
    260             call mean(auxgrid,wetgrid(ix,jy), &
    261                  wetgridsigma(ix,jy),nclassunc)
    262   ! Multiply by number of classes to get total concentration
    263             wetgrid(ix,jy)=wetgrid(ix,jy) &
    264                  *nclassunc
    265             wetgridtotal=wetgridtotal+wetgrid(ix,jy)
    266   ! Calculate standard deviation of the mean
    267             wetgridsigma(ix,jy)= &
    268                  wetgridsigma(ix,jy)* &
    269                  sqrt(real(nclassunc))
    270             wetgridsigmatotal=wetgridsigmatotal+ &
    271                  wetgridsigma(ix,jy)
     248
     249    do kp=1,maxpointspec_act
     250      do nage=1,nageclass
     251
     252        do jy=0,numygrid-1
     253          do ix=0,numxgrid-1
     254
     255! WET DEPOSITION
     256            if ((WETDEP).and.(ldirect.gt.0)) then
     257              do l=1,nclassunc
     258                auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
     259              end do
     260              call mean(auxgrid,wetgrid(ix,jy), &
     261                   wetgridsigma(ix,jy),nclassunc)
     262! Multiply by number of classes to get total concentration
     263              wetgrid(ix,jy)=wetgrid(ix,jy) &
     264                   *nclassunc
     265              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
     266! Calculate standard deviation of the mean
     267              wetgridsigma(ix,jy)= &
     268                   wetgridsigma(ix,jy)* &
     269                   sqrt(real(nclassunc))
     270              wetgridsigmatotal=wetgridsigmatotal+ &
     271                   wetgridsigma(ix,jy)
     272            endif
     273
     274! DRY DEPOSITION
     275            if ((DRYDEP).and.(ldirect.gt.0)) then
     276              do l=1,nclassunc
     277                auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
     278              end do
     279              call mean(auxgrid,drygrid(ix,jy), &
     280                   drygridsigma(ix,jy),nclassunc)
     281! Multiply by number of classes to get total concentration
     282              drygrid(ix,jy)=drygrid(ix,jy)* &
     283                   nclassunc
     284              drygridtotal=drygridtotal+drygrid(ix,jy)
     285! Calculate standard deviation of the mean
     286              drygridsigma(ix,jy)= &
     287                   drygridsigma(ix,jy)* &
     288                   sqrt(real(nclassunc))
     289125           drygridsigmatotal=drygridsigmatotal+ &
     290                   drygridsigma(ix,jy)
     291            endif
     292
     293! CONCENTRATION OR MIXING RATIO
     294            do kz=1,numzgrid
     295              do l=1,nclassunc
     296                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
     297              end do
     298              call mean(auxgrid,grid(ix,jy,kz), &
     299                   gridsigma(ix,jy,kz),nclassunc)
     300! Multiply by number of classes to get total concentration
     301              grid(ix,jy,kz)= &
     302                   grid(ix,jy,kz)*nclassunc
     303              gridtotal=gridtotal+grid(ix,jy,kz)
     304! Calculate standard deviation of the mean
     305              gridsigma(ix,jy,kz)= &
     306                   gridsigma(ix,jy,kz)* &
     307                   sqrt(real(nclassunc))
     308              gridsigmatotal=gridsigmatotal+ &
     309                   gridsigma(ix,jy,kz)
     310            end do
     311          end do
     312        end do
     313
     314
     315!*******************************************************************
     316! Generate output: may be in concentration (ng/m3) or in mixing
     317! ratio (ppt) or both
     318! Output the position and the values alternated multiplied by
     319! 1 or -1, first line is number of values, number of positions
     320! For backward simulations, the unit is seconds, stored in grid_time
     321!*******************************************************************
     322
     323        if (verbosity.eq.1) then
     324          print*,'concoutput_surf 4 (output)'
     325          CALL SYSTEM_CLOCK(count_clock)
     326          WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    272327        endif
    273328
    274   ! DRY DEPOSITION
    275         if ((DRYDEP).and.(ldirect.gt.0)) then
    276             do l=1,nclassunc
    277               auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
    278             end do
    279             call mean(auxgrid,drygrid(ix,jy), &
    280                  drygridsigma(ix,jy),nclassunc)
    281   ! Multiply by number of classes to get total concentration
    282             drygrid(ix,jy)=drygrid(ix,jy)* &
    283                  nclassunc
    284             drygridtotal=drygridtotal+drygrid(ix,jy)
    285   ! Calculate standard deviation of the mean
    286             drygridsigma(ix,jy)= &
    287                  drygridsigma(ix,jy)* &
    288                  sqrt(real(nclassunc))
    289 125         drygridsigmatotal=drygridsigmatotal+ &
    290                  drygridsigma(ix,jy)
    291         endif
    292 
    293   ! CONCENTRATION OR MIXING RATIO
    294         do kz=1,numzgrid
    295             do l=1,nclassunc
    296               auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
    297             end do
    298             call mean(auxgrid,grid(ix,jy,kz), &
    299                  gridsigma(ix,jy,kz),nclassunc)
    300   ! Multiply by number of classes to get total concentration
    301             grid(ix,jy,kz)= &
    302                  grid(ix,jy,kz)*nclassunc
    303             gridtotal=gridtotal+grid(ix,jy,kz)
    304   ! Calculate standard deviation of the mean
    305             gridsigma(ix,jy,kz)= &
    306                  gridsigma(ix,jy,kz)* &
    307                  sqrt(real(nclassunc))
    308             gridsigmatotal=gridsigmatotal+ &
    309                  gridsigma(ix,jy,kz)
    310         end do
    311       end do
    312     end do
    313 
    314 
    315   !*******************************************************************
    316   ! Generate output: may be in concentration (ng/m3) or in mixing
    317   ! ratio (ppt) or both
    318   ! Output the position and the values alternated multiplied by
    319   ! 1 or -1, first line is number of values, number of positions
    320   ! For backward simulations, the unit is seconds, stored in grid_time
    321   !*******************************************************************
    322 
    323   if (verbosity.eq.1) then
    324      print*,'concoutput_surf 4 (output)'
    325      CALL SYSTEM_CLOCK(count_clock)
    326      WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    327   endif
    328 
    329   ! Concentration output
    330   !*********************
    331 
    332   if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
    333 
    334   if (verbosity.eq.1) then
    335      print*,'concoutput_surf (Wet deposition)'
    336      CALL SYSTEM_CLOCK(count_clock)
    337      WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    338   endif
    339 
    340   ! Wet deposition
    341          sp_count_i=0
    342          sp_count_r=0
    343          sp_fact=-1.
    344          sp_zer=.true.
    345          if ((ldirect.eq.1).and.(WETDEP)) then
    346          do jy=0,numygrid-1
    347             do ix=0,numxgrid-1
    348   ! concentraion greater zero
    349               if (wetgrid(ix,jy).gt.smallnum) then
    350                  if (sp_zer.eqv..true.) then ! first non zero value
     329! Concentration output
     330!*********************
     331
     332        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
     333
     334          if (verbosity.eq.1) then
     335            print*,'concoutput_surf (Wet deposition)'
     336            CALL SYSTEM_CLOCK(count_clock)
     337            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
     338          endif
     339
     340! Wet deposition
     341          sp_count_i=0
     342          sp_count_r=0
     343          sp_fact=-1.
     344          sp_zer=.true.
     345          if ((ldirect.eq.1).and.(WETDEP)) then
     346            do jy=0,numygrid-1
     347              do ix=0,numxgrid-1
     348! concentraion greater zero
     349                if (wetgrid(ix,jy).gt.smallnum) then
     350                  if (sp_zer.eqv..true.) then ! first non zero value
    351351                    sp_count_i=sp_count_i+1
    352352                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
    353353                    sp_zer=.false.
    354354                    sp_fact=sp_fact*(-1.)
    355                  endif
    356                  sp_count_r=sp_count_r+1
    357                  sparse_dump_r(sp_count_r)= &
    358                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
    359                  sparse_dump_u(sp_count_r)= &
    360                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
    361               else ! concentration is zero
     355                  endif
     356                  sp_count_r=sp_count_r+1
     357                  sparse_dump_r(sp_count_r)= &
     358                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
     359                  sparse_dump_u(sp_count_r)= &
     360                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
     361                else ! concentration is zero
    362362                  sp_zer=.true.
    363               endif
    364             end do
    365          end do
    366          else
     363                endif
     364              end do
     365            end do
     366          else
    367367            sp_count_i=0
    368368            sp_count_r=0
    369          endif
    370          write(unitoutgrid) sp_count_i
    371          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
    372          write(unitoutgrid) sp_count_r
    373          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
     369          endif
     370          write(unitoutgrid) sp_count_i
     371          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
     372          write(unitoutgrid) sp_count_r
     373          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
    374374!         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
    375375
    376   if (verbosity.eq.1) then
    377      print*,'concoutput_surf (Dry deposition)'
    378      CALL SYSTEM_CLOCK(count_clock)
    379      WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    380   endif
    381   ! Dry deposition
    382          sp_count_i=0
    383          sp_count_r=0
    384          sp_fact=-1.
    385          sp_zer=.true.
    386          if ((ldirect.eq.1).and.(DRYDEP)) then
    387           do jy=0,numygrid-1
    388             do ix=0,numxgrid-1
    389               if (drygrid(ix,jy).gt.smallnum) then
    390                  if (sp_zer.eqv..true.) then ! first non zero value
     376          if (verbosity.eq.1) then
     377            print*,'concoutput_surf (Dry deposition)'
     378            CALL SYSTEM_CLOCK(count_clock)
     379            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
     380          endif
     381! Dry deposition
     382          sp_count_i=0
     383          sp_count_r=0
     384          sp_fact=-1.
     385          sp_zer=.true.
     386          if ((ldirect.eq.1).and.(DRYDEP)) then
     387            do jy=0,numygrid-1
     388              do ix=0,numxgrid-1
     389                if (drygrid(ix,jy).gt.smallnum) then
     390                  if (sp_zer.eqv..true.) then ! first non zero value
    391391                    sp_count_i=sp_count_i+1
    392392                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
    393393                    sp_zer=.false.
    394394                    sp_fact=sp_fact*(-1.)
    395                  endif
    396                  sp_count_r=sp_count_r+1
    397                  sparse_dump_r(sp_count_r)= &
    398                       sp_fact* &
    399                       1.e12*drygrid(ix,jy)/area(ix,jy)
     395                  endif
     396                  sp_count_r=sp_count_r+1
     397                  sparse_dump_r(sp_count_r)= &
     398                       sp_fact* &
     399                       1.e12*drygrid(ix,jy)/area(ix,jy)
    400400                  sparse_dump_u(sp_count_r)= &
    401                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
    402               else ! concentration is zero
     401                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
     402                else ! concentration is zero
    403403                  sp_zer=.true.
    404               endif
    405             end do
    406           end do
    407          else
     404                endif
     405              end do
     406            end do
     407          else
    408408            sp_count_i=0
    409409            sp_count_r=0
    410          endif
    411          write(unitoutgrid) sp_count_i
    412          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
    413          write(unitoutgrid) sp_count_r
    414          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
     410          endif
     411          write(unitoutgrid) sp_count_i
     412          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
     413          write(unitoutgrid) sp_count_r
     414          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
    415415!         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
    416416
    417   if (verbosity.eq.1) then
    418      print*,'concoutput_surf (Concentrations)'
    419      CALL SYSTEM_CLOCK(count_clock)
    420      WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
    421   endif
    422 
    423   ! Concentrations
    424 
    425   ! surf_only write only 1st layer
    426 
    427          sp_count_i=0
    428          sp_count_r=0
    429          sp_fact=-1.
    430          sp_zer=.true.
     417          if (verbosity.eq.1) then
     418            print*,'concoutput_surf (Concentrations)'
     419            CALL SYSTEM_CLOCK(count_clock)
     420            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
     421          endif
     422
     423! Concentrations
     424
     425! surf_only write only 1st layer
     426
     427          sp_count_i=0
     428          sp_count_r=0
     429          sp_fact=-1.
     430          sp_zer=.true.
    431431          do kz=1,1
    432432            do jy=0,numygrid-1
    … …  
    440440                    sp_fact=sp_fact*(-1.)
    441441                  endif
    442                    sp_count_r=sp_count_r+1
    443                    sparse_dump_r(sp_count_r)= &
    444                         sp_fact* &
    445                         grid(ix,jy,kz)* &
    446                         factor3d(ix,jy,kz)/tot_mu(ks,kp)
    447   !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
    448   !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
    449                    sparse_dump_u(sp_count_r)= &
    450                         gridsigma(ix,jy,kz)* &
    451                         factor3d(ix,jy,kz)/tot_mu(ks,kp)
     442                  sp_count_r=sp_count_r+1
     443                  sparse_dump_r(sp_count_r)= &
     444                       sp_fact* &
     445                       grid(ix,jy,kz)* &
     446                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
     447!                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
     448!    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
     449                  sparse_dump_u(sp_count_r)= &
     450                       gridsigma(ix,jy,kz)* &
     451                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
    452452                else ! concentration is zero
    453453                  sp_zer=.true.
    454454                endif
    455              end do
    456            end do
    457          end do
    458          write(unitoutgrid) sp_count_i
    459          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
    460          write(unitoutgrid) sp_count_r
    461          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
     455              end do
     456            end do
     457          end do
     458          write(unitoutgrid) sp_count_i
     459          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
     460          write(unitoutgrid) sp_count_r
     461          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
    462462!         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
    463463
    464   endif !  concentration output
    465 
    466   ! Mixing ratio output
    467   !********************
    468 
    469   if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
    470 
    471   ! Wet deposition
    472          sp_count_i=0
    473          sp_count_r=0
    474          sp_fact=-1.
    475          sp_zer=.true.
    476          if ((ldirect.eq.1).and.(WETDEP)) then
    477           do jy=0,numygrid-1
    478             do ix=0,numxgrid-1
     464        endif !  concentration output
     465
     466! Mixing ratio output
     467!********************
     468
     469        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
     470
     471! Wet deposition
     472          sp_count_i=0
     473          sp_count_r=0
     474          sp_fact=-1.
     475          sp_zer=.true.
     476          if ((ldirect.eq.1).and.(WETDEP)) then
     477            do jy=0,numygrid-1
     478              do ix=0,numxgrid-1
    479479                if (wetgrid(ix,jy).gt.smallnum) then
    480480                  if (sp_zer.eqv..true.) then ! first non zero value
    … …  
    484484                    sp_zer=.false.
    485485                    sp_fact=sp_fact*(-1.)
    486                  endif
    487                  sp_count_r=sp_count_r+1
    488                  sparse_dump_r(sp_count_r)= &
    489                       sp_fact* &
    490                       1.e12*wetgrid(ix,jy)/area(ix,jy)
    491                  sparse_dump_u(sp_count_r)= &
    492                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
    493               else ! concentration is zero
     486                  endif
     487                  sp_count_r=sp_count_r+1
     488                  sparse_dump_r(sp_count_r)= &
     489                       sp_fact* &
     490                       1.e12*wetgrid(ix,jy)/area(ix,jy)
     491                  sparse_dump_u(sp_count_r)= &
     492                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
     493                else ! concentration is zero
    494494                  sp_zer=.true.
    495               endif
    496             end do
    497           end do
    498          else
    499            sp_count_i=0
    500            sp_count_r=0
    501          endif
    502          write(unitoutgridppt) sp_count_i
    503          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
    504          write(unitoutgridppt) sp_count_r
    505          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
     495                endif
     496              end do
     497            end do
     498          else
     499            sp_count_i=0
     500            sp_count_r=0
     501          endif
     502          write(unitoutgridppt) sp_count_i
     503          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
     504          write(unitoutgridppt) sp_count_r
     505          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
    506506!         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
    507507
    508508
    509   ! Dry deposition
    510          sp_count_i=0
    511          sp_count_r=0
    512          sp_fact=-1.
    513          sp_zer=.true.
    514          if ((ldirect.eq.1).and.(DRYDEP)) then
    515           do jy=0,numygrid-1
    516             do ix=0,numxgrid-1
     509! Dry deposition
     510          sp_count_i=0
     511          sp_count_r=0
     512          sp_fact=-1.
     513          sp_zer=.true.
     514          if ((ldirect.eq.1).and.(DRYDEP)) then
     515            do jy=0,numygrid-1
     516              do ix=0,numxgrid-1
    517517                if (drygrid(ix,jy).gt.smallnum) then
    518518                  if (sp_zer.eqv..true.) then ! first non zero value
    … …  
    522522                    sp_zer=.false.
    523523                    sp_fact=sp_fact*(-1)
    524                  endif
    525                  sp_count_r=sp_count_r+1
    526                  sparse_dump_r(sp_count_r)= &
    527                       sp_fact* &
    528                       1.e12*drygrid(ix,jy)/area(ix,jy)
    529                  sparse_dump_u(sp_count_r)= &
    530                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
    531               else ! concentration is zero
     524                  endif
     525                  sp_count_r=sp_count_r+1
     526                  sparse_dump_r(sp_count_r)= &
     527                       sp_fact* &
     528                       1.e12*drygrid(ix,jy)/area(ix,jy)
     529                  sparse_dump_u(sp_count_r)= &
     530                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
     531                else ! concentration is zero
    532532                  sp_zer=.true.
    533               endif
    534             end do
    535           end do
    536          else
    537            sp_count_i=0
    538            sp_count_r=0
    539          endif
    540          write(unitoutgridppt) sp_count_i
    541          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
    542          write(unitoutgridppt) sp_count_r
    543          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
     533                endif
     534              end do
     535            end do
     536          else
     537            sp_count_i=0
     538            sp_count_r=0
     539          endif
     540          write(unitoutgridppt) sp_count_i
     541          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
     542          write(unitoutgridppt) sp_count_r
     543          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
    544544!         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
    545545
    546546
    547   ! Mixing ratios
    548 
    549   ! surf_only write only 1st layer
    550 
    551          sp_count_i=0
    552          sp_count_r=0
    553          sp_fact=-1.
    554          sp_zer=.true.
     547! Mixing ratios
     548
     549! surf_only write only 1st layer
     550
     551          sp_count_i=0
     552          sp_count_r=0
     553          sp_fact=-1.
     554          sp_zer=.true.
    555555          do kz=1,1
    556556            do jy=0,numygrid-1
    … …  
    563563                    sp_zer=.false.
    564564                    sp_fact=sp_fact*(-1.)
    565                  endif
    566                  sp_count_r=sp_count_r+1
    567                  sparse_dump_r(sp_count_r)= &
    568                       sp_fact* &
    569                       1.e12*grid(ix,jy,kz) &
    570                       /volume(ix,jy,kz)/outnum* &
    571                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
    572                  sparse_dump_u(sp_count_r)= &
    573                       1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
    574                       outnum*weightair/weightmolar(ks)/ &
    575                       densityoutgrid(ix,jy,kz)
    576               else ! concentration is zero
     565                  endif
     566                  sp_count_r=sp_count_r+1
     567                  sparse_dump_r(sp_count_r)= &
     568                       sp_fact* &
     569                       1.e12*grid(ix,jy,kz) &
     570                       /volume(ix,jy,kz)/outnum* &
     571                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
     572                  sparse_dump_u(sp_count_r)= &
     573                       1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
     574                       outnum*weightair/weightmolar(ks)/ &
     575                       densityoutgrid(ix,jy,kz)
     576                else ! concentration is zero
    577577                  sp_zer=.true.
    578               endif
     578                endif
    579579              end do
    580580            end do
    581581          end do
    582          write(unitoutgridppt) sp_count_i
    583          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
    584          write(unitoutgridppt) sp_count_r
    585          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
     582          write(unitoutgridppt) sp_count_i
     583          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
     584          write(unitoutgridppt) sp_count_r
     585          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
    586586!         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
    587587
    588       endif ! output for ppt
    589 
    590   end do
    591   end do
     588        endif ! output for ppt
     589
     590      end do
     591    end do
    592592
    593593    close(unitoutgridppt)
    … …  
    602602       drygridtotal
    603603
    604   ! Dump of receptor concentrations
    605 
    606     if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
    607       write(unitoutreceptppt) itime
    608       do ks=1,nspec
    609         write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
    610              weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
     604! Dump of receptor concentrations
     605
     606  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
     607    write(unitoutreceptppt) itime
     608    do ks=1,nspec
     609      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
     610           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
     611    end do
     612  endif
     613
     614! Dump of receptor concentrations
     615
     616  if (numreceptor.gt.0) then
     617    write(unitoutrecept) itime
     618    do ks=1,nspec
     619      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
     620           i=1,numreceptor)
     621    end do
     622  endif
     623
     624
     625
     626! Reinitialization of grid
     627!*************************
     628
     629  do ks=1,nspec
     630    do kp=1,maxpointspec_act
     631      do i=1,numreceptor
     632        creceptor(i,ks)=0.
    611633      end do
    612     endif
    613 
    614   ! Dump of receptor concentrations
    615 
    616     if (numreceptor.gt.0) then
    617       write(unitoutrecept) itime
    618       do ks=1,nspec
    619         write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
    620              i=1,numreceptor)
    621       end do
    622     endif
    623 
    624 
    625 
    626   ! Reinitialization of grid
    627   !*************************
    628 
    629   do ks=1,nspec
    630   do kp=1,maxpointspec_act
    631     do i=1,numreceptor
    632       creceptor(i,ks)=0.
    633     end do
    634     do jy=0,numygrid-1
    635       do ix=0,numxgrid-1
    636         do l=1,nclassunc
    637           do nage=1,nageclass
    638             do kz=1,numzgrid
    639               gridunc(ix,jy,kz,ks,kp,l,nage)=0.
     634      do jy=0,numygrid-1
     635        do ix=0,numxgrid-1
     636          do l=1,nclassunc
     637            do nage=1,nageclass
     638              do kz=1,numzgrid
     639                gridunc(ix,jy,kz,ks,kp,l,nage)=0.
     640              end do
    640641            end do
    641642          end do
    … …  
    644645    end do
    645646  end do
    646   end do
    647647
    648648
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG