- Location:
- /branches
- Files:
-
- 6 added
- 1 deleted
- 21 edited
Legend:
- Unmodified
- Added
- Removed
-
/branches/petra/options/COMMAND
r36 r33 106 106 SURF_ONLY IF THIS IS SET TO 1, OUTPUT IS WRITTEN ONLY OUT FOR LOWEST LAYER 107 107 108 25. _ 4x, logical109 .false.110 LDEP_INCR IF .TRUE., INCREMENTAL DEPOSITION, ELSE ACCUMULATED DEPOSITION (=DEFAULT)111 112 108 113 109 1. Simulation direction, 1 for forward, -1 for backward in time -
/branches/petra/options/COMMAND.alternative
r36 r33 31 31 2 LINIT_COND INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT 32 32 0 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)34 33 35 34 -
/branches/petra/options/COMMAND.reference
r36 r33 11 11 12 12 2. ________ ______ 3X, I8, 1X, I6 13 2011 1210 00000013 20110310 000000 14 14 YYYYMMDD HHMISS BEGINNING DATE OF SIMULATION 15 15 16 16 3. ________ ______ 3X, I8, 1X, I6 17 2011 1210 12000017 20110310 120000 18 18 YYYYMMDD HHMISS ENDING DATE OF SIMULATION 19 19 … … 105 105 0 106 106 SURF_ONLY IF THIS IS SET TO 1, OUTPUT IS WRITTEN ONLY OUT FOR LOWEST LAYER 107 108 25. _ 4x, logical109 .false.110 LDEP_INCR IF .TRUE., INCREMENTAL DEPOSITION, ELSE ACCUMULATED DEPOSITION (=DEFAULT)111 107 112 108 -
/branches/petra/src/FLEXPART.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 66 66 67 67 ! FLEXPART version string 68 flexversion='Version 9.2 _beta.r34 (2015-02-12)'68 flexversion='Version 9.2 beta (2014-07-01)' 69 69 verbosity=0 70 70 … … 119 119 write(*,*) 'call readpaths' 120 120 endif 121 call readpaths 121 call readpaths(pathfile) 122 122 123 123 if (verbosity.gt.1) then !show clock info -
/branches/petra/src/advance.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 61 61 ! 8 April 2000: Deep convection parameterization * 62 62 ! * 63 ! May 2002: Petterssen scheme introduced 64 ! PS, 2/2015: fix mixture of real and dp in call to funtion mod 63 ! May 2002: Petterssen scheme introduced * 65 64 ! * 66 65 !***************************************************************************** … … 708 707 709 708 if ( yt.lt.0. ) then 710 xt=mod(xt+180. _dp,360._dp)709 xt=mod(xt+180.,360.) 711 710 yt=-yt 712 711 else if ( yt.gt.real(nymin1) ) then 713 xt=mod(xt+180. _dp,360._dp)712 xt=mod(xt+180.,360.) 714 713 yt=2*real(nymin1)-yt 715 714 endif … … 878 877 879 878 if ( yt.lt.0. ) then 880 xt=mod(xt+180. _dp,360._dp)879 xt=mod(xt+180.,360.) 881 880 yt=-yt 882 881 else if ( yt.gt.real(nymin1) ) then 883 xt=mod(xt+180. _dp,360._dp)882 xt=mod(xt+180.,360.) 884 883 yt=2*real(nymin1)-yt 885 884 endif -
/branches/petra/src/com_mod.f90
r36 r33 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 22 module com_mod23 24 1 !******************************************************************************* 25 2 ! Include file for particle diffusion model FLEXPART * … … 30 7 ! June 1996 * 31 8 ! * 32 ! Modifications: 15 August 2013 IP, 33 ! 2/2015 PS, add incremental deposition switch 9 ! Last update:15 August 2013 IP * 34 10 ! * 35 11 !******************************************************************************* 12 13 module com_mod 36 14 37 15 use par_mod, only: dp, numpath, maxnests, maxageclass, maxspec, ni, & … … 91 69 integer :: mquasilag,nested_output,ind_source,ind_receptor 92 70 integer :: ind_rel,ind_samp,ioutputforeachrelease,linit_cond,surf_only 93 logical :: turbswitch , ldep_incr71 logical :: turbswitch 94 72 95 73 ! ctl factor, by which time step must be smaller than Lagrangian time scale … … 120 98 ! nested_output: 0 no, 1 yes 121 99 ! turbswitch determines how the Markov chain is formulated 122 ! ldep_incr: .true. incremental deposition, .false. accumulated deposition123 100 124 101 ! ind_rel and ind_samp are used within the code to change between mass and mass-mix (see readcommand.f) … … 159 136 character :: compoint(1001)*45 160 137 integer :: numpoint 161 ! SE, now dynamically allocated:138 !sec, now dynamically allocated: 162 139 ! ireleasestart(maxpoint),ireleaseend(maxpoint) 163 140 ! real xpoint1(maxpoint),ypoint1(maxpoint) … … 178 155 real :: rgs(maxspec,5,numclass),rlu(maxspec,5,numclass) 179 156 real :: rm(maxspec),dryvel(maxspec),kao(maxspec),ohreact(maxspec) 180 ! SEit is possible to associate a species with a second one to make transfer from gas to aerosol157 ! se it is possible to associate a species with a second one to make transfer from gas to aerosol 181 158 integer :: spec_ass(maxspec) 182 159 … … 572 549 real :: dxoutn,dyoutn,outlon0n,outlat0n,xoutshiftn,youtshiftn 573 550 !real outheight(maxzgrid),outheighthalf(maxzgrid) 574 logical :: dep,drydep,drydepspec(maxspec),wetdep,ohrea,assspec551 logical :: DEP,DRYDEP,DRYDEPSPEC(maxspec),WETDEP,OHREA,ASSSPEC 575 552 576 553 ! numxgrid,numygrid number of grid points in x,y-direction … … 585 562 ! outheight [m] upper levels of the output grid 586 563 ! outheighthalf [m] half (middle) levels of the output grid cells 587 ! dep.true., if either dry or wet depos. is switched on588 ! drydep.true., if dry deposition is switched on589 ! drydepspec.true., if dry deposition is switched on for that species590 ! wetdep.true., if wet deposition is switched on591 ! ohrea .true., if ohreaction is switched on592 ! assspec.true., if there are two species asscoiated564 ! 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 593 570 ! (i.e. transfer of mass between these two occurs 594 571 -
/branches/petra/src/concoutput.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 47 47 ! * 48 48 ! 2008 new sparse matrix format * 49 ! PS, 2/2015: option to produce incremental deposition output50 ! access= -> position=51 49 ! * 52 50 !***************************************************************************** … … 110 108 write(adate,'(i8.8)') jjjjmmdd 111 109 write(atime,'(i6.6)') ihmmss 112 open(unitdates,file=path(2)(1:length(2))//'dates', position='append')110 open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND') 113 111 write(unitdates,'(a)') adate//atime 114 112 close(unitdates) … … 590 588 !************************* 591 589 592 creceptor=0. 593 gridunc=0. 594 if (ldep_incr) then ! incremental deposition output 595 wetgridunc=0. 596 drygridunc=0. 597 endif 598 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 599 610 end subroutine concoutput -
/branches/petra/src/concoutput_nest.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 45 45 ! * 46 46 ! 2008 new sparse matrix format * 47 ! PS, 2/2015: option to produce incremental deposition output48 ! access= -> position=49 47 ! * 50 48 !***************************************************************************** … … 114 112 115 113 116 if (ldirect.eq.1) then 117 do ks=1,nspec 118 do kp=1,maxpointspec_act 119 tot_mu(ks,kp)=1 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 120 125 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 126 endif 129 127 130 128 … … 164 162 end do 165 163 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 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 184 183 end do 185 184 end do 186 end do187 185 188 186 !********************************************************************* … … 193 191 do ks=1,nspec 194 192 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 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') 212 203 endif 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 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 222 223 do l=1,nclassunc 223 224 auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage) 224 225 end do 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 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 234 239 do l=1,nclassunc 235 240 auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage) 236 241 end do 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 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 246 255 do l=1,nclassunc 247 256 auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage) 248 257 end do 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 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)) 255 267 end do 256 268 end do 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) 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) 289 303 ! sparse_dump_u(sp_count_r)= 290 304 !+ 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) 305 else ! concentration is zero 306 sp_zer=.true. 307 endif 308 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 327 do jy=0,numygridn-1 328 do ix=0,numxgridn-1 329 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) 325 340 ! sparse_dump_u(sp_count_r)= 326 341 !+ 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.) 342 else ! concentration is zero 343 sp_zer=.true. 360 344 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) 345 end do 346 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 367 do ix=0,numxgridn-1 368 if (grid(ix,jy,kz).gt.smallnum) then 369 if (sp_zer.eqv..true.) then ! first non zero value 370 sp_count_i=sp_count_i+1 371 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) 364 381 ! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0) 365 382 ! + write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp … … 367 384 !+ ,gridsigma(ix,jy,kz,ks,kp,nage)* 368 385 !+ factor(ix,jy,kz)/tot_mu(ks,kp) 369 else ! concentration is zero 370 sp_zer=.true. 371 endif 386 else ! concentration is zero 387 sp_zer=.true. 388 endif 389 end do 390 end do 372 391 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 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 397 414 do jy=0,numygridn-1 398 415 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) 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 421 sp_zer=.false. 422 sp_fact=sp_fact*(-1.) 423 endif 424 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) 411 430 else ! concentration is zero 412 sp_zer=.true.431 sp_zer=.true. 413 432 endif 414 433 end do 415 434 end do 416 else417 sp_count_i=0418 sp_count_r=0419 endif420 write(unitoutgridppt) sp_count_i421 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)422 write(unitoutgridppt) sp_count_r423 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)424 425 426 427 428 429 sp_count_i=0430 sp_count_r=0431 sp_fact=-1.432 sp_zer=.true.433 if ((ldirect.eq.1).and.(DRYDEP)) then435 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 434 453 do jy=0,numygridn-1 435 454 do ix=0,numxgridn-1 436 if (drygrid(ix,jy).gt.smallnum) then 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) 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) 448 469 else ! concentration is zero 449 sp_zer=.true.470 sp_zer=.true. 450 471 endif 451 472 end do 452 473 end do 453 else454 sp_count_i=0455 sp_count_r=0456 endif457 write(unitoutgridppt) sp_count_i458 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)459 write(unitoutgridppt) sp_count_r460 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)461 462 463 464 465 466 sp_count_i=0467 sp_count_r=0468 sp_fact=-1.469 sp_zer=.true.470 do kz=1,numzgrid471 do jy=0,numygridn-1474 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 472 493 do ix=0,numxgridn-1 473 494 if (grid(ix,jy,kz).gt.smallnum) then … … 475 496 sp_count_i=sp_count_i+1 476 497 sparse_dump_i(sp_count_i)= & 477 ix+jy*numxgridn+kz*numxgridn*numygridn498 ix+jy*numxgridn+kz*numxgridn*numygridn 478 499 sp_zer=.false. 479 500 sp_fact=sp_fact*(-1.) 480 501 endif 481 502 sp_count_r=sp_count_r+1 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. 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. 491 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) 524 525 endif ! output for ppt 526 527 end do 528 end do 529 530 close(unitoutgridppt) 531 close(unitoutgrid) 532 533 end do 534 535 536 537 ! Reinitialization of grid 538 !************************* 539 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. 492 551 end do 493 552 end do 494 553 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) 501 502 endif ! output for ppt 503 504 end do 505 end do 506 507 close(unitoutgridppt) 508 close(unitoutgrid) 509 554 end do 555 end do 510 556 end do 511 512 513 514 ! Reinitialization of grid 515 !************************* 516 517 griduncn=0. 518 if (ldep_incr) then ! incremental deposition output 519 wetgriduncn=0. 520 drygriduncn=0. 521 endif 557 end do 558 522 559 523 560 end subroutine concoutput_nest 561 -
/branches/petra/src/concoutput_surf.f90
r36 r33 116 116 !write(unitdates,'(a)') adate//atime 117 117 118 open(unitdates,file=path(2)(1:length(2))//'dates', position='append')118 open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND') 119 119 write(unitdates,'(a)') adate//atime 120 120 close(unitdates) -
/branches/petra/src/par_mod.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 28 28 ! 1997 * 29 29 ! * 30 ! 15 August 2013, IP * 31 ! 2/2015, PS: nshift=0, unitheader_txt -> unitheader_rel 32 ! * 30 ! Last update 15 August 2013 IP * 33 31 ! * 34 32 !******************************************************************************* … … 130 128 !integer,parameter :: nxmax=1201,nymax=235,nuvzmax=58,nwzmax=58,nzmax=58 131 129 132 integer,parameter :: nxshift= 0 !359 ! for ECMWF130 integer,parameter :: nxshift=359 ! for ECMWF 133 131 !integer,parameter :: nxshift=0 ! for GFS or FNL (XF) 134 132 … … 261 259 integer,parameter :: unitlsm=1, unitsurfdata=1, unitland=1, unitwesely=1 262 260 integer,parameter :: unitOH=1 263 integer,parameter :: unitdates=94, unitheader=90,unitheader_ rel=100, unitshortpart=95261 integer,parameter :: unitdates=94, unitheader=90,unitheader_txt=100, unitshortpart=95 264 262 integer,parameter :: unitboundcond=89 265 263 -
/branches/petra/src/readcommand.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 29 29 ! * 30 30 ! 18 May 1996 * 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 31 ! HSO, 1 July 2014 * 32 ! Added optional namelist input * 35 33 ! * 36 34 !***************************************************************************** … … 71 69 ! mdomainfill 1 use domain-filling option, 0 not, 2 use strat. O3 * 72 70 ! * 73 ! ldep_incr .true. for incremental,74 ! .false. for accumulated deposition output (DEFAULT)75 71 ! Constants: * 76 72 ! unitcommand unit connected to file COMMAND * … … 83 79 implicit none 84 80 85 real 86 character 81 real(kind=dp) :: juldate 82 character(len=50) :: line 87 83 logical :: old 88 integer :: ireaderror, icmdstat84 integer :: readerror 89 85 90 86 namelist /command/ & … … 114 110 linit_cond, & 115 111 lnetcdfout, & 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. 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 149 143 150 144 ! Open the command file and read user options … … 154 148 155 149 ! try namelist input (default) 156 read(unitcommand,command,iostat= ireaderror)150 read(unitcommand,command,iostat=readerror) 157 151 close(unitcommand) 158 152 159 153 ! distinguish namelist from fixed text input 160 if ((ireaderror .ne. 0) .or. (ldirect .eq. 0)) then 161 162 ! parse as text file format 154 if ((readerror.ne.0).or.(ldirect.eq.0)) then ! parse as text file format 163 155 164 156 open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', err=999) … … 233 225 read(unitcommand,*) nested_output 234 226 if (old) call skplin(3,unitcommand) 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 227 read(unitcommand,*) linit_cond 228 if (old) call skplin(3,unitcommand) 229 read(unitcommand,*) surf_only 246 230 close(unitcommand) 247 231 … … 249 233 250 234 ! write command file in namelist format to output directory if requested 251 if (nmlout .eqv..true.) then235 if (nmlout.eqv..true.) then 252 236 open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000) 253 237 write(unitcommand,nml=command) … … 260 244 !*************************************************************** 261 245 262 if (ctl .ge.0.1) then246 if (ctl.ge.0.1) then 263 247 turbswitch=.true. 264 248 else … … 324 308 !************************************************************************ 325 309 326 if (ldirect .eq.1) linit_cond=0327 if ((linit_cond .lt. 0) .or. (linit_cond .gt.2)) then310 if (ldirect.eq.1) linit_cond=0 311 if ((linit_cond.lt.0).or.(linit_cond.gt.2)) then 328 312 write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION #### ' 329 313 write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND". #### ' … … 334 318 !****************** 335 319 336 if (iedate .lt.ibdate) then320 if (iedate.lt.ibdate) then 337 321 write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE #### ' 338 322 write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE #### ' … … 340 324 write(*,*) ' #### "COMMAND". #### ' 341 325 stop 342 else if (iedate .eq.ibdate) then343 if (ietime .lt.ibtime) then326 else if (iedate.eq.ibdate) then 327 if (ietime.lt.ibtime) then 344 328 write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME #### ' 345 329 write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE #### ' … … 354 338 !************************************ 355 339 356 if (ctl .gt.0.) then340 if (ctl.gt.0.) then 357 341 method=1 358 342 mintime=minstep … … 363 347 364 348 ! check for netcdf output switch (use for non-namelist input only!) 365 if (iout .ge.8) then349 if (iout.ge.8) then 366 350 lnetcdfout = 1 367 351 iout = iout - 8 … … 376 360 !********************************************************************** 377 361 378 if ((iout .lt. 1) .or. (iout .gt.5)) then362 if ((iout.lt.1).or.(iout.gt.5)) then 379 363 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 380 364 write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5 FOR #### ' … … 385 369 386 370 !AF check consistency between units and volume mixing ratio 387 if ( ((iout .eq. 2) .or. (iout .eq. 3)) .and.&388 (ind_source .gt. 1 .or. ind_receptor .gt.1) ) then371 if ( ((iout.eq.2).or.(iout.eq.3)).and. & 372 (ind_source.gt.1 .or.ind_receptor.gt.1) ) then 389 373 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 390 374 write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED #### ' … … 397 381 !***************************************************************************** 398 382 399 if ((ioutputforeachrelease .eq. 1) .and. (mquasilag .eq.1)) then383 if ((ioutputforeachrelease.eq.1).and.(mquasilag.eq.1)) then 400 384 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 401 385 write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####' … … 408 392 !***************************************************************************** 409 393 410 if ((ldirect .lt. 0) .and. (mquasilag .eq.1)) then394 if ((ldirect.lt.0).and.(mquasilag.eq.1)) then 411 395 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 412 396 write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####' … … 420 404 !***************************************************************************** 421 405 422 if ((ldirect .lt. 0) .and. (ioutputforeachrelease .eq.0)) then406 if ((ldirect.lt.0).and.(ioutputforeachrelease.eq.0)) then 423 407 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 424 408 write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####' … … 432 416 !***************************************************************************** 433 417 434 if ((mdomainfill .eq. 1) .and. (ioutputforeachrelease .eq.1)) then418 if ((mdomainfill.eq.1).and.(ioutputforeachrelease.eq.1)) then 435 419 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 436 420 write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR ####' … … 445 429 !***************************************************************************** 446 430 447 if (ldirect .lt.0) then448 if ((iout .eq. 2) .or. (iout .eq.3)) then431 if (ldirect.lt.0) then 432 if ((iout.eq.2).or.(iout.eq.3)) then 449 433 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 450 434 write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####' … … 458 442 !***************************************************************************** 459 443 460 if (mdomainfill .ge.1) then461 if ((iout .eq. 4) .or. (iout .eq.5)) then444 if (mdomainfill.ge.1) then 445 if ((iout.eq.4).or.(iout.eq.5)) then 462 446 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 463 447 write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION, ####' … … 472 456 !**************************************************************** 473 457 474 if ((ipout .ne. 0) .and. (ipout .ne. 1) .and. (ipout .ne.2)) then458 if ((ipout.ne.0).and.(ipout.ne.1).and.(ipout.ne.2)) then 475 459 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 476 460 write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3! #### ' … … 478 462 endif 479 463 480 if(lsubgrid .ne. 1 .and. verbosity .eq.0) then464 if(lsubgrid.ne.1.and.verbosity.eq.0) then 481 465 write(*,*) ' ---------------- ' 482 466 write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS' … … 489 473 !*********************************************************** 490 474 491 if ((lconvection .ne. 0) .and. (lconvection .ne.1)) then475 if ((lconvection.ne.0).and.(lconvection.ne.1)) then 492 476 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 493 477 write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### ' … … 499 483 !************************************************************* 500 484 501 if (lsynctime .gt.(idiffnorm/2)) then485 if (lsynctime.gt.(idiffnorm/2)) then 502 486 write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION #### ' 503 487 write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER. #### ' … … 510 494 !***************************************************************************** 511 495 512 if (loutaver .eq.0) then496 if (loutaver.eq.0) then 513 497 write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' 514 498 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 518 502 endif 519 503 520 if (loutaver .gt.loutstep) then504 if (loutaver.gt.loutstep) then 521 505 write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' 522 506 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 526 510 endif 527 511 528 if (loutsample .gt.loutaver) then512 if (loutsample.gt.loutaver) then 529 513 write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' 530 514 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 534 518 endif 535 519 536 if (mod(loutaver,lsynctime) .ne.0) then520 if (mod(loutaver,lsynctime).ne.0) then 537 521 write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' 538 522 write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE #### ' … … 541 525 endif 542 526 543 if ((loutaver/lsynctime) .lt.2) then527 if ((loutaver/lsynctime).lt.2) then 544 528 write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' 545 529 write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST #### ' … … 548 532 endif 549 533 550 if (mod(loutstep,lsynctime) .ne.0) then534 if (mod(loutstep,lsynctime).ne.0) then 551 535 write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' 552 536 write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### ' … … 555 539 endif 556 540 557 if ((loutstep/lsynctime) .lt.2) then541 if ((loutstep/lsynctime).lt.2) then 558 542 write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' 559 543 write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST #### ' … … 562 546 endif 563 547 564 if (mod(loutsample,lsynctime) .ne.0) then548 if (mod(loutsample,lsynctime).ne.0) then 565 549 write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' 566 550 write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE #### ' … … 569 553 endif 570 554 571 if (itsplit .lt.loutaver) then555 if (itsplit.lt.loutaver) then 572 556 write(*,*) ' #### FLEXPART MODEL ERROR! SPLITTING TIME FOR#### ' 573 557 write(*,*) ' #### PARTICLES IS TOO SHORT. PLEASE INCREASE #### ' … … 576 560 endif 577 561 578 if ((mquasilag .eq. 1) .and. (iout .ge.4)) then562 if ((mquasilag.eq.1).and.(iout.ge.4)) then 579 563 write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING #### ' 580 564 write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME #### ' … … 587 571 588 572 outstep=real(abs(loutstep)) 589 if (ldirect .eq.1) then573 if (ldirect.eq.1) then 590 574 bdate=juldate(ibdate,ibtime) 591 575 edate=juldate(iedate,ietime) 592 576 ideltas=nint((edate-bdate)*86400.) 593 else if (ldirect .eq.-1) then577 else if (ldirect.eq.-1) then 594 578 loutaver=-1*loutaver 595 579 loutstep=-1*loutstep -
/branches/petra/src/readpaths.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 20 20 !********************************************************************** 21 21 22 subroutine readpaths 22 subroutine readpaths !(pathfile) 23 23 24 24 !***************************************************************************** … … 29 29 ! Author: A. Stohl * 30 30 ! * 31 ! 1 February 1994 32 ! * 33 ! HS, 7.9.2012: option to give pathnames file as command line option * 31 ! 1 February 1994 * 32 ! last modified * 33 ! HS, 7.9.2012 * 34 ! option to give pathnames file as command line option * 34 35 ! * 35 36 !***************************************************************************** -
/branches/petra/src/readreceptors.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 27 27 ! * 28 28 ! Author: A. Stohl * 29 ! 1 August 1996 30 ! * 31 ! HSO, 14 August 2013: Added optional namelist input 32 ! PS, 2/2015: access= -> position= 29 ! 1 August 1996 * 30 ! HSO, 14 August 2013 31 ! Added optional namelist input 33 32 ! * 34 33 !***************************************************************************** … … 82 81 ! prepare namelist output if requested 83 82 if (nmlout.eqv..true.) then 84 open(unitreceptorout,file=path(2)(1:length(2))//'RECEPTORS.namelist', position='append',status='new',err=1000)83 open(unitreceptorout,file=path(2)(1:length(2))//'RECEPTORS.namelist',access='append',status='new',err=1000) 85 84 endif 86 85 -
/branches/petra/src/readreleases.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 33 33 ! Update: 29 January 2001 * 34 34 ! Release altitude can be either in magl or masl * 35 ! HSO, 12 August 2013: Added optional namelist input 36 ! PS, 2/2015: access= -> position= 37 ! 35 ! HSO, 12 August 2013 36 ! Added optional namelist input 38 37 ! * 39 38 !***************************************************************************** … … 127 126 ! prepare namelist output if requested 128 127 if (nmlout.eqv..true.) then 129 open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist', position='append',status='new',err=1000)128 open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist',access='append',status='new',err=1000) 130 129 endif 131 130 -
/branches/petra/src/readspecies.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 34 34 ! N. Kristiansen, 31.01.2013: Including parameters for in-cloud scavenging * 35 35 ! * 36 ! HSO, 13 August 2013 : added optional namelist input37 ! PS, 2/2015: access= -> position=36 ! HSO, 13 August 2013 37 ! added optional namelist input 38 38 ! * 39 39 !***************************************************************************** … … 271 271 ! namelist output if requested 272 272 if (nmlout.eqv..true.) then 273 open(unitspecies,file=path(2)(1:length(2))//'SPECIES_'//aspecnumb//'.namelist', position='append',status='new',err=1000)273 open(unitspecies,file=path(2)(1:length(2))//'SPECIES_'//aspecnumb//'.namelist',access='append',status='new',err=1000) 274 274 write(unitspecies,nml=species_params) 275 275 close(unitspecies) -
/branches/petra/src/readwind.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 39 39 ! Changes, Bernd C. Krueger, Feb. 2001: 40 40 ! Variables tth and qvh (on eta coordinates) in common block 41 ! 2/2015, PS: add missing paramter iret in call to grib subr42 !43 41 !********************************************************************** 44 42 ! * … … 251 249 call grib_get_int(igrib,'numberOfPointsAlongAMeridian',isec2(3),iret) 252 250 call grib_check(iret,gribFunction,gribErrorMsg) 253 call grib_get_int(igrib,'numberOfVerticalCoordinateValues',isec2(12) ,iret)251 call grib_get_int(igrib,'numberOfVerticalCoordinateValues',isec2(12)) 254 252 call grib_check(iret,gribFunction,gribErrorMsg) 255 253 ! CHECK GRID SPECIFICATIONS -
/branches/petra/src/readwind_nests.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 38 38 ! CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api * 39 39 ! 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 subr41 !42 40 !***************************************************************************** 43 41 … … 242 240 call grib_check(iret,gribFunction,gribErrorMsg) 243 241 call grib_get_int(igrib,'numberOfVerticalCoordinateValues', & 244 isec2(12) ,iret)242 isec2(12)) 245 243 call grib_check(iret,gribFunction,gribErrorMsg) 246 244 ! CHECK GRID SPECIFICATIONS -
/branches/petra/src/skplin.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 21 21 22 22 subroutine skplin(nlines,iunit) 23 ! i i23 ! i i 24 24 !***************************************************************************** 25 25 ! * … … 38 38 ! * 39 39 !***************************************************************************** 40 ! PS 2/2015: catch EOF condition so that we can41 ! have optional parameters at end of list for compatibility42 40 43 44 41 implicit none 45 42 46 integer, intent(in) :: nlines, iunit 47 integer :: i, icmdstat 43 integer :: i,iunit, nlines 48 44 49 45 do i=1,nlines 50 read(iunit,* ,iostat=icmdstat)46 read(iunit,*) 51 47 end do 52 48 53 49 end subroutine skplin -
/branches/petra/src/writeheader.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 33 33 ! 7 August 2002 * 34 34 ! * 35 ! 2/2015, AP+PS: version string length written36 ! 2/2015, PS: write out ldep_incr37 35 !***************************************************************************** 38 36 ! * … … 69 67 70 68 if (ldirect.eq.1) then 71 write(unitheader) ibdate,ibtime, len_trim(flexversion), trim(flexversion)69 write(unitheader) ibdate,ibtime, trim(flexversion) 72 70 else 73 write(unitheader) iedate,ietime, len_trim(flexversion), trim(flexversion)71 write(unitheader) iedate,ietime, trim(flexversion) 74 72 endif 75 73 … … 82 80 !*************************************** 83 81 84 write(unitheader) outlon0,outlat0,numxgrid,numygrid,dxout,dyout 82 write(unitheader) outlon0,outlat0,numxgrid,numygrid, & 83 dxout,dyout 85 84 write(unitheader) numzgrid,(outheight(i),i=1,numzgrid) 86 85 … … 128 127 !***************************************** 129 128 130 write(unitheader) method,lsubgrid,lconvection, ind_source,ind_receptor 129 write(unitheader) method,lsubgrid,lconvection, & 130 ind_source,ind_receptor 131 131 132 132 ! Write age class information … … 142 142 write(unitheader) (oroout(ix,jy),jy=0,numygrid-1) 143 143 end do 144 145 ! Write deposition type146 !***********************147 148 write(unitheader) ldep_incr149 150 151 144 close(unitheader) 152 145 -
/branches/petra/src/writeheader_nest.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 32 32 ! * 33 33 ! 7 August 2002 * 34 ! *35 ! 2/2015, AP+PS: version string length written36 34 ! * 37 35 !***************************************************************************** … … 69 67 70 68 if (ldirect.eq.1) then 71 write(unitheader) ibdate,ibtime, len_trim(flexversion),trim(flexversion)69 write(unitheader) ibdate,ibtime, trim(flexversion) 72 70 else 73 write(unitheader) iedate,ietime, len_trim(flexversion),trim(flexversion)71 write(unitheader) iedate,ietime, trim(flexversion) 74 72 endif 75 73 -
/branches/petra/src/writeheader_txt.f90
r36 r33 1 1 !********************************************************************** 2 ! Copyright 1998 -2015*2 ! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 32 32 ! * 33 33 ! 7 August 2002 * 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 ! 34 ! modified IP 2013 for text output * 39 35 !***************************************************************************** 40 36 ! * … … 63 59 !************************ 64 60 65 open(unitheader,file=path(2)(1:length(2))//'header .txt', &61 open(unitheader,file=path(2)(1:length(2))//'header_txt', & 66 62 form='formatted',err=998) 67 open(unitheader_ rel,file=path(2)(1:length(2))//'header_releases.txt', &63 open(unitheader_txt,file=path(2)(1:length(2))//'header_txt_releases', & 68 64 form='formatted',err=998) 69 65 … … 72 68 !***************************** 73 69 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'70 write(unitheader,*) '# ibdate,ibtime, iedate, ietime, flexversion' 71 write(unitheader,*) ibdate, ibtime, iedate, ietime, trim(flexversion) ! 'FLEXPART V9.0' 76 72 !if (ldirect.eq.1) then 77 73 ! write(unitheader,*) ibdate,ibtime,trim(flexversion) ! 'FLEXPART V9.0' … … 91 87 write(unitheader,*) '# information on grid setup ' 92 88 write(unitheader,*) '#outlon0,outlat0,numxgrid,numygrid,dxout,dyout' 93 write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, dxout,dyout 89 write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, & 90 dxout,dyout 94 91 write(unitheader,*) '# numzgrid, outheight(.) ' 95 92 write(unitheader,*) numzgrid,(outheight(i),i=1,numzgrid) … … 122 119 123 120 124 write(unitheader_ rel,*) '# information on release points'125 write(unitheader_ rel,*) '# numpoint'126 write(unitheader_ rel,*) numpoint127 write(unitheader_ rel,*) '# for numpoint:'121 write(unitheader_txt,*) '# information on release points' 122 write(unitheader_txt,*) '# numpoint' 123 write(unitheader_txt,*) numpoint 124 write(unitheader_txt,*) '# for numpoint:' 128 125 do i=1,numpoint 129 write(unitheader_ rel,*) ireleasestart(i),ireleaseend(i),kindz(i)126 write(unitheader_txt,*) ireleasestart(i),ireleaseend(i),kindz(i) 130 127 xp1=xpoint1(i)*dx+xlon0 131 128 yp1=ypoint1(i)*dy+ylat0 132 129 xp2=xpoint2(i)*dx+xlon0 133 130 yp2=ypoint2(i)*dy+ylat0 134 write(unitheader_ rel,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)135 write(unitheader_ rel,*) npart(i),1131 write(unitheader_txt,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i) 132 write(unitheader_txt,*) npart(i),1 136 133 if (numpoint.le.1000) then 137 write(unitheader_ rel,*) compoint(i)134 write(unitheader_txt,*) compoint(i) 138 135 else 139 write(unitheader_ rel,*) compoint(1001)136 write(unitheader_txt,*) compoint(1001) 140 137 endif 141 138 do j=1,nspec 142 write(unitheader_ rel,*) xmass(i,j)143 write(unitheader_ rel,*) xmass(i,j)144 write(unitheader_ rel,*) xmass(i,j)139 write(unitheader_txt,*) xmass(i,j) 140 write(unitheader_txt,*) xmass(i,j) 141 write(unitheader_txt,*) xmass(i,j) 145 142 end do 146 143 end do … … 151 148 write(unitheader,*) '# information on model switches' 152 149 write(unitheader,*) '# method,lsubgrid,lconvection, ind_source,ind_receptor' 153 write(unitheader,*) method,lsubgrid,lconvection,ind_source,ind_receptor 150 write(unitheader,*) method,lsubgrid,lconvection, & 151 ind_source,ind_receptor 154 152 155 153 ! Write age class information … … 162 160 !Do not write topography to text output file. Keep it on the binary one 163 161 !******************************** 162 164 163 !do ix=0,numxgrid-1 165 164 ! write(unitheader,*) (oroout(ix,jy),jy=0,numygrid-1) 166 165 !end do 167 166 168 ! Write deposition type 169 !*********************** 167 170 168 171 write(unitheader,*) '# information on incremental / accum. deposition' 172 write(unitheader,*) ldep_incr 169 173 170 174 171 close(unitheader) 175 close(unitheader_rel) 172 close(unitheader_txt) 173 176 174 177 175 ! open(unitheader,file=path(2)(1:length(2))//'header_nml', & … … 183 181 184 182 185 998 continue 186 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### ' 183 998 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### ' 187 184 write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### ' 188 185 write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### '
Note: See TracChangeset
for help on using the changeset viewer.