Changeset 36


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

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

Location:
branches/petra
Files:
1 added
21 edited

Legend:

Unmodified
Added
Removed
  • branches/petra/options/COMMAND

    r24 r36  
    105105    0
    106106    SURF_ONLY        IF THIS IS SET TO 1, OUTPUT IS WRITTEN ONLY OUT FOR LOWEST LAYER
     107
     10825. _                4x, logical
     109    .false.         
     110    LDEP_INCR        IF .TRUE., INCREMENTAL DEPOSITION, ELSE ACCUMULATED DEPOSITION (=DEFAULT)
    107111
    108112
  • branches/petra/options/COMMAND.alternative

    r24 r36  
    31312               LINIT_COND        INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
    32320               SURF_ONLY         IF THIS IS SET TO 1, OUTPUT IS WRITTEN ONLY OUT FOR LOWEST LAYER
     33.f.             LDEP_INCR         IF .TRUE., INCREMENTAL DEPOSITION, ELSE ACCUMULATED DEPOSITION (=DEFAULT)
    3334
    3435
  • branches/petra/options/COMMAND.reference

    r24 r36  
    1111
    12122. ________ ______   3X, I8, 1X, I6
    13    20110310 000000
     13   20111210 000000
    1414   YYYYMMDD HHMISS   BEGINNING DATE OF SIMULATION
    1515
    16163. ________ ______   3X, I8, 1X, I6
    17    20110310 120000
     17   20111210 120000
    1818   YYYYMMDD HHMISS   ENDING DATE OF SIMULATION
    1919
     
    105105    0
    106106    SURF_ONLY        IF THIS IS SET TO 1, OUTPUT IS WRITTEN ONLY OUT FOR LOWEST LAYER
     107
     10825. _                4x, logical
     109    .false.         
     110    LDEP_INCR        IF .TRUE., INCREMENTAL DEPOSITION, ELSE ACCUMULATED DEPOSITION (=DEFAULT)
    107111
    108112
  • branches/petra/src/FLEXPART.f90

    r30 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    6666
    6767  ! FLEXPART version string
    68   flexversion='Version 9.2 beta (2014-07-01)'
     68  flexversion='Version 9.2_beta.r34 (2015-02-12)'
    6969  verbosity=0
    7070
     
    119119    write(*,*) 'call readpaths'
    120120  endif
    121   call readpaths(pathfile)
     121  call readpaths
    122122 
    123123  if (verbosity.gt.1) then !show clock info
  • branches/petra/src/advance.f90

    r29 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    6161  !  8 April 2000: Deep convection parameterization                            *
    6262  !                                                                            *
    63   !  May 2002: Petterssen scheme introduced                                    *
     63  !  May 2002: Petterssen scheme introduced 
     64  !  PS, 2/2015: fix mixture of real and dp in call to funtion mod
    6465  !                                                                            *
    6566  !*****************************************************************************
     
    707708
    708709  if ( yt.lt.0. ) then
    709     xt=mod(xt+180.,360.)
     710    xt=mod(xt+180._dp,360._dp)
    710711    yt=-yt
    711712  else if ( yt.gt.real(nymin1) ) then
    712     xt=mod(xt+180.,360.)
     713    xt=mod(xt+180._dp,360._dp)
    713714    yt=2*real(nymin1)-yt
    714715  endif
     
    877878
    878879  if ( yt.lt.0. ) then
    879     xt=mod(xt+180.,360.)
     880    xt=mod(xt+180._dp,360._dp)
    880881    yt=-yt
    881882  else if ( yt.gt.real(nymin1) ) then
    882     xt=mod(xt+180.,360.)
     883    xt=mod(xt+180._dp,360._dp)
    883884    yt=2*real(nymin1)-yt
    884885  endif
  • 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
  • branches/petra/src/concoutput.f90

    r20 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    4747  !                                                                            *
    4848  !     2008 new sparse matrix format                                          *
     49  !     PS, 2/2015: option to produce incremental deposition output
     50  !                 access= -> position=
    4951  !                                                                            *
    5052  !*****************************************************************************
     
    108110  write(adate,'(i8.8)') jjjjmmdd
    109111  write(atime,'(i6.6)') ihmmss
    110   open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
     112  open(unitdates,file=path(2)(1:length(2))//'dates', position='append')
    111113  write(unitdates,'(a)') adate//atime
    112114  close(unitdates) 
     
    588590  !*************************
    589591
    590   do ks=1,nspec
    591   do kp=1,maxpointspec_act
    592     do i=1,numreceptor
    593       creceptor(i,ks)=0.
    594     end do
    595     do jy=0,numygrid-1
    596       do ix=0,numxgrid-1
    597         do l=1,nclassunc
    598           do nage=1,nageclass
    599             do kz=1,numzgrid
    600               gridunc(ix,jy,kz,ks,kp,l,nage)=0.
    601             end do
    602           end do
    603         end do
    604       end do
    605     end do
    606   end do
    607   end do
    608 
    609 
     592  creceptor=0.
     593  gridunc=0.
     594  if (ldep_incr) then ! incremental deposition output
     595    wetgridunc=0.
     596    drygridunc=0.
     597  endif
     598 
    610599end subroutine concoutput
  • branches/petra/src/concoutput_nest.f90

    r4 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    4545  !                                                                            *
    4646  !     2008 new sparse matrix format                                          *
     47  !     PS, 2/2015: option to produce incremental deposition output
     48  !                 access= -> position=
    4749  !                                                                            *
    4850  !*****************************************************************************
     
    112114
    113115
    114     if (ldirect.eq.1) then
    115        do ks=1,nspec
    116          do kp=1,maxpointspec_act
    117            tot_mu(ks,kp)=1
    118          end do
    119        end do
    120    else
    121       do ks=1,nspec
    122              do kp=1,maxpointspec_act
    123                tot_mu(ks,kp)=xmass(kp,ks)
    124              end do
    125       end do
    126     endif
     116  if (ldirect.eq.1) then
     117    do ks=1,nspec
     118      do kp=1,maxpointspec_act
     119        tot_mu(ks,kp)=1
     120      end do
     121    end do
     122  else
     123    do ks=1,nspec
     124      do kp=1,maxpointspec_act
     125        tot_mu(ks,kp)=xmass(kp,ks)
     126      end do
     127    end do
     128  endif
    127129
    128130
     
    162164  end do
    163165
    164     do i=1,numreceptor
    165       xl=xreceptor(i)
    166       yl=yreceptor(i)
    167       iix=max(min(nint(xl),nxmin1),0)
    168       jjy=max(min(nint(yl),nymin1),0)
    169       densityoutrecept(i)=rho(iix,jjy,1,2)
    170     end do
    171 
    172 
    173   ! Output is different for forward and backward simulations
    174     do kz=1,numzgrid
    175       do jy=0,numygridn-1
    176         do ix=0,numxgridn-1
    177           if (ldirect.eq.1) then
    178             factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
    179           else
    180             factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
    181           endif
    182         end do
    183       end do
    184     end do
     166  do i=1,numreceptor
     167    xl=xreceptor(i)
     168    yl=yreceptor(i)
     169    iix=max(min(nint(xl),nxmin1),0)
     170    jjy=max(min(nint(yl),nymin1),0)
     171    densityoutrecept(i)=rho(iix,jjy,1,2)
     172  end do
     173
     174
     175! Output is different for forward and backward simulations
     176  do kz=1,numzgrid
     177    do jy=0,numygridn-1
     178      do ix=0,numxgridn-1
     179        if (ldirect.eq.1) then
     180          factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
     181        else
     182          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
     183        endif
     184      end do
     185    end do
     186  end do
    185187
    186188  !*********************************************************************
     
    191193  do ks=1,nspec
    192194
    193   write(anspec,'(i3.3)') ks
    194   if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
    195     if (ldirect.eq.1) then
    196       open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
    197            //adate// &
    198            atime//'_'//anspec,form='unformatted')
    199     else
    200       open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
    201            //adate// &
    202            atime//'_'//anspec,form='unformatted')
     195    write(anspec,'(i3.3)') ks
     196    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
     197      if (ldirect.eq.1) then
     198        open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
     199             //adate// atime//'_'//anspec,form='unformatted')
     200      else
     201        open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
     202             //adate// atime//'_'//anspec,form='unformatted')
     203      endif
     204       write(unitoutgrid) itime
     205     endif
     206
     207    if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
     208     open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
     209          //adate// atime//'_'//anspec,form='unformatted')
     210
     211      write(unitoutgridppt) itime
    203212    endif
    204      write(unitoutgrid) itime
    205    endif
    206 
    207   if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
    208    open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
    209         //adate// &
    210         atime//'_'//anspec,form='unformatted')
    211 
    212     write(unitoutgridppt) itime
    213   endif
    214 
    215   do kp=1,maxpointspec_act
    216   do nage=1,nageclass
    217 
    218     do jy=0,numygridn-1
    219       do ix=0,numxgridn-1
    220 
    221   ! WET DEPOSITION
    222         if ((WETDEP).and.(ldirect.gt.0)) then
     213
     214    do kp=1,maxpointspec_act
     215    do nage=1,nageclass
     216
     217      do jy=0,numygridn-1
     218        do ix=0,numxgridn-1
     219
     220    ! WET DEPOSITION
     221          if ((WETDEP).and.(ldirect.gt.0)) then
    223222            do l=1,nclassunc
    224223              auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
    225224            end do
    226             call mean(auxgrid,wetgrid(ix,jy), &
    227                  wetgridsigma(ix,jy),nclassunc)
    228   ! Multiply by number of classes to get total concentration
    229             wetgrid(ix,jy)=wetgrid(ix,jy) &
    230                  *nclassunc
    231   ! Calculate standard deviation of the mean
    232             wetgridsigma(ix,jy)= &
    233                  wetgridsigma(ix,jy)* &
    234                  sqrt(real(nclassunc))
    235         endif
    236 
    237   ! DRY DEPOSITION
    238         if ((DRYDEP).and.(ldirect.gt.0)) then
     225            call mean(auxgrid,wetgrid(ix,jy), wetgridsigma(ix,jy),nclassunc)
     226    ! Multiply by number of classes to get total concentration
     227            wetgrid(ix,jy)=wetgrid(ix,jy)*nclassunc
     228    ! Calculate standard deviation of the mean
     229            wetgridsigma(ix,jy)= wetgridsigma(ix,jy)* sqrt(real(nclassunc))
     230          endif
     231
     232    ! DRY DEPOSITION
     233          if ((DRYDEP).and.(ldirect.gt.0)) then
    239234            do l=1,nclassunc
    240235              auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
    241236            end do
    242             call mean(auxgrid,drygrid(ix,jy), &
    243                  drygridsigma(ix,jy),nclassunc)
    244   ! Multiply by number of classes to get total concentration
    245             drygrid(ix,jy)=drygrid(ix,jy)* &
    246                  nclassunc
    247   ! Calculate standard deviation of the mean
    248             drygridsigma(ix,jy)= &
    249                  drygridsigma(ix,jy)* &
    250                  sqrt(real(nclassunc))
    251         endif
    252 
    253   ! CONCENTRATION OR MIXING RATIO
    254         do kz=1,numzgrid
     237            call mean(auxgrid,drygrid(ix,jy), drygridsigma(ix,jy),nclassunc)
     238    ! Multiply by number of classes to get total concentration
     239            drygrid(ix,jy)=drygrid(ix,jy)* nclassunc
     240    ! Calculate standard deviation of the mean
     241            drygridsigma(ix,jy)= drygridsigma(ix,jy)* sqrt(real(nclassunc))
     242          endif
     243
     244    ! CONCENTRATION OR MIXING RATIO
     245          do kz=1,numzgrid
    255246            do l=1,nclassunc
    256247              auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
    257248            end do
    258             call mean(auxgrid,grid(ix,jy,kz), &
    259                  gridsigma(ix,jy,kz),nclassunc)
    260   ! Multiply by number of classes to get total concentration
    261             grid(ix,jy,kz)= &
    262                  grid(ix,jy,kz)*nclassunc
    263   ! Calculate standard deviation of the mean
    264             gridsigma(ix,jy,kz)= &
    265                  gridsigma(ix,jy,kz)* &
    266                  sqrt(real(nclassunc))
     249            call mean(auxgrid,grid(ix,jy,kz), gridsigma(ix,jy,kz),nclassunc)
     250    ! Multiply by number of classes to get total concentration
     251            grid(ix,jy,kz)= grid(ix,jy,kz)*nclassunc
     252    ! Calculate standard deviation of the mean
     253            gridsigma(ix,jy,kz)= gridsigma(ix,jy,kz)* sqrt(real(nclassunc))
     254          end do
    267255        end do
    268256      end do
    269     end do
    270 
    271 
    272   !*******************************************************************
    273   ! Generate output: may be in concentration (ng/m3) or in mixing
    274   ! ratio (ppt) or both
    275   ! Output the position and the values alternated multiplied by
    276   ! 1 or -1, first line is number of values, number of positions
    277   ! For backward simulations, the unit is seconds, stored in grid_time
    278   !*******************************************************************
    279 
    280   ! Concentration output
    281   !*********************
    282   if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
    283 
    284   ! Wet deposition
    285          sp_count_i=0
    286          sp_count_r=0
    287          sp_fact=-1.
    288          sp_zer=.true.
    289          if ((ldirect.eq.1).and.(WETDEP)) then
    290          do jy=0,numygridn-1
    291             do ix=0,numxgridn-1
    292   !oncentraion greater zero
    293               if (wetgrid(ix,jy).gt.smallnum) then
    294                  if (sp_zer.eqv..true.) then ! first non zero value
    295                     sp_count_i=sp_count_i+1
    296                     sparse_dump_i(sp_count_i)=ix+jy*numxgridn
    297                     sp_zer=.false.
    298                     sp_fact=sp_fact*(-1.)
    299                  endif
    300                  sp_count_r=sp_count_r+1
    301                  sparse_dump_r(sp_count_r)= &
    302                       sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
     257
     258
     259    !*******************************************************************
     260    ! Generate output: may be in concentration (ng/m3) or in mixing
     261    ! ratio (ppt) or both
     262    ! Output the position and the values alternated multiplied by
     263    ! 1 or -1, first line is number of values, number of positions
     264    ! For backward simulations, the unit is seconds, stored in grid_time
     265    !*******************************************************************
     266
     267    ! Concentration output
     268    !*********************
     269    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
     270
     271    ! Wet deposition
     272      sp_count_i=0
     273      sp_count_r=0
     274      sp_fact=-1.
     275      sp_zer=.true.
     276      if ((ldirect.eq.1).and.(WETDEP)) then
     277      do jy=0,numygridn-1
     278        do ix=0,numxgridn-1
     279    ! concentration greater zero
     280          if (wetgrid(ix,jy).gt.smallnum) then
     281            if (sp_zer.eqv..true.) then ! first non zero value
     282              sp_count_i=sp_count_i+1
     283              sparse_dump_i(sp_count_i)=ix+jy*numxgridn
     284              sp_zer=.false.
     285              sp_fact=sp_fact*(-1.)
     286            endif
     287            sp_count_r=sp_count_r+1
     288            sparse_dump_r(sp_count_r)= sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
    303289  !                sparse_dump_u(sp_count_r)=
    304290  !+                1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
     291          else ! concentration is zero
     292            sp_zer=.true.
     293          endif
     294       end do
     295      end do
     296      else
     297        sp_count_i=0
     298        sp_count_r=0
     299      endif
     300      write(unitoutgrid) sp_count_i
     301      write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
     302      write(unitoutgrid) sp_count_r
     303      write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
     304    !       write(unitoutgrid) sp_count_u
     305    !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
     306
     307    ! Dry deposition
     308      sp_count_i=0
     309      sp_count_r=0
     310      sp_fact=-1.
     311      sp_zer=.true.
     312      if ((ldirect.eq.1).and.(DRYDEP)) then
     313       do jy=0,numygridn-1
     314         do ix=0,numxgridn-1
     315           if (drygrid(ix,jy).gt.smallnum) then
     316             if (sp_zer.eqv..true.) then ! first non zero value
     317                sp_count_i=sp_count_i+1
     318                sparse_dump_i(sp_count_i)=ix+jy*numxgridn
     319                sp_zer=.false.
     320                sp_fact=sp_fact*(-1.)
     321             endif
     322             sp_count_r=sp_count_r+1
     323             sparse_dump_r(sp_count_r)= sp_fact* &
     324                  1.e12*drygrid(ix,jy)/arean(ix,jy)
     325  !                sparse_dump_u(sp_count_r)=
     326  !+                1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
     327           else ! concentration is zero
     328             sp_zer=.true.
     329           endif
     330         end do
     331       end do
     332      else
     333        sp_count_i=0
     334        sp_count_r=0
     335      endif
     336      write(unitoutgrid) sp_count_i
     337      write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
     338      write(unitoutgrid) sp_count_r
     339      write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
     340    !       write(*,*) sp_count_u
     341    !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
     342
     343
     344
     345    ! Concentrations
     346      sp_count_i=0
     347      sp_count_r=0
     348      sp_fact=-1.
     349      sp_zer=.true.
     350      do kz=1,numzgrid
     351        do jy=0,numygridn-1
     352          do ix=0,numxgridn-1
     353            if (grid(ix,jy,kz).gt.smallnum) then
     354              if (sp_zer.eqv..true.) then ! first non zero value
     355                sp_count_i=sp_count_i+1
     356                sparse_dump_i(sp_count_i)= &
     357                      ix+jy*numxgridn+kz*numxgridn*numygridn
     358                sp_zer=.false.
     359                sp_fact=sp_fact*(-1.)
     360              endif
     361              sp_count_r=sp_count_r+1
     362              sparse_dump_r(sp_count_r)= sp_fact* grid(ix,jy,kz)* &
     363                     factor3d(ix,jy,kz)/tot_mu(ks,kp)
     364  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
     365  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
     366  !                sparse_dump_u(sp_count_r)=
     367  !+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
     368  !+               factor(ix,jy,kz)/tot_mu(ks,kp)
     369            else ! concentration is zero
     370              sp_zer=.true.
     371            endif
     372          end do
     373        end do
     374      end do
     375      write(unitoutgrid) sp_count_i
     376      write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
     377      write(unitoutgrid) sp_count_r
     378      write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
     379    !       write(unitoutgrid) sp_count_u
     380    !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
     381
     382
     383
     384      endif !  concentration output
     385
     386    ! Mixing ratio output
     387    !********************
     388
     389      if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
     390
     391      ! Wet deposition
     392        sp_count_i=0
     393        sp_count_r=0
     394        sp_fact=-1.
     395        sp_zer=.true.
     396        if ((ldirect.eq.1).and.(WETDEP)) then
     397          do jy=0,numygridn-1
     398            do ix=0,numxgridn-1
     399              if (wetgrid(ix,jy).gt.smallnum) then
     400                if (sp_zer.eqv..true.) then ! first non zero value
     401                  sp_count_i=sp_count_i+1
     402                  sparse_dump_i(sp_count_i)= ix+jy*numxgridn
     403                  sp_zer=.false.
     404                  sp_fact=sp_fact*(-1.)
     405                endif
     406                sp_count_r=sp_count_r+1
     407                sparse_dump_r(sp_count_r)= sp_fact* &
     408                   1.e12*wetgrid(ix,jy)/arean(ix,jy)
     409    !                sparse_dump_u(sp_count_r)=
     410    !    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
    305411              else ! concentration is zero
    306                   sp_zer=.true.
     412                sp_zer=.true.
    307413              endif
    308414            end do
    309          end do
    310          else
    311             sp_count_i=0
    312             sp_count_r=0
    313          endif
    314          write(unitoutgrid) sp_count_i
    315          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
    316          write(unitoutgrid) sp_count_r
    317          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
    318   !       write(unitoutgrid) sp_count_u
    319   !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
    320 
    321   ! Dry deposition
    322          sp_count_i=0
    323          sp_count_r=0
    324          sp_fact=-1.
    325          sp_zer=.true.
    326          if ((ldirect.eq.1).and.(DRYDEP)) then
     415          end do
     416        else
     417          sp_count_i=0
     418          sp_count_r=0
     419        endif
     420        write(unitoutgridppt) sp_count_i
     421        write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
     422        write(unitoutgridppt) sp_count_r
     423        write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
     424    !       write(unitoutgridppt) sp_count_u
     425    !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
     426
     427
     428      ! Dry deposition
     429        sp_count_i=0
     430        sp_count_r=0
     431        sp_fact=-1.
     432        sp_zer=.true.
     433        if ((ldirect.eq.1).and.(DRYDEP)) then
    327434          do jy=0,numygridn-1
    328435            do ix=0,numxgridn-1
    329436              if (drygrid(ix,jy).gt.smallnum) then
    330                  if (sp_zer.eqv..true.) then ! first non zero value
    331                     sp_count_i=sp_count_i+1
    332                     sparse_dump_i(sp_count_i)=ix+jy*numxgridn
    333                     sp_zer=.false.
    334                     sp_fact=sp_fact*(-1.)
    335                  endif
    336                  sp_count_r=sp_count_r+1
    337                  sparse_dump_r(sp_count_r)= &
    338                       sp_fact* &
    339                       1.e12*drygrid(ix,jy)/arean(ix,jy)
    340   !                sparse_dump_u(sp_count_r)=
    341   !+                1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
     437                if (sp_zer.eqv..true.) then ! first non zero value
     438                  sp_count_i=sp_count_i+1
     439                  sparse_dump_i(sp_count_i)= ix+jy*numxgridn
     440                  sp_zer=.false.
     441                  sp_fact=sp_fact*(-1)
     442                endif
     443                sp_count_r=sp_count_r+1
     444                sparse_dump_r(sp_count_r)= sp_fact* &
     445                     1.e12*drygrid(ix,jy)/arean(ix,jy)
     446    !                sparse_dump_u(sp_count_r)=
     447    !    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
    342448              else ! concentration is zero
    343                   sp_zer=.true.
     449                sp_zer=.true.
    344450              endif
    345451            end do
    346452          end do
    347          else
    348             sp_count_i=0
    349             sp_count_r=0
    350          endif
    351          write(unitoutgrid) sp_count_i
    352          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
    353          write(unitoutgrid) sp_count_r
    354          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
    355   !       write(*,*) sp_count_u
    356   !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
    357 
    358 
    359 
    360   ! Concentrations
    361          sp_count_i=0
    362          sp_count_r=0
    363          sp_fact=-1.
    364          sp_zer=.true.
    365           do kz=1,numzgrid
    366             do jy=0,numygridn-1
     453        else
     454          sp_count_i=0
     455          sp_count_r=0
     456        endif
     457        write(unitoutgridppt) sp_count_i
     458        write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
     459        write(unitoutgridppt) sp_count_r
     460        write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
     461    !       write(unitoutgridppt) sp_count_u
     462    !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
     463
     464
     465      ! Mixing ratios
     466        sp_count_i=0
     467        sp_count_r=0
     468        sp_fact=-1.
     469        sp_zer=.true.
     470        do kz=1,numzgrid
     471           do jy=0,numygridn-1
    367472              do ix=0,numxgridn-1
    368473                if (grid(ix,jy,kz).gt.smallnum) then
     
    370475                    sp_count_i=sp_count_i+1
    371476                    sparse_dump_i(sp_count_i)= &
    372                          ix+jy*numxgridn+kz*numxgridn*numygridn
    373                     sp_zer=.false.
    374                     sp_fact=sp_fact*(-1.)
    375                    endif
    376                    sp_count_r=sp_count_r+1
    377                    sparse_dump_r(sp_count_r)= &
    378                         sp_fact* &
    379                         grid(ix,jy,kz)* &
    380                         factor3d(ix,jy,kz)/tot_mu(ks,kp)
    381   !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
    382   !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
    383   !                sparse_dump_u(sp_count_r)=
    384   !+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
    385   !+               factor(ix,jy,kz)/tot_mu(ks,kp)
    386               else ! concentration is zero
    387                   sp_zer=.true.
    388               endif
    389               end do
    390             end do
    391           end do
    392          write(unitoutgrid) sp_count_i
    393          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
    394          write(unitoutgrid) sp_count_r
    395          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
    396   !       write(unitoutgrid) sp_count_u
    397   !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
    398 
    399 
    400 
    401     endif !  concentration output
    402 
    403   ! Mixing ratio output
    404   !********************
    405 
    406   if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
    407 
    408   ! Wet deposition
    409          sp_count_i=0
    410          sp_count_r=0
    411          sp_fact=-1.
    412          sp_zer=.true.
    413          if ((ldirect.eq.1).and.(WETDEP)) then
    414           do jy=0,numygridn-1
    415             do ix=0,numxgridn-1
    416                 if (wetgrid(ix,jy).gt.smallnum) then
    417                   if (sp_zer.eqv..true.) then ! first non zero value
    418                     sp_count_i=sp_count_i+1
    419                     sparse_dump_i(sp_count_i)= &
    420                          ix+jy*numxgridn
     477                        ix+jy*numxgridn+kz*numxgridn*numygridn
    421478                    sp_zer=.false.
    422479                    sp_fact=sp_fact*(-1.)
    423480                 endif
    424481                 sp_count_r=sp_count_r+1
    425                  sparse_dump_r(sp_count_r)= &
    426                       sp_fact* &
    427                       1.e12*wetgrid(ix,jy)/arean(ix,jy)
    428   !                sparse_dump_u(sp_count_r)=
    429   !    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
    430               else ! concentration is zero
    431                   sp_zer=.true.
     482                 sparse_dump_r(sp_count_r)= sp_fact* 1.e12*grid(ix,jy,kz) &
     483                     /volumen(ix,jy,kz)/outnum* &
     484                     weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
     485    !                sparse_dump_u(sp_count_r)=
     486    !+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
     487    !+              outnum*weightair/weightmolar(ks)/
     488    !+              densityoutgrid(ix,jy,kz)
     489                else ! concentration is zero
     490                sp_zer=.true.
    432491              endif
    433492            end do
    434493          end do
    435          else
    436            sp_count_i=0
    437            sp_count_r=0
    438          endif
    439          write(unitoutgridppt) sp_count_i
    440          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
    441          write(unitoutgridppt) sp_count_r
    442          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
    443   !       write(unitoutgridppt) sp_count_u
    444   !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
    445 
    446 
    447   ! Dry deposition
    448          sp_count_i=0
    449          sp_count_r=0
    450          sp_fact=-1.
    451          sp_zer=.true.
    452          if ((ldirect.eq.1).and.(DRYDEP)) then
    453           do jy=0,numygridn-1
    454             do ix=0,numxgridn-1
    455                 if (drygrid(ix,jy).gt.smallnum) then
    456                   if (sp_zer.eqv..true.) then ! first non zero value
    457                     sp_count_i=sp_count_i+1
    458                     sparse_dump_i(sp_count_i)= &
    459                          ix+jy*numxgridn
    460                     sp_zer=.false.
    461                     sp_fact=sp_fact*(-1)
    462                  endif
    463                  sp_count_r=sp_count_r+1
    464                  sparse_dump_r(sp_count_r)= &
    465                       sp_fact* &
    466                       1.e12*drygrid(ix,jy)/arean(ix,jy)
    467   !                sparse_dump_u(sp_count_r)=
    468   !    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
    469               else ! concentration is zero
    470                   sp_zer=.true.
    471               endif
    472             end do
    473           end do
    474          else
    475            sp_count_i=0
    476            sp_count_r=0
    477          endif
    478          write(unitoutgridppt) sp_count_i
    479          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
    480          write(unitoutgridppt) sp_count_r
    481          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
    482   !       write(unitoutgridppt) sp_count_u
    483   !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
    484 
    485 
    486   ! Mixing ratios
    487          sp_count_i=0
    488          sp_count_r=0
    489          sp_fact=-1.
    490          sp_zer=.true.
    491           do kz=1,numzgrid
    492             do jy=0,numygridn-1
    493               do ix=0,numxgridn-1
    494                 if (grid(ix,jy,kz).gt.smallnum) then
    495                   if (sp_zer.eqv..true.) then ! first non zero value
    496                     sp_count_i=sp_count_i+1
    497                     sparse_dump_i(sp_count_i)= &
    498                          ix+jy*numxgridn+kz*numxgridn*numygridn
    499                     sp_zer=.false.
    500                     sp_fact=sp_fact*(-1.)
    501                  endif
    502                  sp_count_r=sp_count_r+1
    503                  sparse_dump_r(sp_count_r)= &
    504                       sp_fact* &
    505                       1.e12*grid(ix,jy,kz) &
    506                       /volumen(ix,jy,kz)/outnum* &
    507                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
    508   !                sparse_dump_u(sp_count_r)=
    509   !+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
    510   !+              outnum*weightair/weightmolar(ks)/
    511   !+              densityoutgrid(ix,jy,kz)
    512               else ! concentration is zero
    513                   sp_zer=.true.
    514               endif
    515               end do
    516             end do
    517           end do
    518          write(unitoutgridppt) sp_count_i
    519          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
    520          write(unitoutgridppt) sp_count_r
    521          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
    522   !       write(unitoutgridppt) sp_count_u
    523   !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
     494        end do
     495        write(unitoutgridppt) sp_count_i
     496        write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
     497        write(unitoutgridppt) sp_count_r
     498        write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
     499    !       write(unitoutgridppt) sp_count_u
     500    !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
    524501
    525502      endif ! output for ppt
    526503
    527   end do
    528   end do
     504    end do
     505    end do
    529506
    530507    close(unitoutgridppt)
     
    538515  !*************************
    539516
    540   do ks=1,nspec
    541   do kp=1,maxpointspec_act
    542     do i=1,numreceptor
    543       creceptor(i,ks)=0.
    544     end do
    545     do jy=0,numygridn-1
    546       do ix=0,numxgridn-1
    547         do l=1,nclassunc
    548           do nage=1,nageclass
    549             do kz=1,numzgrid
    550               griduncn(ix,jy,kz,ks,kp,l,nage)=0.
    551             end do
    552           end do
    553         end do
    554       end do
    555     end do
    556   end do
    557   end do
    558 
     517  griduncn=0.
     518  if (ldep_incr) then ! incremental deposition output
     519    wetgriduncn=0.
     520    drygriduncn=0.
     521  endif
    559522
    560523end subroutine concoutput_nest
    561 
  • branches/petra/src/concoutput_surf.f90

    r20 r36  
    116116  !write(unitdates,'(a)') adate//atime
    117117
    118     open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
     118    open(unitdates,file=path(2)(1:length(2))//'dates', position='append')
    119119      write(unitdates,'(a)') adate//atime
    120120    close(unitdates)
  • branches/petra/src/par_mod.f90

    r27 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    2828!        1997                                                                  *
    2929!                                                                              *
    30 !        Last update 15 August 2013 IP                                         *
     30!        15 August 2013, IP                                                    *
     31!        2/2015, PS: nshift=0, unitheader_txt -> unitheader_rel
     32!                                                                              *
    3133!                                                                              *
    3234!*******************************************************************************
     
    128130  !integer,parameter :: nxmax=1201,nymax=235,nuvzmax=58,nwzmax=58,nzmax=58
    129131
    130   integer,parameter :: nxshift=359 ! for ECMWF
     132  integer,parameter :: nxshift= 0 !359 ! for ECMWF
    131133  !integer,parameter :: nxshift=0     ! for GFS or FNL (XF)
    132134
     
    259261  integer,parameter :: unitlsm=1, unitsurfdata=1, unitland=1, unitwesely=1
    260262  integer,parameter :: unitOH=1
    261   integer,parameter :: unitdates=94, unitheader=90,unitheader_txt=100, unitshortpart=95
     263  integer,parameter :: unitdates=94, unitheader=90,unitheader_rel=100, unitshortpart=95
    262264  integer,parameter :: unitboundcond=89
    263265
  • branches/petra/src/readcommand.f90

    r30 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    2929  !                                                                            *
    3030  !     18 May 1996                                                            *
    31   !     HSO, 1 July 2014                                                       *
    32   !     Added optional namelist input                                          *
     31  !
     32  !     HSO, 1 July 2014: Added optional namelist input
     33  !     PS 2/2015: add ldep_incr as optional command input
     34  !                make new parameters (last 3) optional for bwd compatibility
    3335  !                                                                            *
    3436  !*****************************************************************************
     
    6971  ! mdomainfill          1 use domain-filling option, 0 not, 2 use strat. O3   *
    7072  !                                                                            *
     73  ! ldep_incr            .true.  for incremental,
     74  !                      .false. for accumulated deposition output (DEFAULT)
    7175  ! Constants:                                                                 *
    7276  ! unitcommand          unit connected to file COMMAND                        *
     
    7983  implicit none
    8084
    81   real(kind=dp) :: juldate
    82   character(len=50) :: line
     85  real (kind=dp) :: juldate
     86  character (len=50) :: line
    8387  logical :: old
    84   integer :: readerror
     88  integer :: ireaderror, icmdstat
    8589
    8690  namelist /command/ &
     
    110114  linit_cond, &
    111115  lnetcdfout, &
    112   surf_only   
    113 
    114   ! Presetting namelist command
    115   ldirect=0
    116   ibdate=20000101
    117   ibtime=0
    118   iedate=20000102
    119   ietime=0
    120   loutstep=10800
    121   loutaver=10800
    122   loutsample=900
    123   itsplit=999999999
    124   lsynctime=900
    125   ctl=-5.0
    126   ifine=4
    127   iout=3
    128   ipout=0
    129   lsubgrid=1
    130   lconvection=1
    131   lagespectra=0
    132   ipin=1
    133   ioutputforeachrelease=1
    134   iflux=1
    135   mdomainfill=0
    136   ind_source=1
    137   ind_receptor=1
    138   mquasilag=0
    139   nested_output=0
    140   linit_cond=0
    141   lnetcdfout=0
    142   surf_only=0
     116  surf_only, &
     117  ldep_incr
     118
     119  ! Set default values for namelist command
     120  ldirect = 0
     121  ibdate = 20000101
     122  ibtime = 0
     123  iedate = 20000102
     124  ietime = 0
     125  loutstep = 10800
     126  loutaver = 10800
     127  loutsample = 900
     128  itsplit = 999999999
     129  lsynctime = 900
     130  ctl = -5.0
     131  ifine = 4
     132  iout = 3
     133  ipout = 0
     134  lsubgrid = 1
     135  lconvection = 1
     136  lagespectra = 0
     137  ipin = 1
     138  ioutputforeachrelease = 1
     139  iflux = 1
     140  mdomainfill = 0
     141  ind_source = 1
     142  ind_receptor = 1
     143  mquasilag = 0
     144  nested_output = 0
     145  linit_cond = 0
     146  lnetcdfout = 0
     147  surf_only = 0
     148  ldep_incr = .false.
    143149
    144150  ! Open the command file and read user options
     
    148154
    149155  ! try namelist input (default)
    150   read(unitcommand,command,iostat=readerror)
     156  read(unitcommand,command,iostat=ireaderror)
    151157  close(unitcommand)
    152158
    153159  ! distinguish namelist from fixed text input
    154   if ((readerror.ne.0).or.(ldirect.eq.0)) then ! parse as text file format
     160  if ((ireaderror .ne. 0) .or. (ldirect .eq. 0)) then
     161   
     162    ! parse as text file format
    155163 
    156164    open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', err=999)
     
    225233    read(unitcommand,*) nested_output
    226234    if (old) call skplin(3,unitcommand)
    227     read(unitcommand,*) linit_cond
    228     if (old) call skplin(3,unitcommand)
    229     read(unitcommand,*) surf_only
     235    read(unitcommand,*,iostat=icmdstat) linit_cond
     236    if (icmdstat .gt. 0) &
     237      print*, 'readcommand: linit_cond not read properly',icmdstat,linit_cond
     238    if (old) call skplin(3,unitcommand)
     239    read(unitcommand,*,iostat=icmdstat) surf_only
     240    if (icmdstat .gt. 0) &
     241      print*, 'readcommand: linit_cond not read properly',icmdstat,surf_only
     242    if (old) call skplin(3,unitcommand)
     243    read(unitcommand,*,iostat=icmdstat) ldep_incr
     244    if (icmdstat .gt. 0) &
     245      print*, 'readcommand: linit_cond not read properly',icmdstat, ldep_incr
    230246    close(unitcommand)
    231247
     
    233249
    234250  ! write command file in namelist format to output directory if requested
    235   if (nmlout.eqv..true.) then
     251  if (nmlout .eqv. .true.) then
    236252    open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000)
    237253    write(unitcommand,nml=command)
     
    244260  !***************************************************************
    245261
    246   if (ctl.ge.0.1) then
     262  if (ctl .ge. 0.1) then
    247263    turbswitch=.true.
    248264  else
     
    308324  !************************************************************************
    309325
    310   if (ldirect.eq.1) linit_cond=0
    311   if ((linit_cond.lt.0).or.(linit_cond.gt.2)) then
     326  if (ldirect .eq. 1) linit_cond=0
     327  if ((linit_cond .lt. 0) .or. (linit_cond .gt. 2)) then
    312328    write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION    #### '
    313329    write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND".       #### '
     
    318334  !******************
    319335
    320   if (iedate.lt.ibdate) then
     336  if (iedate .lt. ibdate) then
    321337    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE    #### '
    322338    write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE      #### '
     
    324340    write(*,*) ' #### "COMMAND".                              #### '
    325341    stop
    326   else if (iedate.eq.ibdate) then
    327     if (ietime.lt.ibtime) then
     342  else if (iedate .eq. ibdate) then
     343    if (ietime .lt. ibtime) then
    328344    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME    #### '
    329345    write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE      #### '
     
    338354  !************************************
    339355
    340   if (ctl.gt.0.) then
     356  if (ctl .gt. 0.) then
    341357    method=1
    342358    mintime=minstep
     
    347363
    348364!  check for netcdf output switch (use for non-namelist input only!)
    349   if (iout.ge.8) then
     365  if (iout .ge. 8) then
    350366     lnetcdfout = 1
    351367     iout = iout - 8
     
    360376  !**********************************************************************
    361377
    362   if ((iout.lt.1).or.(iout.gt.5)) then
     378  if ((iout .lt. 1) .or.  (iout .gt. 5)) then
    363379    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
    364380    write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5 FOR       #### '
     
    369385
    370386  !AF check consistency between units and volume mixing ratio
    371   if ( ((iout.eq.2).or.(iout.eq.3)).and. &
    372        (ind_source.gt.1 .or.ind_receptor.gt.1) ) then
     387  if ( ((iout .eq. 2) .or.  (iout .eq. 3)) .and. &
     388       (ind_source .gt. 1 .or. ind_receptor .gt. 1) ) then
    373389    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
    374390    write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED      #### '
     
    381397  !*****************************************************************************
    382398
    383   if ((ioutputforeachrelease.eq.1).and.(mquasilag.eq.1)) then
     399  if ((ioutputforeachrelease .eq. 1) .and. (mquasilag .eq. 1)) then
    384400      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
    385401      write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####'
     
    392408  !*****************************************************************************
    393409
    394   if ((ldirect.lt.0).and.(mquasilag.eq.1)) then
     410  if ((ldirect .lt. 0) .and. (mquasilag .eq. 1)) then
    395411      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
    396412      write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####'
     
    404420  !*****************************************************************************
    405421
    406   if ((ldirect.lt.0).and.(ioutputforeachrelease.eq.0)) then
     422  if ((ldirect .lt. 0) .and. (ioutputforeachrelease .eq. 0)) then
    407423      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
    408424      write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####'
     
    416432  !*****************************************************************************
    417433
    418   if ((mdomainfill.eq.1).and.(ioutputforeachrelease.eq.1)) then
     434  if ((mdomainfill .eq. 1) .and. (ioutputforeachrelease .eq. 1)) then
    419435      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
    420436      write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR      ####'
     
    429445  !*****************************************************************************
    430446
    431   if (ldirect.lt.0) then
    432     if ((iout.eq.2).or.(iout.eq.3)) then
     447  if (ldirect .lt. 0) then
     448    if ((iout .eq. 2) .or. (iout .eq. 3)) then
    433449      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
    434450      write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####'
     
    442458  !*****************************************************************************
    443459
    444   if (mdomainfill.ge.1) then
    445     if ((iout.eq.4).or.(iout.eq.5)) then
     460  if (mdomainfill .ge. 1) then
     461    if ((iout .eq. 4) .or. (iout .eq. 5)) then
    446462      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
    447463      write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION,   ####'
     
    456472  !****************************************************************
    457473
    458   if ((ipout.ne.0).and.(ipout.ne.1).and.(ipout.ne.2)) then
     474  if ((ipout .ne. 0) .and. (ipout .ne. 1) .and. (ipout .ne. 2)) then
    459475    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
    460476    write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3!                #### '
     
    462478  endif
    463479
    464   if(lsubgrid.ne.1.and.verbosity.eq.0) then
     480  if(lsubgrid .ne. 1 .and. verbosity .eq. 0) then
    465481    write(*,*) '             ----------------               '
    466482    write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS'
     
    473489  !***********************************************************
    474490
    475   if ((lconvection.ne.0).and.(lconvection.ne.1)) then
     491  if ((lconvection .ne. 0) .and. (lconvection .ne. 1)) then
    476492    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
    477493    write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### '
     
    483499  !*************************************************************
    484500
    485   if (lsynctime.gt.(idiffnorm/2)) then
     501  if (lsynctime .gt. (idiffnorm/2)) then
    486502    write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION   #### '
    487503    write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER.      #### '
     
    494510  !*****************************************************************************
    495511
    496   if (loutaver.eq.0) then
     512  if (loutaver .eq. 0) then
    497513    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
    498514    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
     
    502518  endif
    503519
    504   if (loutaver.gt.loutstep) then
     520  if (loutaver .gt. loutstep) then
    505521    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
    506522    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
     
    510526  endif
    511527
    512   if (loutsample.gt.loutaver) then
     528  if (loutsample .gt. loutaver) then
    513529    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
    514530    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
     
    518534  endif
    519535
    520   if (mod(loutaver,lsynctime).ne.0) then
     536  if (mod(loutaver,lsynctime) .ne. 0) then
    521537    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
    522538    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
     
    525541  endif
    526542
    527   if ((loutaver/lsynctime).lt.2) then
     543  if ((loutaver/lsynctime) .lt. 2) then
    528544    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
    529545    write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST    #### '
     
    532548  endif
    533549
    534   if (mod(loutstep,lsynctime).ne.0) then
     550  if (mod(loutstep,lsynctime) .ne. 0) then
    535551    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
    536552    write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### '
     
    539555  endif
    540556
    541   if ((loutstep/lsynctime).lt.2) then
     557  if ((loutstep/lsynctime) .lt. 2) then
    542558    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
    543559    write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST   #### '
     
    546562  endif
    547563
    548   if (mod(loutsample,lsynctime).ne.0) then
     564  if (mod(loutsample,lsynctime) .ne. 0) then
    549565    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
    550566    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
     
    553569  endif
    554570
    555   if (itsplit.lt.loutaver) then
     571  if (itsplit .lt. loutaver) then
    556572    write(*,*) ' #### FLEXPART MODEL ERROR! SPLITTING TIME FOR#### '
    557573    write(*,*) ' #### PARTICLES IS TOO SHORT. PLEASE INCREASE #### '
     
    560576  endif
    561577
    562   if ((mquasilag.eq.1).and.(iout.ge.4)) then
     578  if ((mquasilag .eq. 1) .and. (iout .ge. 4)) then
    563579    write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING       #### '
    564580    write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME          #### '
     
    571587
    572588  outstep=real(abs(loutstep))
    573   if (ldirect.eq.1) then
     589  if (ldirect .eq. 1) then
    574590    bdate=juldate(ibdate,ibtime)
    575591    edate=juldate(iedate,ietime)
    576592    ideltas=nint((edate-bdate)*86400.)
    577   else if (ldirect.eq.-1) then
     593  else if (ldirect .eq. -1) then
    578594    loutaver=-1*loutaver
    579595    loutstep=-1*loutstep
  • branches/petra/src/readpaths.f90

    r27 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    2020!**********************************************************************
    2121
    22 subroutine readpaths !(pathfile)
     22subroutine readpaths
    2323
    2424  !*****************************************************************************
     
    2929  !     Author: A. Stohl                                                       *
    3030  !                                                                            *
    31   !     1 February 1994                                                        *
    32   !     last modified                                                          *
    33   !     HS, 7.9.2012                                                           *
    34   !     option to give pathnames file as command line option                   *
     31  !     1 February 1994
     32  !                                                                            *
     33  !     HS, 7.9.2012: option to give pathnames file as command line option     *
    3534  !                                                                            *
    3635  !*****************************************************************************
  • branches/petra/src/readreceptors.f90

    r27 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    2727  !                                                                            *
    2828  !     Author: A. Stohl                                                       *
    29   !     1 August 1996                                                          *
    30   !     HSO, 14 August 2013
    31   !     Added optional namelist input
     29  !     1 August 1996       
     30  !                                                  *
     31  !     HSO, 14 August 2013: Added optional namelist input
     32  !     PS, 2/2015: access= -> position=
    3233  !                                                                            *
    3334  !*****************************************************************************
     
    8182  ! prepare namelist output if requested
    8283  if (nmlout.eqv..true.) then
    83     open(unitreceptorout,file=path(2)(1:length(2))//'RECEPTORS.namelist',access='append',status='new',err=1000)
     84    open(unitreceptorout,file=path(2)(1:length(2))//'RECEPTORS.namelist',position='append',status='new',err=1000)
    8485  endif
    8586
  • branches/petra/src/readreleases.f90

    r27 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    3333  !     Update: 29 January 2001                                                *
    3434  !     Release altitude can be either in magl or masl                         *
    35   !     HSO, 12 August 2013
    36   !     Added optional namelist input
     35  !     HSO, 12 August 2013: Added optional namelist input
     36  !     PS, 2/2015: access= -> position=
     37  !
    3738  !                                                                            *
    3839  !*****************************************************************************
     
    126127  ! prepare namelist output if requested
    127128  if (nmlout.eqv..true.) then
    128     open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist',access='append',status='new',err=1000)
     129    open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist',position='append',status='new',err=1000)
    129130  endif
    130131
  • branches/petra/src/readspecies.f90

    r28 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    3434  !   N. Kristiansen, 31.01.2013: Including parameters for in-cloud scavenging *
    3535  !                                                                            *
    36   !   HSO, 13 August 2013
    37   !   added optional namelist input
     36  !   HSO, 13 August 2013: added optional namelist input
     37  !   PS, 2/2015: access= -> position=
    3838  !                                                                            *
    3939  !*****************************************************************************
     
    271271  ! namelist output if requested
    272272  if (nmlout.eqv..true.) then
    273     open(unitspecies,file=path(2)(1:length(2))//'SPECIES_'//aspecnumb//'.namelist',access='append',status='new',err=1000)
     273    open(unitspecies,file=path(2)(1:length(2))//'SPECIES_'//aspecnumb//'.namelist',position='append',status='new',err=1000)
    274274    write(unitspecies,nml=species_params)
    275275    close(unitspecies)
  • branches/petra/src/readwind.f90

    r24 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    3939  !  Changes, Bernd C. Krueger, Feb. 2001:
    4040  !   Variables tth and qvh (on eta coordinates) in common block
     41  ! 2/2015, PS: add missing paramter iret in call to grib subr
     42  !
    4143  !**********************************************************************
    4244  !                                                                     *
     
    249251  call grib_get_int(igrib,'numberOfPointsAlongAMeridian',isec2(3),iret)
    250252  call grib_check(iret,gribFunction,gribErrorMsg)
    251   call grib_get_int(igrib,'numberOfVerticalCoordinateValues',isec2(12))
     253  call grib_get_int(igrib,'numberOfVerticalCoordinateValues',isec2(12),iret)
    252254  call grib_check(iret,gribFunction,gribErrorMsg)
    253255  ! CHECK GRID SPECIFICATIONS
  • branches/petra/src/readwind_nests.f90

    r24 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    3838  !  CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api    *
    3939  !  CHANGE: 03/12/2008, Harald Sodemann, update to f90 with ECMWF grib_api    *
     40  ! 2/2015, PS: add missing paramter iret in call to grib subr
     41  !
    4042  !*****************************************************************************
    4143
     
    240242  call grib_check(iret,gribFunction,gribErrorMsg)
    241243  call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
    242        isec2(12))
     244       isec2(12),iret)
    243245  call grib_check(iret,gribFunction,gribErrorMsg)
    244246  ! CHECK GRID SPECIFICATIONS
  • branches/petra/src/skplin.f90

    r4 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    2121
    2222subroutine skplin(nlines,iunit)
    23   !                    i      i
     23  !                 i      i 
    2424  !*****************************************************************************
    2525  !                                                                            *
     
    3838  !                                                                            *
    3939  !*****************************************************************************
     40  ! PS 2/2015: catch EOF condition so that we can
     41  ! have optional parameters at end of list for compatibility
    4042
     43 
    4144  implicit none
    4245
    43   integer :: i,iunit, nlines
     46  integer, intent(in)  :: nlines, iunit
     47  integer :: i, icmdstat
    4448
    4549  do i=1,nlines
    46     read(iunit,*)
     50    read(iunit,*,iostat=icmdstat)
    4751  end do
    48 
     52   
    4953end subroutine skplin
  • branches/petra/src/writeheader.f90

    r20 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    3333  !     7 August 2002                                                          *
    3434  !                                                                            *
     35  !     2/2015, AP+PS: version string length written 
     36  !     2/2015, PS: write out ldep_incr
    3537  !*****************************************************************************
    3638  !                                                                            *
     
    6769
    6870  if (ldirect.eq.1) then
    69     write(unitheader) ibdate,ibtime, trim(flexversion)
     71    write(unitheader) ibdate,ibtime, len_trim(flexversion), trim(flexversion)
    7072  else
    71     write(unitheader) iedate,ietime, trim(flexversion)
     73    write(unitheader) iedate,ietime, len_trim(flexversion), trim(flexversion)
    7274  endif
    7375
     
    8082  !***************************************
    8183
    82   write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
    83        dxout,dyout
     84  write(unitheader) outlon0,outlat0,numxgrid,numygrid,dxout,dyout
    8485  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
    8586
     
    127128  !*****************************************
    128129
    129   write(unitheader) method,lsubgrid,lconvection, &
    130        ind_source,ind_receptor
     130  write(unitheader) method,lsubgrid,lconvection, ind_source,ind_receptor
    131131
    132132  ! Write age class information
     
    142142    write(unitheader) (oroout(ix,jy),jy=0,numygrid-1)
    143143  end do
     144
     145  ! Write deposition type
     146  !***********************
     147 
     148  write(unitheader) ldep_incr
     149
     150
    144151  close(unitheader)
    145152
  • branches/petra/src/writeheader_nest.f90

    r24 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    3232  !                                                                            *
    3333  !     7 August 2002                                                          *
     34  !                                                                            *
     35  !     2/2015, AP+PS: version string length written 
    3436  !                                                                            *
    3537  !*****************************************************************************
     
    6769
    6870  if (ldirect.eq.1) then
    69     write(unitheader) ibdate,ibtime, trim(flexversion)
     71    write(unitheader) ibdate,ibtime, len_trim(flexversion), trim(flexversion)
    7072  else
    71     write(unitheader) iedate,ietime, trim(flexversion)
     73    write(unitheader) iedate,ietime, len_trim(flexversion), trim(flexversion)
    7274  endif
    7375
  • branches/petra/src/writeheader_txt.f90

    r20 r36  
    11!**********************************************************************
    2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
     2! Copyright 1998-2015                                                 *
    33! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
    44! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
     
    3232  !                                                                            *
    3333  !     7 August 2002                                                          *
    34   !     modified IP 2013 for text output                                       *
     34  !                                                                            *
     35  !     2013, IP: IP, text            output                                   *
     36  !     2/2015, PS: version string length written, enclose version string in '
     37  !                 write out ldep_incr
     38  !
    3539  !*****************************************************************************
    3640  !                                                                            *
     
    5963  !************************
    6064
    61   open(unitheader,file=path(2)(1:length(2))//'header_txt', &
     65  open(unitheader,file=path(2)(1:length(2))//'header.txt', &
    6266       form='formatted',err=998)
    63   open(unitheader_txt,file=path(2)(1:length(2))//'header_txt_releases', &
     67  open(unitheader_rel,file=path(2)(1:length(2))//'header_releases.txt', &
    6468       form='formatted',err=998)
    6569
     
    6872  !*****************************
    6973 
    70   write(unitheader,*) '# ibdate,ibtime, iedate, ietime, flexversion'
    71   write(unitheader,*) ibdate, ibtime, iedate, ietime, trim(flexversion) !  'FLEXPART V9.0'
     74  write(unitheader,*) '# ibdate,ibtime, iedate, ietime, len(flexversion), flexversion'
     75  write(unitheader,*) ibdate, ibtime, iedate, ietime, len_trim(flexversion), "'"//trim(flexversion)//"'" !  'FLEXPART V9.0'
    7276  !if (ldirect.eq.1) then
    7377  !  write(unitheader,*) ibdate,ibtime,trim(flexversion) !  'FLEXPART V9.0'
     
    8791  write(unitheader,*) '# information on grid setup    '
    8892  write(unitheader,*) '#outlon0,outlat0,numxgrid,numygrid,dxout,dyout'
    89   write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, &
    90        dxout,dyout 
     93  write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, dxout,dyout
    9194  write(unitheader,*) '# numzgrid, outheight(.) '
    9295  write(unitheader,*) numzgrid,(outheight(i),i=1,numzgrid)
     
    119122
    120123
    121   write(unitheader_txt,*) '# information on release points'
    122   write(unitheader_txt,*) '# numpoint'
    123   write(unitheader_txt,*) numpoint
    124   write(unitheader_txt,*) '# for numpoint:'
     124  write(unitheader_rel,*) '# information on release points'
     125  write(unitheader_rel,*) '# numpoint'
     126  write(unitheader_rel,*) numpoint
     127  write(unitheader_rel,*) '# for numpoint:'
    125128  do i=1,numpoint
    126     write(unitheader_txt,*) ireleasestart(i),ireleaseend(i),kindz(i)
     129    write(unitheader_rel,*) ireleasestart(i),ireleaseend(i),kindz(i)
    127130    xp1=xpoint1(i)*dx+xlon0
    128131    yp1=ypoint1(i)*dy+ylat0
    129132    xp2=xpoint2(i)*dx+xlon0
    130133    yp2=ypoint2(i)*dy+ylat0
    131     write(unitheader_txt,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
    132     write(unitheader_txt,*) npart(i),1
     134    write(unitheader_rel,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
     135    write(unitheader_rel,*) npart(i),1
    133136    if (numpoint.le.1000) then
    134       write(unitheader_txt,*) compoint(i)
     137      write(unitheader_rel,*) compoint(i)
    135138    else
    136       write(unitheader_txt,*) compoint(1001)
     139      write(unitheader_rel,*) compoint(1001)
    137140    endif
    138141    do j=1,nspec
    139       write(unitheader_txt,*) xmass(i,j)
    140       write(unitheader_txt,*) xmass(i,j)
    141       write(unitheader_txt,*) xmass(i,j)
     142      write(unitheader_rel,*) xmass(i,j)
     143      write(unitheader_rel,*) xmass(i,j)
     144      write(unitheader_rel,*) xmass(i,j)
    142145    end do
    143146  end do
     
    148151  write(unitheader,*) '# information on model switches'
    149152  write(unitheader,*) '# method,lsubgrid,lconvection, ind_source,ind_receptor'
    150   write(unitheader,*) method,lsubgrid,lconvection, &
    151        ind_source,ind_receptor
     153  write(unitheader,*) method,lsubgrid,lconvection,ind_source,ind_receptor
    152154
    153155  ! Write age class information
     
    160162  !Do not write topography to text output file. Keep it on the binary one
    161163  !********************************
    162 
    163164  !do ix=0,numxgrid-1
    164165  !  write(unitheader,*) (oroout(ix,jy),jy=0,numygrid-1)
    165166  !end do
    166167
    167 
     168  ! Write deposition type
     169  !***********************
    168170 
    169 
     171  write(unitheader,*) '# information on incremental / accum. deposition'
     172  write(unitheader,*) ldep_incr
    170173
    171174  close(unitheader)
    172   close(unitheader_txt)
    173 
     175  close(unitheader_rel)
    174176
    175177!  open(unitheader,file=path(2)(1:length(2))//'header_nml', &
     
    181183
    182184
    183 998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
     185998 continue
     186  write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
    184187  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
    185188  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG