Changeset 660bcb7 in flexpart.git
- Timestamp:
- Nov 24, 2014, 1:36:35 PM (9 years ago)
- Branches:
- NetCDF
- Children:
- 3073eaf
- Parents:
- 4bf4a69
- Location:
- src
- Files:
-
- 7 edited
-
FLEXPART.f90 (modified) (5 diffs)
-
com_mod.f90 (modified) (2 diffs)
-
readcommand.f90 (modified) (5 diffs)
-
readreceptors.f90 (modified) (2 diffs)
-
readreleases.f90 (modified) (1 diff)
-
readspecies.f90 (modified) (2 diffs)
-
timemanager.f90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/FLEXPART.f90
rb4d29ce r660bcb7 45 45 use conv_mod 46 46 47 use netcdf_output_mod, only: writeheader_netcdf 48 49 47 50 implicit none 48 51 … … 303 306 !****************************************************************** 304 307 308 if (lnetcdfout.eq.1) then 309 call writeheader_netcdf(lnest = .false.) 310 else 311 call writeheader 312 end if 313 314 if (nested_output.eq.1) then 315 if (lnetcdfout.eq.1) then 316 call writeheader_netcdf(lnest = .true.) 317 else 318 call writeheader_nest 319 endif 320 endif 321 305 322 if (verbosity.gt.0) then 306 323 print*,'call writeheader' … … 315 332 if (nested_output.ne.1.and.surf_only.eq.1) call writeheader_surf 316 333 317 !open(unitdates,file=path(2)(1:length(2))//'dates')318 319 334 if (verbosity.gt.0) then 320 335 print*,'call openreceptors' … … 359 374 if (verbosity.gt.0) then 360 375 if (verbosity.gt.1) then 361 CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)362 write(*,*) 'S YSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max376 call system_clock(count_clock, count_rate, count_max) 377 write(*,*) 'System clock',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max 363 378 endif 364 379 if (info_flag.eq.1) then 365 print*, ' info only mode (stop)'380 print*, 'Info only mode (stop)' 366 381 stop 367 382 endif … … 373 388 write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLEXPART MODEL RUN!' 374 389 390 ! output wall time 391 if (verbosity .gt. 0) then 392 call system_clock(count_clock,count_rate) 393 tins=(count_clock - count_clock0)/real(count_rate) 394 print*,'Wall time ',tins,'s, ',tins/60,'min, ',tins/3600,'h.' 395 endif 396 375 397 end program flexpart -
src/com_mod.f90
rb4d29ce r660bcb7 113 113 ! lagespectra 1 if age spectra calculation switched on, 2 if not 114 114 115 integer :: lnetcdfout 116 ! lnetcdfout 1 for netcdf grid output, 0 if not. Set in COMMAND (namelist input) 115 117 116 118 integer :: nageclass,lage(maxageclass) … … 687 689 integer :: info_flag=0 688 690 integer :: count_clock, count_clock0, count_rate, count_max 691 real :: tins 689 692 logical :: nmlout=.true. 690 693 -
src/readcommand.f90
rb4d29ce r660bcb7 109 109 nested_output, & 110 110 linit_cond, & 111 lnetcdfout, & 111 112 surf_only 112 113 … … 138 139 nested_output=0 139 140 linit_cond=0 141 lnetcdfout=0 140 142 surf_only=0 141 143 … … 344 346 endif 345 347 348 ! check for netcdf output switch (use for non-namelist input only!) 349 if (iout.ge.8) then 350 lnetcdfout = 1 351 iout = iout - 8 352 endif 353 346 354 ! Check whether a valid option for gridded model output has been chosen 347 355 !********************************************************************** … … 349 357 if ((iout.lt.1).or.(iout.gt.5)) then 350 358 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 351 write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5! #### ' 359 write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5 FOR #### ' 360 write(*,*) ' #### STANDARD FLEXPART OUTPUT OR 9 - 13 #### ' 361 write(*,*) ' #### FOR NETCDF OUTPUT #### ' 352 362 stop 353 363 endif … … 361 371 stop 362 372 endif 363 364 373 365 374 -
src/readreceptors.f90
rb4d29ce r660bcb7 81 81 ! prepare namelist output if requested 82 82 if (nmlout.eqv..true.) then 83 open(unitreceptorout,file=path(2)(1:length(2))//'RECEPTORS.namelist',access='append',status=' new',err=1000)83 open(unitreceptorout,file=path(2)(1:length(2))//'RECEPTORS.namelist',access='append',status='unknown',err=1000) 84 84 endif 85 85 … … 179 179 stop 180 180 181 1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS " #### '182 write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY #### '181 1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS.namelist" #### ' 182 write(*,*) ' #### CANNOT BE OPENED/CREATED IN THE DIRECTORY #### ' 183 183 write(*,'(a)') path(2)(1:length(2)) 184 184 stop -
src/readreleases.f90
rb4d29ce r660bcb7 126 126 ! prepare namelist output if requested 127 127 if (nmlout.eqv..true.) then 128 open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist',access='append',status=' new',err=1000)128 open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist',access='append',status='unknown',err=1000) 129 129 endif 130 130 -
src/readspecies.f90
rb4d29ce r660bcb7 239 239 20 continue 240 240 241 242 ! Read in daily and day-of-week variation of emissions, if available 243 !******************************************************************* 244 ! HSO: This is not yet implemented as namelist parameters 245 ! default values set to 1 246 247 do j=1,24 ! initialize everything to no variation 248 area_hour(i,j)=1. 249 point_hour(i,j)=1. 250 end do 251 do j=1,7 252 area_dow(i,j)=1. 253 point_dow(i,j)=1. 254 end do 255 241 256 if (readerror.ne.0) then ! text format input 242 243 ! Read in daily and day-of-week variation of emissions, if available244 !*******************************************************************245 ! HSO: This is not yet implemented as namelist parameters246 247 do j=1,24 ! initialize everything to no variation248 area_hour(i,j)=1.249 point_hour(i,j)=1.250 end do251 do j=1,7252 area_dow(i,j)=1.253 point_dow(i,j)=1.254 end do255 257 256 258 read(unitspecies,*,end=22) … … 269 271 ! namelist output if requested 270 272 if (nmlout.eqv..true.) then 271 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',access='append',status='unknown',err=1000) 272 274 write(unitspecies,nml=species_params) 273 275 close(unitspecies) -
src/timemanager.f90
rb4d29ce r660bcb7 43 43 ! call convection BEFORE new fields are read in BWD mode * 44 44 ! Changes Caroline Forster, Feb 2005 * 45 !new interface between flexpart and convection scheme * 46 !Emanuel's latest subroutine convect43c.f is used * 45 ! new interface between flexpart and convection scheme * 46 ! Emanuel's latest subroutine convect43c.f is used * 47 ! Changes Stefan Henne, Harald Sodemann, 2013-2014 * 48 ! added netcdf output code * 47 49 !***************************************************************************** 48 50 ! * 49 51 ! Variables: * 50 ! DEP.true. if either wet or dry deposition is switched on *52 ! dep .true. if either wet or dry deposition is switched on * 51 53 ! decay(maxspec) [1/s] decay constant for radioactive decay * 52 ! DRYDEP.true. if dry deposition is switched on *54 ! drydep .true. if dry deposition is switched on * 53 55 ! ideltas [s] modelling period * 54 56 ! itime [s] actual temporal position of calculation * … … 70 72 ! prob probability of absorption at ground due to dry * 71 73 ! deposition * 72 ! WETDEP.true. if wet deposition is switched on *74 ! wetdep .true. if wet deposition is switched on * 73 75 ! weight weight for each concentration sample (1/2 or 1) * 74 76 ! uap(maxpart),ucp(maxpart),uzp(maxpart) = random velocities due to * … … 92 94 use par_mod 93 95 use com_mod 96 use netcdf_output_mod, only: concoutput_netcdf, concoutput_nest_netcdf,concoutput_surf_netcdf, concoutput_surf_nest_netcdf 94 97 95 98 implicit none … … 129 132 130 133 134 itime=0 131 135 !write(*,45) itime,numpart,gridtotalunc,wetgridtotalunc,drygridtotalunc 132 136 write(*,46) float(itime)/3600,itime,numpart … … 141 145 do itime=0,ideltas,lsynctime 142 146 143 144 147 ! Computation of wet deposition, OH reaction and mass transfer 145 148 ! between two species every lsynctime seconds … … 152 155 !******************************************************************** 153 156 154 if ( WETDEP.and. itime .ne. 0 .and. numpart .gt. 0) then157 if (wetdep .and. itime .ne. 0 .and. numpart .gt. 0) then 155 158 if (verbosity.gt.0) then 156 159 write (*,*) 'timemanager> call wetdepo' … … 159 162 endif 160 163 161 if ( OHREA.and. itime .ne. 0 .and. numpart .gt. 0) &164 if (ohrea .and. itime .ne. 0 .and. numpart .gt. 0) & 162 165 call ohreaction(itime,lsynctime,loutnext) 163 166 164 if ( ASSSPEC.and. itime .ne. 0 .and. numpart .gt. 0) then167 if (assspec .and. itime .ne. 0 .and. numpart .gt. 0) then 165 168 stop 'associated species not yet implemented!' 166 169 ! call transferspec(itime,lsynctime,loutnext) … … 240 243 !*********************************************************************** 241 244 242 if ( DEP.and.(itime.eq.loutnext).and.(ldirect.gt.0)) then245 if (dep.and.(itime.eq.loutnext).and.(ldirect.gt.0)) then 243 246 do ks=1,nspec 244 247 do kp=1,maxpointspec_act … … 350 353 if ((iout.le.3.).or.(iout.eq.5)) then 351 354 if (surf_only.ne.1) then 352 call concoutput(itime,outnum,gridtotalunc, & 353 wetgridtotalunc,drygridtotalunc) 355 if (lnetcdfout.eq.1) then 356 call concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) 357 else 358 call concoutput(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) 359 endif 354 360 else 355 if (verbosity.eq.1) then 356 print*,'call concoutput_surf ' 357 CALL SYSTEM_CLOCK(count_clock) 358 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 359 endif 360 call concoutput_surf(itime,outnum,gridtotalunc, & 361 wetgridtotalunc,drygridtotalunc) 362 if (verbosity.eq.1) then 363 print*,'called concoutput_surf ' 364 CALL SYSTEM_CLOCK(count_clock) 365 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 366 endif 361 if (verbosity.eq.1) then 362 print*,'call concoutput_surf ' 363 call system_clock(count_clock) 364 write(*,*) 'system clock',count_clock - count_clock0 365 endif 366 if (lnetcdfout.eq.1) then 367 call concoutput_surf_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) 368 else 369 call concoutput_surf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) 370 if (verbosity.eq.1) then 371 print*,'called concoutput_surf ' 372 call system_clock(count_clock) 373 write(*,*) 'system clock',count_clock - count_clock0 374 endif 375 endif 367 376 endif 368 377 369 if ((nested_output.eq.1).and.(surf_only.ne.1)) call concoutput_nest(itime,outnum) 370 if ((nested_output.eq.1).and.(surf_only.eq.1)) call concoutput_surf_nest(itime,outnum) 378 if (nested_output .eq. 1) then 379 if (lnetcdfout.eq.0) then 380 if (surf_only.ne.1) then 381 call concoutput_nest(itime,outnum) 382 else 383 call concoutput_surf_nest(itime,outnum) 384 endif 385 else 386 if (surf_only.ne.1) then 387 call concoutput_nest_netcdf(itime,outnum) 388 else 389 call concoutput_surf_nest_netcdf(itime,outnum) 390 endif 391 endif 392 endif 371 393 outnum=0. 372 394 endif … … 474 496 !**************************** 475 497 476 xold= xtra1(j)477 yold= ytra1(j)498 xold=real(xtra1(j)) 499 yold=real(ytra1(j)) 478 500 zold=ztra1(j) 479 501 … … 515 537 endif 516 538 517 if ( DRYDEPSPEC(ks)) then ! dry deposition539 if (drydepspec(ks)) then ! dry deposition 518 540 drydeposit(ks)=xmass1(j,ks)*prob(ks)*decfact 519 541 xmass1(j,ks)=xmass1(j,ks)*(1.-prob(ks))*decfact … … 526 548 endif 527 549 528 529 550 if (mdomainfill.eq.0) then 530 551 if (xmass(npoint(j),ks).gt.0.) & … … 538 559 if (xmassfract.lt.0.0001) then ! terminate all particles carrying less mass 539 560 itra1(j)=-999999999 561 if (verbosity.gt.0) then 562 print*,'terminated particle ',j,' for small mass' 563 endif 540 564 endif 541 565 542 566 ! Sabine Eckhardt, June 2008 543 567 ! don't create depofield for backward runs 544 if (DRYDEP.AND.(ldirect.eq.1)) then 545 call drydepokernel(nclass(j),drydeposit,real(xtra1(j)), & 546 real(ytra1(j)),nage,kp) 547 if (nested_output.eq.1) call drydepokernel_nest( & 548 nclass(j),drydeposit,real(xtra1(j)),real(ytra1(j)), & 549 nage,kp) 568 if (drydep.AND.(ldirect.eq.1)) then 569 call drydepokernel(nclass(j),drydeposit,real(xtra1(j)),real(ytra1(j)),nage,kp) 570 if (nested_output.eq.1) then 571 call drydepokernel_nest(nclass(j),drydeposit,real(xtra1(j)),real(ytra1(j)),nage,kp) 572 endif 550 573 endif 551 574 … … 554 577 555 578 if (abs(itra1(j)-itramem(j)).ge.lage(nageclass)) then 556 if (linit_cond.ge.1) & 557 call initial_cond_calc(itime+lsynctime,j) 579 if (linit_cond.ge.1) call initial_cond_calc(itime+lsynctime,j) 558 580 itra1(j)=-999999999 581 if (verbosity.gt.0) then 582 print*,'terminated particle ',j,' for age' 583 endif 559 584 endif 560 585 endif … … 584 609 585 610 if (iflux.eq.1) then 586 611 deallocate(flux) 587 612 endif 588 if ( OHREA.eqv..TRUE.) then589 613 if (ohrea.eqv..TRUE.) then 614 deallocate(OH_field,OH_field_height) 590 615 endif 591 616 if (ldirect.gt.0) then 592 deallocate(drygridunc,wetgridunc)617 deallocate(drygridunc,wetgridunc) 593 618 endif 594 619 deallocate(gridunc) … … 597 622 deallocate(xmasssave) 598 623 if (nested_output.eq.1) then 599 600 601 deallocate(griduncn,drygriduncn,wetgriduncn)602 624 deallocate(orooutn, arean, volumen) 625 if (ldirect.gt.0) then 626 deallocate(griduncn,drygriduncn,wetgriduncn) 627 endif 603 628 endif 604 629 deallocate(outheight,outheighthalf) 605 deallocate(oroout, area,volume)630 deallocate(oroout,area,volume) 606 631 607 632 end subroutine timemanager
Note: See TracChangeset
for help on using the changeset viewer.
