Changeset e31b3b5 in flexpart.git for src


Ignore:
Timestamp:
Apr 7, 2016, 9:04:32 AM (8 years ago)
Author:
Espen Sollum ATMOS <eso@…>
Branches:
master, 10.4.1_pesei, GFS_025, bugfixes+enhancements, dev, release-10, release-10.4.1, scaling-bug, univie
Children:
32b49c3
Parents:
8ed5f11 (diff), ec7fc72 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent.
Message:

Merge branch 'flux' into dev

Location:
src
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • src/mpi_mod.f90

    r8ed5f11 re31b3b5  
    120120  logical, parameter :: mp_dbg_out = .false.
    121121  logical, parameter :: mp_time_barrier=.true.
    122   logical, parameter :: mp_measure_time=.true.
     122  logical, parameter :: mp_measure_time=.false.
    123123  logical, parameter :: mp_exact_numpart=.true.
    124124
  • src/readspecies.f90

    r9484483 rec7fc72  
    151151!  write(*,*) density(pos_spec)
    152152    read(unitspecies,'(e18.1)',end=22) dquer(pos_spec)
    153 !  write(*,*) dquer(pos_spec)
     153    write(*,*) 'dquer(pos_spec):', dquer(pos_spec)
    154154    read(unitspecies,'(e18.1)',end=22) dsigma(pos_spec)
    155155!  write(*,*) dsigma(pos_spec)
     
    292292  endif
    293293
    294   if ((weta(pos_spec).gt.0).and.(henry(pos_spec).le.0)) then
     294  if (((weta(pos_spec).gt.0).or.(wetb(pos_spec).gt.0)).and.(henry(pos_spec).le.0)) then
    295295    if (dquer(pos_spec).le.0) goto 996 ! no particle, no henry set
    296296  endif
  • src/timemanager.f90

    r6a678e3 rec7fc72  
    145145!CGZ-lifetime: set lifetime to 0
    146146 
    147 
     147  write(*,46) float(itime)/3600,itime,numpart
    148148
    149149  if (verbosity.gt.0) then
     
    431431
    432432        !write(*,46) float(itime)/3600,itime,numpart
    433 45      format(i9,' SECONDS SIMULATED: ',i8, ' PARTICLES:    Uncertainty: ',3f7.3)
    434 46      format(' Simulated ',f7.1,' hours (',i9,' s), ',i8, ' particles')
     43345      format(i13,' SECONDS SIMULATED: ',i13, ' PARTICLES:    Uncertainty: ',3f7.3)
     43446      format(' Simulated ',f7.1,' hours (',i13,' s), ',i13, ' particles')
    435435        if (ipout.ge.1) call partoutput(itime)    ! dump particle positions
    436436        loutnext=loutnext+loutstep
  • src/timemanager_mpi.f90

    r8ed5f11 re31b3b5  
    494494          if (mp_measure_time) call mpif_mtime('iotime',1)
    495495
    496 ! :TODO: Correct calling of conc_surf above?
    497 
    498 !   call concoutput_surf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
    499 ! endif
    500 
    501496          if (nested_output.eq.1) then
    502497
     
    694689
    695690        if (mp_measure_time) call mpif_mtime('advance',0)
    696 !mp_advance_wtime_beg = mpi_wtime()
    697691
    698692        call advance(itime,npoint(j),idt(j),uap(j),ucp(j),uzp(j), &
     
    701695
    702696        if (mp_measure_time) call mpif_mtime('advance',1)
    703 
    704         ! mp_advance_wtime_end = mpi_wtime()
    705         ! mp_advance_wtime_total = mp_advance_wtime_total + (mp_advance_wtime_end - &
    706         !      & mp_advance_wtime_beg)
    707697
    708698
  • src/wetdepo.f90

    r1c3c778 rec7fc72  
    258258      wetscav=0.   
    259259
    260 !ZHG test if it nested?
    261260      if (ngrid.gt.0) then
    262261        act_temp=ttn(ix,jy,hz,n,ngrid)
  • src/ecmwf_mod.f90

    rdb712a8 r8ed5f11  
    2222!*******************************************************************************
    2323!   Include file for calculation of particle trajectories (Program FLEXPART)   *
    24 !        This file contains ECMWF specific parameters used in FLEXPART         *
    25 !        Note that module name differs from file name.                         *
    26 !        The makefile selects either this file, or gfs_mod.f90, depending      *
    27 !        on target.                                                            *
    2824!                                                                              *
    29 !        Author: ESO                                                           *
     25!       This file contains ECMWF specific parameters used in FLEXPART          *
     26!       Note that module name differs from file name.                          *
     27!       The makefile selects either this file, or gfs_mod.f90, depending       *
     28!       on target.                                                             *
    3029!                                                                              *
    31 !        2015                                                                  *
     30!       Author: ESO                                                            *
     31!                                                                              *
     32!       2015                                                                   *
    3233!                                                                              *
    3334!*******************************************************************************
     
    4445  integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138 !ECMWF new
    4546  integer,parameter :: nxshift=359
    46 !  integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138 !test BUG
    4747!  integer,parameter :: nxshift=0
    4848
    49 !
    5049  !*********************************************
    5150  ! Maximum dimensions of the nested input grids
     
    5554!  integer,parameter :: maxnests=1,nxmaxn=86,nymaxn=31
    5655
     56  ! nxmax,nymax        maximum dimension of wind fields in x and y
     57  !                    direction, respectively
     58  ! nuvzmax,nwzmax     maximum dimension of (u,v) and (w) wind fields in z
     59  !                    direction (for fields on eta levels)
     60  ! nzmax              maximum dimension of wind fields in z direction
     61  !                    for the transformed Cartesian coordinates
     62  ! nxshift            for global grids (in x), the grid can be shifted by
     63  !                    nxshift grid points, in order to accomodate nested
     64  !                    grids, and output grids overlapping the domain "boundary"
     65  !                    nxshift must not be negative; "normal" setting would be 0
    5766
    5867end module wind_mod
  • src/gfs_mod.f90

    rb0434e1 r8ed5f11  
    2222!*******************************************************************************
    2323!   Include file for calculation of particle trajectories (Program FLEXPART)   *
    24 !        This file contains GFS specific parameters used in FLEXPART           *
    25 !        Note that module name differs from file name.                         *
    26 !        The makefile selects either this file, or ecmwf_mod.f90, depending    *
    27 !        on target.                                                            *
    2824!                                                                              *
    29 !        Author: ESO                                                           *
     25!       This file contains GFS specific parameters used in FLEXPART            *
     26!       Note that module name differs from file name.                          *
     27!       The makefile selects either this file, or ecmwf_mod.f90, depending     *
     28!       on target.                                                             *
    3029!                                                                              *
    31 !        2015                                                                  *
     30!       Author: ESO                                                            *
     31!                                                                              *
     32!       2015                                                                   *
    3233!                                                                              *
    3334!*******************************************************************************
     
    4445  integer,parameter :: nxshift=0     ! for GFS or FNL
    4546
     47  !*********************************************
     48  ! Maximum dimensions of the nested input grids
     49  !*********************************************
     50
    4651  integer,parameter :: maxnests=1,nxmaxn=361,nymaxn=181
     52
     53  ! nxmax,nymax        maximum dimension of wind fields in x and y
     54  !                    direction, respectively
     55  ! nuvzmax,nwzmax     maximum dimension of (u,v) and (w) wind fields in z
     56  !                    direction (for fields on eta levels)
     57  ! nzmax              maximum dimension of wind fields in z direction
     58  !                    for the transformed Cartesian coordinates
     59  ! nxshift            for global grids (in x), the grid can be shifted by
     60  !                    nxshift grid points, in order to accomodate nested
     61  !                    grids, and output grids overlapping the domain "boundary"
     62  !                    nxshift must not be negative; "normal" setting would be 0
    4763end module wind_mod
  • src/par_mod.f90

    r1c3c778 r8ed5f11  
    2828!        1997                                                                  *
    2929!                                                                              *
    30 !        Last update 15 August 2013 IP                                         *
     30!        Update 15 August 2013 IP                                              *
     31!                                                                              *
     32!        ESO 2016:                                                             *
     33!          GFS specific parameters moved to gfs_mod.f90                        *
     34!          ECMWF specific parameters moved to ecmwf_mod.f90                    *
    3135!                                                                              *
    3236!*******************************************************************************
     
    3438module par_mod
    3539
     40!************************************************************************
    3641! wind_mod: is gfs_mod.f90 for target gfs, ecmwf_mod.f90 for target ecmwf
    3742!************************************************************************
     
    135140  !*********************************************
    136141 
    137   ! nxmax,nymax,nuvzmax,nwzmax,nzmax:
    138   ! Moved to ecmwf.f90 (for ECMWF) / gfs.f90 (GFS)
     142  ! Moved to ecmwf_mod.f90 (for ECMWF) / gfs_mod.f90 (for GFS)
    139143 
    140 
    141   !integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !FNL XF
    142   !integer,parameter :: nxmax=361,nymax=181,nuvzmax=152,nwzmax=152,nzmax=152 !ECMWF new
    143   !integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !ECMWF
    144   !integer,parameter :: nxmax=721,nymax=361,nuvzmax=64,nwzmax=64,nzmax=64
    145 
    146 !  integer,parameter :: nxshift=359 ! for ECMWF
    147   !integer,parameter :: nxshift=0     ! for GFS or FNL
    148 
    149144  integer,parameter :: nconvlevmax = nuvzmax-1
    150145  integer,parameter :: na = nconvlevmax+1
    151 
    152   ! moved to gfs_mod.f90 / ecmwf_mod.f90
    153   !
    154   ! nxmax,nymax        maximum dimension of wind fields in x and y
    155   !                    direction, respectively
    156   ! nuvzmax,nwzmax     maximum dimension of (u,v) and (w) wind fields in z
    157   !                    direction (for fields on eta levels)
    158   ! nzmax              maximum dimension of wind fields in z direction
    159   !                    for the transformed Cartesian coordinates
    160   ! nxshift            for global grids (in x), the grid can be shifted by
    161   !                    nxshift grid points, in order to accomodate nested
    162   !                    grids, and output grids overlapping the domain "boundary"
    163   !                    nxshift must not be negative; "normal" setting would be 0
    164146
    165147  ! ntracermax         maximum number of tracer species in convection
    166148  ! nconvlevmax        maximum number of levels for convection
    167149  ! na                 parameter used in Emanuel's convect subroutine
    168 
    169 
    170   !*********************************************
    171   ! Maximum dimensions of the nested input grids
    172   !*********************************************
    173 
    174   !integer,parameter :: maxnests=0, nxmaxn=0, nymaxn=0
    175   !integer,parameter :: maxnests=0,nxmaxn=351,nymaxn=351 !ECMWF
    176 
    177   !integer,parameter :: maxnests=1, nxmaxn=201, nymaxn=161 ! FNL XF
    178   ! maxnests                maximum number of nested grids
    179   ! nxmaxn,nymaxn           maximum dimension of nested wind fields in
    180   !                         x and y direction, respectively
    181150
    182151
     
    217186  !**************************************************
    218187
    219   integer,parameter :: maxpart=40000000
     188  integer,parameter :: maxpart=10000
    220189  integer,parameter :: maxspec=1
    221190  real,parameter :: minmass=0.0001
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG