module params type parameters real*8 :: px ! pi real*8 :: Hrms ! Hrms wave height real*8 :: Trep ! representative wave period real*8 :: dir0 ! mean wave direction (Nautical convention) integer*4 :: m ! power in cos^m directional distribution integer*4 :: nt ! max. number of time steps real*8 :: hmin ! threshold water depth real*8 :: gammax ! maximum ratio Hrms/hh real*8 :: Tlong ! wave group period for case instat=1 real*8 :: Llong ! alongshore wave group length for case instat=1 real*8 :: gamma ! breaker parameter in Baldock or Roelvink formulation real*8 :: delta ! fraction of wave height to add to depth in computation of celerity real*8 :: rho ! water density real*8 :: g ! acceleration of gravity real*8 :: rhog8 ! 1/8*rho*g real*8 :: omega ! angular wave frequency real*8 :: thetamin ! lower directional limit (angle w.r.t computational x-axis) real*8 :: thetamax ! upper directional limit (angle w.r.t computational x-axis) real*8 :: dtheta ! directional resolution (deg) integer*4 :: thetanaut ! option to enter thetamin,thetamax in nautical convention real*8 :: wci ! option wave/current interaction 0/1 real*8 :: hwci ! min depth fro wci real*8 :: dt ! time step integer*4 :: break ! option breaker model (1=roelvink, 2=baldock, 3=roelvink adapted) integer*4 :: instat ! option time-varying wave b.c. ! (0=stationary, 1=regular wave groups, 3=long-crested random wave groups) integer*4 :: wavint ! (only in stationary mode) interval between wave module calls in tint real*8 :: alpha ! wave dissipation coefficient real*8 :: n ! power in roelvink dissipation model integer*4 :: roller ! option to turn off/on roller model (0/1) (not implemented yet) real*8 :: beta ! breaker slope coefficient in roller model real*8 :: taper ! time to spin up wave b.c. in case of stationary waves real*8 :: t ! time (s) real*8 :: tnext ! next time point for output integer*4 :: it ! output time step number real*8 :: tstart ! start time of simulation real*8 :: tint ! time interval output real*8 :: tintp ! time interval output points real*8 :: tintg ! time interval output global variables real*8 :: tintm ! time interval output mean global variables real*8 :: tstop ! stop time simulation integer*4 :: ntout ! number of output time steps real*8 :: C ! Chezy value real*8 :: cf ! friction coefficient flow [-] real*8 :: eps ! threshold depth real*8 :: umin ! threshold velocity upwind scheme real*8 :: zs01 ! initial water level first sea boundary real*8 :: zs02 ! initial water level second sea boundary real*8 :: zs03 ! initial water level first land boundary real*8 :: zs04 ! initial water level second land boundary integer*4 :: tideloc ! number of input tidal time series real*8 :: paulrevere ! if tideloc =>2, then this indicates where the time series are to be ! applied. Input for tidal information to xbeach options (3): ! 1. one tidal record --> specify tidal record everywhere ! 2. two tidal records --> Need to specify keyword 'paulrevere' ! paulrevere==0 implies to apply one tidal record to ! both sea corners and one tidal record to both land corners ! paulrevere==1 implies to apply the first tidal record ! (column 2 in zs0input.dat) to the (x=1,y=1) sea corner and ! the second tidal record (third column) to the (x=1,y=N) sea corner ! 3. four tidal records --> Need to list tidal records in ! zs0input.dat in order of: ! (x=1,y=1) ! (x=1,y=N) ! (x=N,y=N) ! (x=N,y=1) ! NOTE: clockwise from (1,1) corner integer*8 :: tidelen ! length of input tidal time series real*8 :: A ! obsolete real*8 :: dico ! diffusion coefficient real*8 :: facsl ! factor bedslope effect real*8 :: nuh ! horizontal background viscosity real*8 :: nuhfac ! viscosity coefficient for roller induced turbulent horizontal viscosity real*8 :: rhos ! sediment density real*8 :: morfac ! morphological factor real*8 :: morstart ! start time morphology real*8 :: Emean ! mean wave energy at boundary real*8 :: CFL ! maximum courant number integer*4 :: ngd ! number of sediment classes integer*4 :: nd ! number of sediment class layers real*8 :: dzg ! thickness of sediment class layers real*8 :: D501 ! D50 grain diameter second class of sediment real*8 :: D901 ! D90 grain diameter second class of sediment real*8 :: D502 ! D50 grain diameter second class of sediment real*8 :: D902 ! D90 grain diameter second class of sediment real*8 :: D503 ! D50 grain diameter third class of sediment real*8 :: D903 ! D90 grain diameter third class of sediment real*8 :: sedcal1 ! calibration factor for sediment class 1 real*8 :: sedcal2 ! calibration factor for sediment class 2 real*8 :: sedcal3 ! calibration factor for sediment class 2 real*8 :: por ! porosity real*8 :: wetslp ! critical avalanching slope under water real*8 :: dryslp ! critical avalanching slope above water integer*4 :: sw ! short wave contribution: 0 = urms=0 & ust =0, 1 = default model, 2 = urms=1 and ust=0, 3 = urms=0 & ust=1 integer*4 :: front ! switch for seaward flow boundary: 0 = radiating boundary(Ad), 1 = Van Dongeren, 1997 integer*4 :: ARC ! switch for active reflection compensation at seaward boundary: 0 = reflective, 1 = weakly (non) reflective real*4 :: order ! switch for order of wave steering, 1 = first order wave steering (short wave energy only), 2 = second oder wave steering (bound long wave corresponding to short wave forcing is added) integer*4 :: left ! switch for lateral boundary at left, 0 = vv computed from NSWE, 1 = reflective wall; vv=0 integer*4 :: right ! switch for lateral boundary at right, 0 = vv computed from NSWE, 1 = reflective wall; vv=0 integer*4 :: back ! switch for boundary at bay side, 0 = radiating boundary (Ad), 1 = reflective boundary; uu=0 integer*4 :: refl ! 1 = compensate for reflected wave and roller massflux, 0 = no compensation real*8 :: hswitch ! is the water depth at which is switched from wetslp to dryslp real*8 :: z0 ! zero flow velocity level in Soulsby van Rijn (1997) sed.conc. expression real*8 :: w ! fall velocity sediment complex(kind(0.0)):: compi ! complex i, sqrt(-1) integer*4 :: listline ! keeps rack of the record line in bcf-files real*8 :: rhoa ! air density real*8 :: Cd ! wind drag coefficient real*8 :: windv ! wind velocity real*8 :: windth ! wind direction (nautical input) real*8 :: epsi ! weighting factor for actual flow in computing time avergaed flow at seawrd boundary 1>=epsi>=0 integer*4 :: nonh ! 0 = NSWE, 1 = NSW + non-hydrostatic pressure compensation Stelling & Zijlema, 2003 real*8 :: nuhv ! longshore viscosity enhancement factor real*8 :: wearth ! angular velocity of earth for computing Coriolis forces real*8 :: lat ! estimated latitude at model location for computing Coriolis real*8 :: fc ! real*8 :: fcutoff ! lo freq cutoff frequency for boundary conditions real*8 :: sprdthr ! threshold above which spec dens are read in (default 0.08*maxval) real*8 :: struct ! 0 = no revetment, 1 = multiple sediment classes with non-erodable fractions real*8 :: smax ! Being tested: maximum Shields parameter for ceq Diane Foster integer*4 :: form ! equilibrium sed. conc. formulation: 1 = Soulsby van rijn, 1997, 2 = Van Rijn 2008 integer*4 :: carspan ! 0 = use cg (default); 1 = use sqrt(gh) in instat = 3 for c&g tests integer*4 :: rugauge ! 0 = normal obs. point (default) ; 1 = runupgauge obs. point moving with the shoreline. integer*4 :: nspr ! Expert tool: nspr = 1 bin all wave components for generation of qin (instat 4+) in one direction ! nspr = 0 regular long wave spreading (default) end type contains subroutine wave_input(par) type(parameters) :: par real*8, external :: readkey_dbl integer, external :: readkey_int par%px = 3.14159265358979; par%compi = (0.,1.) par%instat = readkey_int ('params.txt','instat', 1, 0, 7) if (par%instat == 0) then par%dir0 = readkey_dbl ('params.txt','dir0', 270.d0, 180.d0, 360.d0) par%Hrms = readkey_dbl ('params.txt','Hrms', 1.d0, 0.d0, 10.d0) par%wavint = readkey_int ('params.txt','wavint', 1, 1, 3600) par%m = readkey_int ('params.txt','m', 10, 2, 128) par%Trep = readkey_dbl ('params.txt','Tm01', 10.d0, 1.d0, 20.d0) par%Trep = readkey_dbl ('params.txt','Trep', par%Trep, 1.d0, 20.d0) par%omega = 2.d0*par%px/par%Trep; elseif (par%instat==1) then par%dir0 = readkey_dbl ('params.txt','dir0', 270.d0, 180.d0, 360.d0) par%Hrms = readkey_dbl ('params.txt','Hrms', 1.d0, 0.d0, 10.d0) par%Tlong = readkey_dbl ('params.txt','Tlong', 80.d0, 20.d0, 300.d0) par%m = readkey_int ('params.txt','m', 10, 2, 128) par%Trep = readkey_dbl ('params.txt','Tm01', 10.d0, 1.d0, 20.d0) par%Trep = readkey_dbl ('params.txt','Trep', par%Trep, 1.d0, 20.d0) par%omega = 2.d0*par%px/par%Trep; elseif (par%instat==2 .or. par%instat==3) then par%dir0 = readkey_dbl ('params.txt','dir0', 270.d0, 180.d0, 360.d0) par%Hrms = readkey_dbl ('params.txt','Hrms', 1.d0, 0.d0, 10.d0) par%m = readkey_int ('params.txt','m', 10, 2, 128) par%Trep = readkey_dbl ('params.txt','Tm01', 10.d0, 1.d0, 20.d0) par%Trep = readkey_dbl ('params.txt','Trep', par%Trep, 1.d0, 20.d0) par%omega = 2.d0*par%px/par%Trep; elseif (par%instat > 8) then write(*,*)'Instat invalid option' stop end if ! Input file Keyword Default Minimum Maximum !par%dir0 = readkey_dbl ('params.txt','dir0', 270.d0, 180.d0, 360.d0) par%hmin = readkey_dbl ('params.txt','hmin', 0.01d0, 0.001d0, 1.d0) par%gammax= readkey_dbl ('params.txt','gammax', 5.d0, .4d0, 5.d0) par%gamma = readkey_dbl ('params.txt','gamma', 0.6d0, 0.4d0, 0.9d0) par%alpha = readkey_dbl ('params.txt','alpha', 1.0d0, 0.5d0, 2.0d0) par%delta = readkey_dbl ('params.txt','delta', 0.0d0, 0.0d0, 1.0d0) par%n = readkey_dbl ('params.txt','n', 5.0d0, 5.0d0, 20.0d0) par%rho = readkey_dbl ('params.txt','rho', 1025.0d0, 1000.0d0, 1040.0d0) par%g = readkey_dbl ('params.txt','g', 9.81d0, 9.7d0, 9.9d0) par%rhog8 = 1.0d0/8.0d0*par%rho*par%g; par%Emean = par%rhog8*par%Hrms**2 par%thetamin = readkey_dbl ('params.txt','thetamin', -80.d0, -180.d0, 180.d0) par%thetamax = readkey_dbl ('params.txt','thetamax', 80.d0, -180.d0, 180.d0) par%dtheta = readkey_dbl ('params.txt','dtheta', 10.d0, 0.1d0, 20.d0) par%thetanaut= readkey_int ('params.txt','thetanaut', 0, 0, 1) par%wci = readkey_int ('params.txt','wci', 0, 0, 1) par%hwci = readkey_dbl ('params.txt','hwci', 0.01d0, 0.001d0, 1.d0) par%break = readkey_int ('params.txt','break', 3, 1, 3) par%roller = readkey_int ('params.txt','roller', 1, 0, 1) par%beta = readkey_dbl ('params.txt','beta', 0.15d0, 0.05d0, 0.3d0) par%taper = readkey_dbl ('params.txt','taper', 100.d0, 0.0d0, 1000.d0) par%refl = readkey_int ('params.txt','refl', 0, 0, 1) par%nspr = readkey_int ('params.txt','nspr', 0, 0, 1) end subroutine subroutine flow_input(par) type(parameters) :: par real*8, external :: readkey_dbl integer,external :: readkey_int par%cf = readkey_dbl ('params.txt','cf', 3.d-3, 0.d0, 0.1d0) par%C = readkey_dbl ('params.txt','C', sqrt(par%g/par%cf), 20.d0, 100.d0) par%cf = par%g/par%C**2 par%eps = readkey_dbl ('params.txt','eps', 0.1d0, 0.001d0, 1.d0) par%umin = readkey_dbl ('params.txt','umin', 0.1d0, 0.001d0, 5.d0) par%zs01 = readkey_dbl ('params.txt','zs0', 0.0d0, -5.d0, 5.d0) par%tideloc = readkey_int ('params.txt','tideloc', 0, 0, 4) par%paulrevere = readkey_int ('params.txt','paulrevere', 0, 0, 1) par%tidelen = readkey_int ('params.txt','tidelen', 0, 0, 1000000) par%tstart = readkey_dbl ('params.txt','tstart', 1.d0, 0.d0,1000000.d0) par%tint = readkey_dbl ('params.txt','tint', 1.d0, .01d0, 100000.d0) ! Robert par%tintg = readkey_dbl ('params.txt','tintg', par%tint, .01d0, 100000.d0) ! Robert par%tintp = readkey_dbl ('params.txt','tintp',par%tintg, .01d0, 100000.d0) ! Robert par%tintm = readkey_dbl ('params.txt','tintm',par%tintg, 1.d0, par%tstop) ! Robert par%tint = min(par%tintg,par%tintp,par%tintm) ! Robert ! Robert par%tstop = readkey_dbl ('params.txt','tstop', 2000.d0, 1.d0,1000000.d0) par%fcutoff = readkey_dbl ('params.txt','fcutoff', 0.d0, 0.d0, 40.d0) par%sprdthr = readkey_dbl ('params.txt','sprdthr', 0.08d0, 0.d0, 1.d0) par%carspan = readkey_int ('params.txt','carspan',0, 0, 1) par%rugauge = readkey_int ('params.txt','rugauge',0, 0, 1) !par%ntout=nint((par%tstop-par%tstart)/par%tint)+1 par%CFL = readkey_dbl ('params.txt','CFL', 0.2d0, 0.1d0, 0.9d0) par%front = readkey_int ('params.txt','front', 1, 0, 1) par%ARC = readkey_int ('params.txt','ARC', 1, 0, 1) par%order = readkey_dbl ('params.txt','order', 2.d0, 1.d0, 2.d0) par%left = readkey_int ('params.txt','left', 0, 0, 1) par%right = readkey_int ('params.txt','right', 0, 0, 1) par%back = readkey_int ('params.txt','back', 2, 0, 2) par%nuh = readkey_dbl ('params.txt','nuh', 0.5d0, 0.0d0, 1.0d0) par%nuhfac = readkey_dbl ('params.txt','nuhfac', 0.0d0, 0.0d0, 1.0d0) par%rhoa = readkey_dbl ('params.txt','rhoa', 1.25d0, 1.0d0, 2.0d0) par%Cd = readkey_dbl ('params.txt','Cd', 0.002d0, 0.0001d0, 0.01d0) par%windv = readkey_dbl ('params.txt','windv', 0.0d0, 0.0d0, 200.0d0) par%windth = readkey_dbl ('params.txt','windth', 90.0d0, -180.0d0, 180.0d0) par%epsi = readkey_dbl ('params.txt','epsi', 0.d0, 0.d0, 1.d0) par%nonh = readkey_int ('params.txt','nonh', 0, 0, 1) par%nuhv = readkey_dbl ('params.txt','nuhv', 0.d0, 0.d0, 20.d0) par%lat = readkey_dbl ('params.txt','lat', 53.d0, 0.d0, 90.d0) par%wearth = readkey_dbl ('params.txt','omega', 1.d0/24.d0, 0.d0, 1.d0) ! Convert from Nautical to cartesian convention par%windth=(270.d0-par%windth)*par%px/180.d0 par%lat = par%lat*par%px/180.d0 par%wearth = par%px*par%wearth/1800.d0 par%fc = 2.d0*par%wearth*sin(par%lat) end subroutine subroutine sed_input(par) type(parameters) :: par real*8, external :: readkey_dbl integer,external :: readkey_int par%dico = readkey_dbl ('params.txt','dico', 1.d0, 0.d0, 10.d0) par%ngd = readkey_int ('params.txt','ngd', 1, 1, 2) par%nd = readkey_int ('params.txt','nd', 1, 1, 20) par%dzg = readkey_dbl ('params.txt','dzg', 0.1d0, 0.01d0, 1.d0) par%D501 = readkey_dbl ('params.txt','D50', 0.0002d0, 0.00005d0, 0.001d0) par%D901 = readkey_dbl ('params.txt','D90', 0.0003d0, 0.00005d0, 0.001d0) par%D502 = readkey_dbl ('params.txt','D502', 0.0000d0, 0.0000d0, 0.001d0) par%D902 = readkey_dbl ('params.txt','D902', 0.0000d0, 0.0000d0, 0.001d0) par%D503 = readkey_dbl ('params.txt','D503', 0.0000d0, 0.0000d0, 0.001d0) par%D903 = readkey_dbl ('params.txt','D903', 0.0000d0, 0.0000d0, 0.001d0) par%sedcal1 = readkey_dbl ('params.txt','sedcal1', 1.0000d0, 0.0000d0, 10.00d0) par%sedcal2 = readkey_dbl ('params.txt','sedcal2', 1.0000d0, 0.0000d0, 10.00d0) par%sedcal3 = readkey_dbl ('params.txt','sedcal3', 1.0000d0, 0.0000d0, 10.00d0) par%rhos = readkey_dbl ('params.txt','rhos', 2650d0, 2400.d0, 2800.d0) par%morfac = readkey_dbl ('params.txt','morfac', 0.0d0, 0.d0, 1000.d0) par%morstart = readkey_dbl ('params.txt','morstart',120.d0, 0.d0, 10000.d0) par%wetslp = readkey_dbl ('params.txt','wetslp', 0.3d0, 0.1d0, 1.d0) par%dryslp = readkey_dbl ('params.txt','dryslp', 1.0d0, 0.1d0, 2.d0) par%por = readkey_dbl ('params.txt','por', 0.4d0, 0.3d0, 0.5d0) par%hswitch = readkey_dbl ('params.txt','hswitch',0.1d0, 0.01d0, 1.0d0) par%z0 = readkey_dbl ('params.txt','z0 ',0.006d0, 0.0001d0, 0.05d0) par%facsl = readkey_dbl ('params.txt','facsl ',0.00d0, 0.00d0, 1.6d0) par%struct = readkey_int ('params.txt','struct ',0, 0, 1) par%form = readkey_int ('params.txt','form', 1, 1, 3) par%smax = readkey_dbl ('params.txt','smax', 99999.d0, 0.d0, 99999.d0) end subroutine end module