Ignore:
Timestamp:
Feb 16, 2015, 6:21:09 PM (9 years ago)
Author:
pesei
Message:

Implement switch for incremental deposition, see ticket:113 and many small changes, see changelog.txt

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/petra/src/com_mod.f90

    r30 r36  
     1!**********************************************************************
     2! Copyright 1998-2015                                                 *
     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
     22module com_mod
     23
    124!*******************************************************************************
    225!        Include file for particle diffusion model FLEXPART                    *
     
    730!        June 1996                                                             *
    831!                                                                              *
    9 !        Last update:15 August 2013 IP                                         *
     32!        Modifications: 15 August 2013 IP,
     33!        2/2015 PS, add incremental deposition switch
    1034!                                                                              *
    1135!*******************************************************************************
    12 
    13 module com_mod
    1436
    1537  use par_mod, only: dp, numpath, maxnests, maxageclass, maxspec, ni, &
     
    6991  integer :: mquasilag,nested_output,ind_source,ind_receptor
    7092  integer :: ind_rel,ind_samp,ioutputforeachrelease,linit_cond,surf_only
    71   logical :: turbswitch
     93  logical :: turbswitch, ldep_incr
    7294
    7395  ! ctl      factor, by which time step must be smaller than Lagrangian time scale
     
    98120  ! nested_output: 0 no, 1 yes
    99121  ! turbswitch              determines how the Markov chain is formulated
     122  ! ldep_incr: .true. incremental deposition, .false. accumulated deposition
    100123
    101124  ! ind_rel and ind_samp  are used within the code to change between mass and mass-mix (see readcommand.f)
     
    136159  character :: compoint(1001)*45
    137160  integer :: numpoint
    138   !sec, now dynamically allocated:
     161  !SE, now dynamically allocated:
    139162  ! ireleasestart(maxpoint),ireleaseend(maxpoint)
    140163  !      real xpoint1(maxpoint),ypoint1(maxpoint)
     
    155178  real :: rgs(maxspec,5,numclass),rlu(maxspec,5,numclass)
    156179  real :: rm(maxspec),dryvel(maxspec),kao(maxspec),ohreact(maxspec)
    157   ! se  it is possible to associate a species with a second one to make transfer from gas to aerosol
     180  ! SE  it is possible to associate a species with a second one to make transfer from gas to aerosol
    158181  integer :: spec_ass(maxspec)
    159182
     
    549572  real :: dxoutn,dyoutn,outlon0n,outlat0n,xoutshiftn,youtshiftn
    550573  !real outheight(maxzgrid),outheighthalf(maxzgrid)
    551   logical :: DEP,DRYDEP,DRYDEPSPEC(maxspec),WETDEP,OHREA,ASSSPEC
     574  logical :: dep,drydep,drydepspec(maxspec),wetdep,ohrea,assspec
    552575
    553576  ! numxgrid,numygrid       number of grid points in x,y-direction
     
    562585  ! outheight [m]           upper levels of the output grid
    563586  ! outheighthalf [m]       half (middle) levels of the output grid cells
    564   ! DEP                     .true., if either dry or wet depos. is switched on
    565   ! DRYDEP                  .true., if dry deposition is switched on
    566   ! DRYDEPSPEC              .true., if dry deposition is switched on for that species
    567   ! WETDEP                  .true., if wet deposition is switched on
    568   ! OHREA                   .true., if OH reaction is switched on
    569   ! ASSSPEC                 .true., if there are two species asscoiated
     587  ! dep                     .true., if either dry or wet depos. is switched on
     588  ! drydep                  .true., if dry deposition is switched on
     589  ! drydepspec              .true., if dry deposition is switched on for that species
     590  ! wetdep                  .true., if wet deposition is switched on
     591  ! ohrea                   .true., if oh reaction is switched on
     592  ! assspec                 .true., if there are two species asscoiated
    570593  !                    (i.e. transfer of mass between these two occurs
    571594
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG