- Timestamp:
- Feb 16, 2015, 6:21:09 PM (10 years ago)
- Location:
- branches/petra
- Files:
-
- 1 added
- 21 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/petra/options/COMMAND
r24 r36 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, logical 109 .false. 110 LDEP_INCR IF .TRUE., INCREMENTAL DEPOSITION, ELSE ACCUMULATED DEPOSITION (=DEFAULT) 107 111 108 112 -
branches/petra/options/COMMAND.alternative
r24 r36 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) 33 34 34 35 -
branches/petra/options/COMMAND.reference
r24 r36 11 11 12 12 2. ________ ______ 3X, I8, 1X, I6 13 2011 0310 00000013 20111210 000000 14 14 YYYYMMDD HHMISS BEGINNING DATE OF SIMULATION 15 15 16 16 3. ________ ______ 3X, I8, 1X, I6 17 2011 0310 12000017 20111210 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, logical 109 .false. 110 LDEP_INCR IF .TRUE., INCREMENTAL DEPOSITION, ELSE ACCUMULATED DEPOSITION (=DEFAULT) 107 111 108 112 -
branches/petra/src/FLEXPART.f90
r30 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 (2014-07-01)'68 flexversion='Version 9.2_beta.r34 (2015-02-12)' 69 69 verbosity=0 70 70 … … 119 119 write(*,*) 'call readpaths' 120 120 endif 121 call readpaths (pathfile)121 call readpaths 122 122 123 123 if (verbosity.gt.1) then !show clock info -
branches/petra/src/advance.f90
r29 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 * 63 ! May 2002: Petterssen scheme introduced 64 ! PS, 2/2015: fix mixture of real and dp in call to funtion mod 64 65 ! * 65 66 !***************************************************************************** … … 707 708 708 709 if ( yt.lt.0. ) then 709 xt=mod(xt+180. ,360.)710 xt=mod(xt+180._dp,360._dp) 710 711 yt=-yt 711 712 else if ( yt.gt.real(nymin1) ) then 712 xt=mod(xt+180. ,360.)713 xt=mod(xt+180._dp,360._dp) 713 714 yt=2*real(nymin1)-yt 714 715 endif … … 877 878 878 879 if ( yt.lt.0. ) then 879 xt=mod(xt+180. ,360.)880 xt=mod(xt+180._dp,360._dp) 880 881 yt=-yt 881 882 else if ( yt.gt.real(nymin1) ) then 882 xt=mod(xt+180. ,360.)883 xt=mod(xt+180._dp,360._dp) 883 884 yt=2*real(nymin1)-yt 884 885 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 22 module com_mod 23 1 24 !******************************************************************************* 2 25 ! Include file for particle diffusion model FLEXPART * … … 7 30 ! June 1996 * 8 31 ! * 9 ! Last update:15 August 2013 IP * 32 ! Modifications: 15 August 2013 IP, 33 ! 2/2015 PS, add incremental deposition switch 10 34 ! * 11 35 !******************************************************************************* 12 13 module com_mod14 36 15 37 use par_mod, only: dp, numpath, maxnests, maxageclass, maxspec, ni, & … … 69 91 integer :: mquasilag,nested_output,ind_source,ind_receptor 70 92 integer :: ind_rel,ind_samp,ioutputforeachrelease,linit_cond,surf_only 71 logical :: turbswitch 93 logical :: turbswitch, ldep_incr 72 94 73 95 ! ctl factor, by which time step must be smaller than Lagrangian time scale … … 98 120 ! nested_output: 0 no, 1 yes 99 121 ! turbswitch determines how the Markov chain is formulated 122 ! ldep_incr: .true. incremental deposition, .false. accumulated deposition 100 123 101 124 ! ind_rel and ind_samp are used within the code to change between mass and mass-mix (see readcommand.f) … … 136 159 character :: compoint(1001)*45 137 160 integer :: numpoint 138 ! sec, now dynamically allocated:161 !SE, now dynamically allocated: 139 162 ! ireleasestart(maxpoint),ireleaseend(maxpoint) 140 163 ! real xpoint1(maxpoint),ypoint1(maxpoint) … … 155 178 real :: rgs(maxspec,5,numclass),rlu(maxspec,5,numclass) 156 179 real :: rm(maxspec),dryvel(maxspec),kao(maxspec),ohreact(maxspec) 157 ! seit is possible to associate a species with a second one to make transfer from gas to aerosol180 ! SE it is possible to associate a species with a second one to make transfer from gas to aerosol 158 181 integer :: spec_ass(maxspec) 159 182 … … 549 572 real :: dxoutn,dyoutn,outlon0n,outlat0n,xoutshiftn,youtshiftn 550 573 !real outheight(maxzgrid),outheighthalf(maxzgrid) 551 logical :: DEP,DRYDEP,DRYDEPSPEC(maxspec),WETDEP,OHREA,ASSSPEC574 logical :: dep,drydep,drydepspec(maxspec),wetdep,ohrea,assspec 552 575 553 576 ! numxgrid,numygrid number of grid points in x,y-direction … … 562 585 ! outheight [m] upper levels of the output grid 563 586 ! outheighthalf [m] half (middle) levels of the output grid cells 564 ! DEP.true., if either dry or wet depos. is switched on565 ! DRYDEP.true., if dry deposition is switched on566 ! DRYDEPSPEC.true., if dry deposition is switched on for that species567 ! WETDEP.true., if wet deposition is switched on568 ! OHREA .true., if OHreaction is switched on569 ! ASSSPEC.true., if there are two species asscoiated587 ! 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 570 593 ! (i.e. transfer of mass between these two occurs 571 594 -
branches/petra/src/concoutput.f90
r20 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 output 50 ! access= -> position= 49 51 ! * 50 52 !***************************************************************************** … … 108 110 write(adate,'(i8.8)') jjjjmmdd 109 111 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') 111 113 write(unitdates,'(a)') adate//atime 112 114 close(unitdates) … … 588 590 !************************* 589 591 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 610 599 end subroutine concoutput -
branches/petra/src/concoutput_nest.f90
r4 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 output 48 ! access= -> position= 47 49 ! * 48 50 !***************************************************************************** … … 112 114 113 115 114 115 116 117 118 119 120 121 122 123 124 125 126 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 127 129 128 130 … … 162 164 end do 163 165 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 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 185 187 186 188 !********************************************************************* … … 191 193 do ks=1,nspec 192 194 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 203 212 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 223 222 do l=1,nclassunc 224 223 auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage) 225 224 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 239 234 do l=1,nclassunc 240 235 auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage) 241 236 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 255 246 do l=1,nclassunc 256 247 auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage) 257 248 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 267 255 end do 268 256 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) 303 289 ! sparse_dump_u(sp_count_r)= 304 290 !+ 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) 305 411 else ! concentration is zero 306 412 sp_zer=.true. 307 413 endif 308 414 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 327 434 do jy=0,numygridn-1 328 435 do ix=0,numxgridn-1 329 436 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) 342 448 else ! concentration is zero 343 449 sp_zer=.true. 344 450 endif 345 451 end do 346 452 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 367 472 do ix=0,numxgridn-1 368 473 if (grid(ix,jy,kz).gt.smallnum) then … … 370 475 sp_count_i=sp_count_i+1 371 476 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 421 478 sp_zer=.false. 422 479 sp_fact=sp_fact*(-1.) 423 480 endif 424 481 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. 432 491 endif 433 492 end do 434 493 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) 524 501 525 502 endif ! output for ppt 526 503 527 end do528 end do504 end do 505 end do 529 506 530 507 close(unitoutgridppt) … … 538 515 !************************* 539 516 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 559 522 560 523 end subroutine concoutput_nest 561 -
branches/petra/src/concoutput_surf.f90
r20 r36 116 116 !write(unitdates,'(a)') adate//atime 117 117 118 open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')118 open(unitdates,file=path(2)(1:length(2))//'dates', position='append') 119 119 write(unitdates,'(a)') adate//atime 120 120 close(unitdates) -
branches/petra/src/par_mod.f90
r27 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 ! Last update 15 August 2013 IP * 30 ! 15 August 2013, IP * 31 ! 2/2015, PS: nshift=0, unitheader_txt -> unitheader_rel 32 ! * 31 33 ! * 32 34 !******************************************************************************* … … 128 130 !integer,parameter :: nxmax=1201,nymax=235,nuvzmax=58,nwzmax=58,nzmax=58 129 131 130 integer,parameter :: nxshift= 359 ! for ECMWF132 integer,parameter :: nxshift= 0 !359 ! for ECMWF 131 133 !integer,parameter :: nxshift=0 ! for GFS or FNL (XF) 132 134 … … 259 261 integer,parameter :: unitlsm=1, unitsurfdata=1, unitland=1, unitwesely=1 260 262 integer,parameter :: unitOH=1 261 integer,parameter :: unitdates=94, unitheader=90,unitheader_ txt=100, unitshortpart=95263 integer,parameter :: unitdates=94, unitheader=90,unitheader_rel=100, unitshortpart=95 262 264 integer,parameter :: unitboundcond=89 263 265 -
branches/petra/src/readcommand.f90
r30 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 ! 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 33 35 ! * 34 36 !***************************************************************************** … … 69 71 ! mdomainfill 1 use domain-filling option, 0 not, 2 use strat. O3 * 70 72 ! * 73 ! ldep_incr .true. for incremental, 74 ! .false. for accumulated deposition output (DEFAULT) 71 75 ! Constants: * 72 76 ! unitcommand unit connected to file COMMAND * … … 79 83 implicit none 80 84 81 real (kind=dp) :: juldate82 character (len=50) :: line85 real (kind=dp) :: juldate 86 character (len=50) :: line 83 87 logical :: old 84 integer :: readerror88 integer :: ireaderror, icmdstat 85 89 86 90 namelist /command/ & … … 110 114 linit_cond, & 111 115 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. 143 149 144 150 ! Open the command file and read user options … … 148 154 149 155 ! try namelist input (default) 150 read(unitcommand,command,iostat= readerror)156 read(unitcommand,command,iostat=ireaderror) 151 157 close(unitcommand) 152 158 153 159 ! 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 155 163 156 164 open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', err=999) … … 225 233 read(unitcommand,*) nested_output 226 234 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 230 246 close(unitcommand) 231 247 … … 233 249 234 250 ! write command file in namelist format to output directory if requested 235 if (nmlout .eqv..true.) then251 if (nmlout .eqv. .true.) then 236 252 open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000) 237 253 write(unitcommand,nml=command) … … 244 260 !*************************************************************** 245 261 246 if (ctl .ge.0.1) then262 if (ctl .ge. 0.1) then 247 263 turbswitch=.true. 248 264 else … … 308 324 !************************************************************************ 309 325 310 if (ldirect .eq.1) linit_cond=0311 if ((linit_cond .lt.0).or.(linit_cond.gt.2)) then326 if (ldirect .eq. 1) linit_cond=0 327 if ((linit_cond .lt. 0) .or. (linit_cond .gt. 2)) then 312 328 write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION #### ' 313 329 write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND". #### ' … … 318 334 !****************** 319 335 320 if (iedate .lt.ibdate) then336 if (iedate .lt. ibdate) then 321 337 write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE #### ' 322 338 write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE #### ' … … 324 340 write(*,*) ' #### "COMMAND". #### ' 325 341 stop 326 else if (iedate .eq.ibdate) then327 if (ietime .lt.ibtime) then342 else if (iedate .eq. ibdate) then 343 if (ietime .lt. ibtime) then 328 344 write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME #### ' 329 345 write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE #### ' … … 338 354 !************************************ 339 355 340 if (ctl .gt.0.) then356 if (ctl .gt. 0.) then 341 357 method=1 342 358 mintime=minstep … … 347 363 348 364 ! check for netcdf output switch (use for non-namelist input only!) 349 if (iout .ge.8) then365 if (iout .ge. 8) then 350 366 lnetcdfout = 1 351 367 iout = iout - 8 … … 360 376 !********************************************************************** 361 377 362 if ((iout .lt.1).or.(iout.gt.5)) then378 if ((iout .lt. 1) .or. (iout .gt. 5)) then 363 379 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 364 380 write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5 FOR #### ' … … 369 385 370 386 !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) ) then387 if ( ((iout .eq. 2) .or. (iout .eq. 3)) .and. & 388 (ind_source .gt. 1 .or. ind_receptor .gt. 1) ) then 373 389 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 374 390 write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED #### ' … … 381 397 !***************************************************************************** 382 398 383 if ((ioutputforeachrelease .eq.1).and.(mquasilag.eq.1)) then399 if ((ioutputforeachrelease .eq. 1) .and. (mquasilag .eq. 1)) then 384 400 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 385 401 write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####' … … 392 408 !***************************************************************************** 393 409 394 if ((ldirect .lt.0).and.(mquasilag.eq.1)) then410 if ((ldirect .lt. 0) .and. (mquasilag .eq. 1)) then 395 411 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 396 412 write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####' … … 404 420 !***************************************************************************** 405 421 406 if ((ldirect .lt.0).and.(ioutputforeachrelease.eq.0)) then422 if ((ldirect .lt. 0) .and. (ioutputforeachrelease .eq. 0)) then 407 423 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 408 424 write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####' … … 416 432 !***************************************************************************** 417 433 418 if ((mdomainfill .eq.1).and.(ioutputforeachrelease.eq.1)) then434 if ((mdomainfill .eq. 1) .and. (ioutputforeachrelease .eq. 1)) then 419 435 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 420 436 write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR ####' … … 429 445 !***************************************************************************** 430 446 431 if (ldirect .lt.0) then432 if ((iout .eq.2).or.(iout.eq.3)) then447 if (ldirect .lt. 0) then 448 if ((iout .eq. 2) .or. (iout .eq. 3)) then 433 449 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 434 450 write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####' … … 442 458 !***************************************************************************** 443 459 444 if (mdomainfill .ge.1) then445 if ((iout .eq.4).or.(iout.eq.5)) then460 if (mdomainfill .ge. 1) then 461 if ((iout .eq. 4) .or. (iout .eq. 5)) then 446 462 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 447 463 write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION, ####' … … 456 472 !**************************************************************** 457 473 458 if ((ipout .ne.0).and.(ipout.ne.1).and.(ipout.ne.2)) then474 if ((ipout .ne. 0) .and. (ipout .ne. 1) .and. (ipout .ne. 2)) then 459 475 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 460 476 write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3! #### ' … … 462 478 endif 463 479 464 if(lsubgrid .ne.1.and.verbosity.eq.0) then480 if(lsubgrid .ne. 1 .and. verbosity .eq. 0) then 465 481 write(*,*) ' ---------------- ' 466 482 write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS' … … 473 489 !*********************************************************** 474 490 475 if ((lconvection .ne.0).and.(lconvection.ne.1)) then491 if ((lconvection .ne. 0) .and. (lconvection .ne. 1)) then 476 492 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 477 493 write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### ' … … 483 499 !************************************************************* 484 500 485 if (lsynctime .gt.(idiffnorm/2)) then501 if (lsynctime .gt. (idiffnorm/2)) then 486 502 write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION #### ' 487 503 write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER. #### ' … … 494 510 !***************************************************************************** 495 511 496 if (loutaver .eq.0) then512 if (loutaver .eq. 0) then 497 513 write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' 498 514 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 502 518 endif 503 519 504 if (loutaver .gt.loutstep) then520 if (loutaver .gt. loutstep) then 505 521 write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' 506 522 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 510 526 endif 511 527 512 if (loutsample .gt.loutaver) then528 if (loutsample .gt. loutaver) then 513 529 write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' 514 530 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 518 534 endif 519 535 520 if (mod(loutaver,lsynctime) .ne.0) then536 if (mod(loutaver,lsynctime) .ne. 0) then 521 537 write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' 522 538 write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE #### ' … … 525 541 endif 526 542 527 if ((loutaver/lsynctime) .lt.2) then543 if ((loutaver/lsynctime) .lt. 2) then 528 544 write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' 529 545 write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST #### ' … … 532 548 endif 533 549 534 if (mod(loutstep,lsynctime) .ne.0) then550 if (mod(loutstep,lsynctime) .ne. 0) then 535 551 write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' 536 552 write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### ' … … 539 555 endif 540 556 541 if ((loutstep/lsynctime) .lt.2) then557 if ((loutstep/lsynctime) .lt. 2) then 542 558 write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' 543 559 write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST #### ' … … 546 562 endif 547 563 548 if (mod(loutsample,lsynctime) .ne.0) then564 if (mod(loutsample,lsynctime) .ne. 0) then 549 565 write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' 550 566 write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE #### ' … … 553 569 endif 554 570 555 if (itsplit .lt.loutaver) then571 if (itsplit .lt. loutaver) then 556 572 write(*,*) ' #### FLEXPART MODEL ERROR! SPLITTING TIME FOR#### ' 557 573 write(*,*) ' #### PARTICLES IS TOO SHORT. PLEASE INCREASE #### ' … … 560 576 endif 561 577 562 if ((mquasilag .eq.1).and.(iout.ge.4)) then578 if ((mquasilag .eq. 1) .and. (iout .ge. 4)) then 563 579 write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING #### ' 564 580 write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME #### ' … … 571 587 572 588 outstep=real(abs(loutstep)) 573 if (ldirect .eq.1) then589 if (ldirect .eq. 1) then 574 590 bdate=juldate(ibdate,ibtime) 575 591 edate=juldate(iedate,ietime) 576 592 ideltas=nint((edate-bdate)*86400.) 577 else if (ldirect .eq.-1) then593 else if (ldirect .eq. -1) then 578 594 loutaver=-1*loutaver 579 595 loutstep=-1*loutstep -
branches/petra/src/readpaths.f90
r27 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 !(pathfile)22 subroutine readpaths 23 23 24 24 !***************************************************************************** … … 29 29 ! Author: A. Stohl * 30 30 ! * 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 * 35 34 ! * 36 35 !***************************************************************************** -
branches/petra/src/readreceptors.f90
r27 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 ! 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= 32 33 ! * 33 34 !***************************************************************************** … … 81 82 ! prepare namelist output if requested 82 83 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) 84 85 endif 85 86 -
branches/petra/src/readreleases.f90
r27 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 36 ! Added optional namelist input 35 ! HSO, 12 August 2013: Added optional namelist input 36 ! PS, 2/2015: access= -> position= 37 ! 37 38 ! * 38 39 !***************************************************************************** … … 126 127 ! prepare namelist output if requested 127 128 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) 129 130 endif 130 131 -
branches/petra/src/readspecies.f90
r28 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 37 ! added optional namelist input36 ! HSO, 13 August 2013: added optional namelist input 37 ! PS, 2/2015: access= -> position= 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', access='append',status='new',err=1000)273 open(unitspecies,file=path(2)(1:length(2))//'SPECIES_'//aspecnumb//'.namelist',position='append',status='new',err=1000) 274 274 write(unitspecies,nml=species_params) 275 275 close(unitspecies) -
branches/petra/src/readwind.f90
r24 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 subr 42 ! 41 43 !********************************************************************** 42 44 ! * … … 249 251 call grib_get_int(igrib,'numberOfPointsAlongAMeridian',isec2(3),iret) 250 252 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) 252 254 call grib_check(iret,gribFunction,gribErrorMsg) 253 255 ! CHECK GRID SPECIFICATIONS -
branches/petra/src/readwind_nests.f90
r24 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 subr 41 ! 40 42 !***************************************************************************** 41 43 … … 240 242 call grib_check(iret,gribFunction,gribErrorMsg) 241 243 call grib_get_int(igrib,'numberOfVerticalCoordinateValues', & 242 isec2(12) )244 isec2(12),iret) 243 245 call grib_check(iret,gribFunction,gribErrorMsg) 244 246 ! CHECK GRID SPECIFICATIONS -
branches/petra/src/skplin.f90
r4 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 can 41 ! have optional parameters at end of list for compatibility 40 42 43 41 44 implicit none 42 45 43 integer :: i,iunit, nlines 46 integer, intent(in) :: nlines, iunit 47 integer :: i, icmdstat 44 48 45 49 do i=1,nlines 46 read(iunit,* )50 read(iunit,*,iostat=icmdstat) 47 51 end do 48 52 49 53 end subroutine skplin -
branches/petra/src/writeheader.f90
r20 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 written 36 ! 2/2015, PS: write out ldep_incr 35 37 !***************************************************************************** 36 38 ! * … … 67 69 68 70 if (ldirect.eq.1) then 69 write(unitheader) ibdate,ibtime, trim(flexversion)71 write(unitheader) ibdate,ibtime, len_trim(flexversion), trim(flexversion) 70 72 else 71 write(unitheader) iedate,ietime, trim(flexversion)73 write(unitheader) iedate,ietime, len_trim(flexversion), trim(flexversion) 72 74 endif 73 75 … … 80 82 !*************************************** 81 83 82 write(unitheader) outlon0,outlat0,numxgrid,numygrid, & 83 dxout,dyout 84 write(unitheader) outlon0,outlat0,numxgrid,numygrid,dxout,dyout 84 85 write(unitheader) numzgrid,(outheight(i),i=1,numzgrid) 85 86 … … 127 128 !***************************************** 128 129 129 write(unitheader) method,lsubgrid,lconvection, & 130 ind_source,ind_receptor 130 write(unitheader) method,lsubgrid,lconvection, 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 type 146 !*********************** 147 148 write(unitheader) ldep_incr 149 150 144 151 close(unitheader) 145 152 -
branches/petra/src/writeheader_nest.f90
r24 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 written 34 36 ! * 35 37 !***************************************************************************** … … 67 69 68 70 if (ldirect.eq.1) then 69 write(unitheader) ibdate,ibtime, trim(flexversion)71 write(unitheader) ibdate,ibtime, len_trim(flexversion), trim(flexversion) 70 72 else 71 write(unitheader) iedate,ietime, trim(flexversion)73 write(unitheader) iedate,ietime, len_trim(flexversion), trim(flexversion) 72 74 endif 73 75 -
branches/petra/src/writeheader_txt.f90
r20 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 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 ! 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 ! 35 39 !***************************************************************************** 36 40 ! * … … 59 63 !************************ 60 64 61 open(unitheader,file=path(2)(1:length(2))//'header _txt', &65 open(unitheader,file=path(2)(1:length(2))//'header.txt', & 62 66 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', & 64 68 form='formatted',err=998) 65 69 … … 68 72 !***************************** 69 73 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' 72 76 !if (ldirect.eq.1) then 73 77 ! write(unitheader,*) ibdate,ibtime,trim(flexversion) ! 'FLEXPART V9.0' … … 87 91 write(unitheader,*) '# information on grid setup ' 88 92 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 91 94 write(unitheader,*) '# numzgrid, outheight(.) ' 92 95 write(unitheader,*) numzgrid,(outheight(i),i=1,numzgrid) … … 119 122 120 123 121 write(unitheader_ txt,*) '# information on release points'122 write(unitheader_ txt,*) '# numpoint'123 write(unitheader_ txt,*) numpoint124 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:' 125 128 do i=1,numpoint 126 write(unitheader_ txt,*) ireleasestart(i),ireleaseend(i),kindz(i)129 write(unitheader_rel,*) ireleasestart(i),ireleaseend(i),kindz(i) 127 130 xp1=xpoint1(i)*dx+xlon0 128 131 yp1=ypoint1(i)*dy+ylat0 129 132 xp2=xpoint2(i)*dx+xlon0 130 133 yp2=ypoint2(i)*dy+ylat0 131 write(unitheader_ txt,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)132 write(unitheader_ txt,*) npart(i),1134 write(unitheader_rel,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i) 135 write(unitheader_rel,*) npart(i),1 133 136 if (numpoint.le.1000) then 134 write(unitheader_ txt,*) compoint(i)137 write(unitheader_rel,*) compoint(i) 135 138 else 136 write(unitheader_ txt,*) compoint(1001)139 write(unitheader_rel,*) compoint(1001) 137 140 endif 138 141 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) 142 145 end do 143 146 end do … … 148 151 write(unitheader,*) '# information on model switches' 149 152 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 152 154 153 155 ! Write age class information … … 160 162 !Do not write topography to text output file. Keep it on the binary one 161 163 !******************************** 162 163 164 !do ix=0,numxgrid-1 164 165 ! write(unitheader,*) (oroout(ix,jy),jy=0,numygrid-1) 165 166 !end do 166 167 167 168 ! Write deposition type 169 !*********************** 168 170 169 171 write(unitheader,*) '# information on incremental / accum. deposition' 172 write(unitheader,*) ldep_incr 170 173 171 174 close(unitheader) 172 close(unitheader_txt) 173 175 close(unitheader_rel) 174 176 175 177 ! open(unitheader,file=path(2)(1:length(2))//'header_nml', & … … 181 183 182 184 183 998 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### ' 185 998 continue 186 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### ' 184 187 write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### ' 185 188 write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### '
Note: See TracChangeset
for help on using the changeset viewer.