splash/000755 000770 000000 00000000000 12612006634 012750 5ustar00dpricewheel000000 000000 splash/.gitignore000644 000770 000000 00000000261 11477315362 014750 0ustar00dpricewheel000000 000000 *.mod *.o ?splash docs/splash.aux docs/splash.log docs/splash.toc docs/splash.out docs/splash.blg docs/html/*.png docs/html/*.html docs/html/splash.css bin ref *otherendian.f90 splash/bin/000755 000770 000000 00000000000 12612006626 013521 5ustar00dpricewheel000000 000000 splash/build/000755 000770 000000 00000000000 12612006625 014047 5ustar00dpricewheel000000 000000 splash/ChangeLog000644 000770 000000 00001601272 12612006634 014533 0ustar00dpricewheel000000 000000 2015-10-21 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.6.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5272 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-21 dprice * src/splash.f90: v2.6.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5271 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-21 dprice * src/timestepping.f90: bug fix with axes labelling decisions git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5270 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-20 dprice * src/read_data_ndspmhd.f90: (ndspmhd) label del2v and grad divv correctly in ndspmhd output git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5269 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-20 dprice * src/plotstep.f90: less verbose log output when plotting cross sections git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5268 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-20 dprice * src/menu.f90: do not allow rendering of cross-sections in non-cartesian coords (not implemented) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5267 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-20 dprice * src/read_data_pbob.f90, src/read_data_pbob_utils.c: (pbob) updated pbob data read for new format; reads all time slices git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5266 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-14 dprice * src/discplot.f90, src/plotstep.f90: bug fix with Toomre Q calculation if physical units set git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5265 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-14 dprice * src/read_data_sphNG.f90: BUG FIX with sphNG data read if precision of density array changed; now allows density and h to be any precision in any block if using tagged format (thanks to Ben Lewis) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5264 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-10-14 dprice * build/Makefile: updated X11 libs so compiles out-of-box on Mac git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5263 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-09-10 dprice * src/exact.f90: (exact_shock) automatically reads shock parameters from phantom .setup file if it exists git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5262 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-09-07 dprice * src/read_data_pbob.f90, src/read_data_pbob_utils.c: assume 2D not 3D in pbob read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5261 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-09-07 dprice * build/Makefile, src/read_data_pbob.f90, src/read_data_pbob_utils.c: added PBOB data read for David Brown git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5260 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-09-04 dprice * src/plotstep.f90: debugging statements removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5259 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-09-04 dprice * src/exact.f90, src/plotstep.f90: (exact) residual and error calculation only uses particles actually plotted git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5258 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-08-25 dprice * build/Makefile, src/dataread_utils.f90, src/read_data_falcON_hdf5.f90, src/read_data_falcON_hdf5_utils.cc: implemented falcON hdf5 data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5257 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-08-17 dprice * src/options_powerspec.f90: bug fix with previous commit; use 1/lambda not 2*pi/lambda for default frequency values git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5256 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-08-17 dprice * src/options_powerspec.f90, src/plotstep.f90: powerspectrum takes min, max freq as options; less confusing git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5255 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-08-04 dprice * src/analysis.f90: added splash calc delta option; computes 0.5*(max-min)/mean as function of time git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5254 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-31 dprice * src/read_data_sphNG.f90: BUG FIX with nunknown causing seg fault with mixed Phantom/sphNG data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5253 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-31 dprice * src/options_render.f90: allow up to 100000 pixels in x git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5252 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-23 dprice * src/exact.f90, src/exact_sedov.f90: bug fix: gamma can now be set manually for exact solutions (thanks to Tim Waters) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5251 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-21 dprice * src/plotstep.f90: bug fix with adaptive plot limits (after previous bug fix) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5250 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-21 dprice * src/read_data_sphNG.f90: BUG FIX with bulge particle types in phantom read (thanks to Alex Pettitt) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5249 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-16 dprice * src/read_data_sphNG.f90: BUG FIX with SSPLASH_RESET_CM with tagged data format (thanks to Chris Nixon) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5248 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-16 dprice * src/splash.f90: version info updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5247 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-16 dprice * src/options_page.f90: bug fix: tracking offset limits now saved to splash.defaults (thanks to Chris Nixon for reporting) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5246 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-16 dprice * src/timestepping.f90: bug fix with adaptive plot limits + multiple plots per page git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5245 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-16 dprice * src/plotstep.f90: BUG FIX with adaptive plot limits + multiple steps-per-page (thanks to Chris Nixon) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5244 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-07-16 dprice * build/Makefile: removed obsolete -i_dynamic from SYSTEM=ifort git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5243 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-06-20 dprice * src/read_data_ascii.f90: BUG FIX with out-of-bounds error if particle type read from ascii file (thanks to Carrie Elliott) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5242 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-06-05 dprice * src/calc_quantities.f90: dust-to-gas ratio added to list of pre-calculated quantities git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5241 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-06-04 dprice * src/read_data_sphNG.f90: recognises dustfrac in phantom output git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5240 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-05-27 dprice * src/write_sphdata.f90: splash to ascii preserves precision of data if splash compiled in double precision git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5239 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-05-25 dprice * src/write_data_phantom.f90: bug fix with checking of unequal masses in splash to phantom git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5238 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-05-03 dprice * src/exact.f90: bug fix with read of Kdrag from ndspmhd input file for dustywave exact solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5237 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-05-03 dprice * src/splash.f90: better error checking on command line options git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5236 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-27 dprice * src/plotstep.f90, src/setpage.f90: bug fix with axes drawing decisions if last row but page not complete git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5235 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-27 dprice * src/exact_torus.f90: minor update to torus exact solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5234 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-23 dprice * install-cairo.sh: typo in install-cairo script fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5233 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-23 dprice * src/options_particleplots.f90: bug fix with linestyle prompt for line joining particles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5232 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-20 dprice * src/read_data_ascii.f90: seg fault fixed in ascii read with particle types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5231 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-17 dprice * install-cairo.sh: updated install-cairo script to latest releases; also installs unxz automatically if tar Jxz fails git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5230 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-14 dprice * src/read_data_ascii.f90: ascii data read recognises different particle types if type column is labelled appropriately (thanks to Juan Pablo Farias) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5229 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-04-01 dprice * docs/splash.tex: updated docs on toroidal coordinate transforms git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5228 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-03-31 dprice * src/geometry.f90: (geometry) formatting fixes from Phantom; less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5227 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-03-31 dprice * src/geometry.f90: (geometry) BUG FIX with theta transformation in toroidal coordinates git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5226 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-03-27 dprice * src/read_data_silo_utils.c: added DBClose to read routine for silo data git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5225 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-03-27 dprice * src/geometry.f90: bug fix with labels in toroidal geometry git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5224 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-03-27 dprice * build/Makefile, src/read_data_silo.f90, src/read_data_silo_utils.c: implemented .silo data read (requires SILO libraries) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5223 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-03-24 dprice * src/read_data_gadget_hdf5_utils.c: BUG FIX with gadget-hdf5 reader after first step (thanks to Alex Pettitt) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5222 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-02-06 dprice * src/geomutils.f90: bug fix with dissappearing units labels in cylindrical/spherical coords (thanks to J-F Gonzalez) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5221 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-02-04 dprice * src/exact_shock.f90: bug fix in shock tube solution if density ratio is large (thanks to M. Hutchison) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5220 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.5.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5219 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * src/splash.f90: v2.5.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5218 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * src/globaldata.f90, src/splash.f90: v2.5.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5217 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * build/Makefile: GIZADIR->GIZA_DIR git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5216 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * src/get_data.f90: turn on particle colours automatically if no h/rho read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5215 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * src/menu.f90: allow rendering at all times if using colours not pixels git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5214 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * src/menu.f90: better default options if x,y,z not in first 3 columns git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5213 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-28 dprice * src/plotstep.f90: bug fix with out-of-bounds error if x,y,z not in first 3 columns git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5212 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-13 dprice * src/read_data_ndspmhd.f90: better labelling of dust fraction git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5211 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-13 dprice * src/menu.f90: minor bug fix with printout of render limits if rendered previously; also y=x avoided in prompt default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5210 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-08 dprice * src/exact.f90, src/geomutils.f90: verboseness reduced during exact solution plotting and coordinate system changes git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5209 cab04810-efc7-4a10-8ecf-f366c833a2ad 2015-01-06 dprice * src/menu.f90: minor change to comments git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5208 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-12-16 dprice * src/read_data_sphNG.f90: BUG FIX reading particle masses from stars/dark matter in phantom git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5207 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-12-10 dprice * src/read_data_amuse_hdf5.f90: (amuse) amuse-hdf5 read correctly recognises h_smooth git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5206 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-12-10 dprice * src/read_data_sphNG.f90: (ssplash) phantom read handles star/dark matter particle types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5205 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-12-10 dprice * src/read_data_sphNG.f90: bug fix with labelling of HI abundance in Phantom/sphNG read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5204 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-12-10 dprice * src/get_data.f90: added sanity check on size of dat allocation during data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5203 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-12-03 dprice * src/read_data_amuse_hdf5.f90: bug fix with array bounds error in amuse-hdf5 if h not read (thanks to Alessandro Atrani) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5202 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-11 dprice * src/legends.f90: improved line style legend git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5201 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-11 dprice * src/options_page.f90, src/plotlib_giza.f90: allow up to 6 line styles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5200 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-11 dprice * src/convert_grid.f90: splash to grid: range restrictions are now applied git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5199 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-07 dprice * src/plotstep.f90: bug fix with slice settings used in vector plots in cross sections when no h is present git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5198 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-07 dprice * src/interpolate_vec.f90, src/plotstep.f90: vector plotting without h now works in 2D and for cross sections git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5197 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-06 dprice * src/interpolate_vec.f90, src/menu.f90, src/plotstep.f90: implemented plotting of vectors when smoothing length not read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5196 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-06 dprice * src/options_page.f90: 5K display size added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5195 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-11-06 dprice * scripts/movie.sh: higher quality movie options in movie.sh by default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5194 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-09-08 dprice * src/defaults.f90: bug fix with formatting overflow in labeltype (thanks to S. Toupin) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5193 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-25 dprice * src/options_particleplots.f90, src/particleplot.f90: added option to change error bar style git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5192 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-25 dprice * src/options_particleplots.f90: bug fix with selection of column for error bars git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5191 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-22 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.5.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5190 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-22 dprice * src/splash.f90: v2.5.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5189 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-22 dprice * src/colourbar.f90, src/options_render.f90: added preset options for floating colour bar (top left/top right/bottom left/bottom right) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5188 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-20 dprice * src/read_data_sphNG.f90, src/splash.f90: sphNG read handles Phantom dumps in tagged format also git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5187 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-08 dprice * src/shapes.f90: added opacity property to shapes; can now adjust each shape opacity separately git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5186 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-08 dprice * src/exact_ringspread.f90: BUG FIX with ring spreading exact solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5185 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-08 dprice * src/read_data_ascii.f90: BUG FIX with incorrect time from first line of ascii files if string too long git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5184 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * src/geometry.f90: compiler warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5183 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * src/analysis.f90: BUG FIX with splash calc: now applies coordinate transformations to data git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5182 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * src/exact_Cshock.f90: spurious comma removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5181 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * src/asciiutils.f90, src/exact.f90: bug fix: option to not apply units to exact solution from file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5180 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * build/Makefile, src/asciiutils.f90, src/read_data_amuse_hdf5.f90, src/read_data_amuse_hdf5_utils.c: added AMUSE HDF5 data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5179 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * src/read_data_gadget.f90: bug fixes with reading gadget files if splash is compiled in double precision git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5178 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * scripts/movie.sh: movie script uses slower frame rate git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5177 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-08-06 dprice * src/splash.f90: updated version info git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5176 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-07-08 dprice * src/read_data_sphNG.f90: complete rewrite of sphNG/Phantom read, added support for tagged data format git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5175 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-07-08 dprice * src/geomutils.f90: use _{} instead of \d in alternative coordinate system labels git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5174 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-07-02 dprice * build/Makefile: splash builds with openMP by default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5173 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-17 dprice * src/labels.f90: bug fix with calculated quantities: now ignores _ and \ when recognising labels git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5172 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-17 dprice * src/calc_quantities.f90: bug fix with plasma beta and T_rad in default calculated quantities list git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5171 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-17 dprice * src/options_page.f90: cave-2 resolution corrected git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5170 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-17 dprice * scripts/movie.sh: added movie.sh to make movies from splash images with ffmpeg git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5169 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-16 dprice * src/interactive.f90: bug fix with possible use of uninitialised variables git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5168 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-16 dprice * src/interactive.f90: seg fault in interactive mode (hopefully) fixed (npts=1 by default) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5167 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-16 dprice * src/read_data_sphNG.f90: BUG FIX with seg fault in sphNG/Phantom read if mhd+sinks git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5166 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-06-05 dprice * src/options_xsecrotate.f90, src/plotstep.f90: screen position adjusts during animation sequence adjustment of z observer position git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5165 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-28 dprice * src/exact_Cshock.f90: updated C-shock, now gives correct solution for Choi test (thanks to J. Wurster) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5164 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-28 dprice * src/particleplot.f90: BUG FIX with fast particle plotting with multiple types if particles on top of each other git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5163 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-28 dprice * src/interpolate3D_projection.F90: unused variable warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5162 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-20 dprice * src/exact_Cshock.f90: updated C-shock solution to plot vx, vy for neutrals git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5161 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-19 dprice * src/exact.f90, src/exact_dustywaves.f90: L2 and L1 errors computed for each solution in case where multiple exact solutions are plotted; also dustywave now standalone routine, does not do plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5160 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-16 dprice * src/exact.f90: computes L1, L2 errors only if 1 exact solution file; minor formatting changes git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5159 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-14 dprice * src/plotstep.f90, src/setpage.f90: bug fix with labelling of x axis if last plot on page and nplots < ndown git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5158 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-12 dprice * src/menu.f90: added instant-multiplot option; can now set up and plot a multiplot by specifying multiple columns on the command line for the y axis git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5157 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-12 dprice * src/menu.f90: removed obsolete labelled format statements git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5156 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-09 dprice * src/exact.f90: can now read and plot exact solutions from multiple files on the same plot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5155 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-09 dprice * src/exact_fromfile.f90: minor improvement to formatting of info line during exact_fromfile plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5154 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-09 dprice * src/calc_quantities.f90: calc quantities less verbose; obsolete function removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5153 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-06 dprice * src/parsetext.f90: bug fix with double minus sign if time is negative in legend git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5152 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-06 dprice * build/Makefile: debugging flags for gfortran does not catch fpes git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5151 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-05-06 dprice * src/interactive.f90, src/limits.f90, src/plotstep.f90: better handling of Infs and NaNs in plot limits git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5150 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-28 dprice * src/menu.f90: obsolete powerspectrum plot option hidden by default (use SPLASH_TURB=yes to get this option) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5149 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-28 dprice * src/read_data_ndspmhd.f90: bug fix with NSPLASH_BARYCENTRIC env. variable in ndspmhd data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5148 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-28 dprice * src/write_sphdata.f90: splash to phantom only writes gas particles but does do something if ntypes > 1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5147 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-28 dprice * src/write_data_phantom.f90: can write phantom mhd dumps using splash to phantom git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5146 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-11 dprice * src/exact_dustywaves.f90: minor cleanup of dustywave solution; avoids too many line continuations; now standards-conforming; also less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5145 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-11 dprice * src/read_data_ndspmhd.f90: less verbose header printing in ndspmhd read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5144 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-02 dprice * src/exact_Cshock.f90: C-shock solution: bug fix with shock width; vs calculated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5143 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-01 dprice * src/read_data_sphNG.f90: BUG FIX with seg fault reading phantom small dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5142 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-01 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.4.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5141 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-01 dprice * src/exact.f90, src/exact_Cshock.f90: added more C-shock solutions git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5140 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-01 dprice * docs/version: version v_2_4_1--01-04-14 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5139 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-04-01 dprice * src/splash.f90: v2.4.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5138 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-03-31 dprice * src/exact_Cshock.f90, src/read_data_ndspmhd.f90: time printing does not overflow git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5137 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-03-31 dprice * src/read_data_sphNG.f90: can read single precision Phantom/sphNG files in double precision splash git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5136 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-03-18 dprice * src/allocate.f90, src/analysis.f90, src/globaldata.f90, src/timestepping.f90: splash calc now gives time=0 in output if time not read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5135 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-03-18 dprice * src/interpolation.f90: BUG FIX with setting weights for dark matter rendering (thanks to Phil Sutton) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5134 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-03-11 dprice * src/splash.f90: updated version info git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5133 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-03-11 dprice * src/adjust_data.f90, src/exact.f90, src/exact_rochelobe.f90, src/partutils.f90, src/plotstep.f90: vastly improved Roche-lobe plotting; ability to track first two sinks git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5132 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-03-11 dprice * src/discplot.f90: number of bins used for surface density/toomre Q plots depends on number of particles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5131 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-25 dprice * src/splash.f90: bumped version number git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5130 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-25 dprice * src/read_data_sphNG.f90: BUG FIX with reading sink particle velocities from phantom data (thanks to F. Dai & S. Facchini) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5129 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-25 dprice * src/fieldlines.f90, src/write_data_gadget.f90: compiler warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5128 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-25 dprice * src/read_data_mbate.f90, src/read_data_oilonwater.f90: broken builds fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5127 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-25 dprice * src/asciiutils.f90: newunit= removed; breaks support for gfortran v4.4 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5126 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-21 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.4.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5125 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-21 dprice * src/splash.f90: version info for 2.4.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5124 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-21 dprice * docs/splash.tex: updated docs with barycentric stuff git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5123 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-21 dprice * src/read_data_ndspmhd.f90: onefluid->fake two fluids done by default; now use NSPLASH_BARYCENTRIC=yes to turn this off git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5122 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-21 dprice * src/asciiutils.f90, src/exact.f90, src/exact_sedov.f90: more robust way of getting line containing Kdrag for dustywave exact solution; also sedov exact solution plots circle again git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5121 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-12 dprice * src/exact.f90, src/exact_Cshock.f90: allow mach numbers to be input parameters to C-shock exact solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5120 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-12 dprice * build/Makefile: exact_Cshock added to build git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5119 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-12 dprice * src/exact.f90, src/exact_Cshock.f90: C-shock exact solution added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5118 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-12 dprice * src/exact.f90, src/exact_shock.f90: added solution for deltav and dustfrac in shock tube solution with no drag git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5117 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-02-11 dprice * src/exact.f90, src/exact_polytrope.f90: polytrope exact solution works with arbitrary mass, polyk git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5116 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-01-24 dprice * src/read_data_sphNG.f90: further bug fix with accreted particles appearing in pngs from phantom dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5115 cab04810-efc7-4a10-8ecf-f366c833a2ad 2014-01-24 dprice * src/labels.f90: bug fix with overflow in print_types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5114 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-12-10 dprice * src/read_data_ascii.f90: bug fix with seg fault if file cannot be opened in ascii read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5113 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-12-03 dprice * src/exact_shock.f90: gamma assumed to be 5/3 if < 1 in shock tube exact solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5112 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-27 dprice * src/read_data_ndspmhd.f90: labelling of deltav fixed -> \Deltav git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5111 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-27 dprice * src/read_data_ndspmhd.f90: bug fix in fake two-fluid stuff with quantities not set to zero git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5110 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-18 dprice * src/convert_grid.f90: bug fix with interface to convert_grid after render sink stuff git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5109 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-14 dprice * src/plotlib_giza.f90: giza interface updated to work with giza v0.8 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5108 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-14 dprice * src/shapes.f90: year updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5107 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-14 dprice * src/splash.f90: version history updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5106 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-14 dprice * src/splash.f90: version updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5105 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-14 dprice * src/options_page.f90: whitespace removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5104 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-14 dprice * src/interpolate3D_opacity.f90, src/interpolation.f90, src/options_xsecrotate.f90, src/plotstep.f90: added option to include sink particles in opacity rendering; hiding them behind dense gas git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5103 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * src/options_page.f90: added CAVE-2 page size option (27000 x 3000); also better defaults for custom page sizes, min is 1x1 in any units git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5102 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * src/legends.f90, src/options_page.f90, src/parsetext.f90: can now use functions in time legend, e.g. Time = %(t + 1000), %(t*100) etc. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5101 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * src/prompting.f90: added warning for strings that will be truncated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5100 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * build/Makefile, src/asciiutils.f90, src/parsetext.f90: added parsetext module to handle parsing of arbitrary functions in text strings git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5099 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * src/read_data_ndspmhd.f90: unused module variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5098 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * src/analysis.f90: compiler warnings fixed with real=0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5097 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * Makefile: added phony targets for all subdirectories git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5096 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-13 dprice * build/Makefile: bug fix with compilation of test modules git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5095 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-12 dprice * build/Makefile, src/read_data_maddison.f90: added data read for Sarah Maddison/Mark Hutchison code git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5094 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-11 dprice * docs/version_history, docs/version_history_tex.tex: version 2.3.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5093 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-11 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.3.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5092 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-11 dprice * src/splash.f90: v2.3.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5091 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-10 dprice * src/particleplot.f90: bug fix with previous commit: only do fast particle plotting if more than 100 particles of a given type git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5090 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-10 dprice * src/particleplot.f90: fast particle plotting used for cross-section + 3D perspective particle plots; further code tidying in particleplot routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5089 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-11-06 dprice * src/interpolation.f90: BUG FIX with out-of-bounds error in splash to grid if multiple particle types but not rendering additional types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5088 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * src/read_data_sphNG.f90: BUG FIX with mapping of phantom types to splash types, fixes problem with identifying boundary particles; also removed obsolete SSPLASH_CENTRE_ON_SINK option git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5087 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * src/sort.f90: sort routine moved to separate module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5086 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * build/Makefile, src/fieldlines.f90, src/interpolate3D_opacity.f90: sort routine moved to separate module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5085 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * src/labels.f90, src/read_data_sphNG.f90: phantom data read handles boundary particles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5084 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * src/particleplot.f90: further variable renames to simplify/shorten particleplot routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5083 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * src/particleplot.f90: further cleanups of particleplot routine; less repeated code git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5082 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * src/particleplot.f90, src/plotstep.f90: compiler warning fixed with unused dummy variables in particleplot routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5081 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-29 dprice * src/particleplot.f90: minor cleanups of particle plotting routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5080 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-23 dprice * src/adjust_data.f90: minor comment removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5079 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-23 dprice * src/adjust_data.f90: SPLASH_COROTATE: rotation of particle velocities implemented, seems to work git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5078 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-23 dprice * src/adjust_data.f90, src/partutils.f90: SPLASH_COROTATE setting implemented; works in conjunction with SPLASH_CENTRE_ON_SINK also git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5077 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-22 dprice * src/read_data_sphNG.f90: bug fix with printing of number of unknown/dead particles; also error->warning for iphase not present git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5076 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-22 dprice * src/read_data_sphNG.f90: BUG FIX with dead/accreted particles appearing in plots after partial data read (ssplash) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5075 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-22 dprice * src/adjust_data.f90, src/partutils.f90: cleaned up adjust_data routine to use utility functions for finding sink locations git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5074 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-22 dprice * build/Makefile, src/get_data.f90, src/labels.f90: adjust_data routine moved into separate module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5073 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-14 dprice * src/units.f90: bug fix with unit settings for time prompting to set coordinates also git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5072 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-10-04 dprice * src/get_data.f90, src/read_data_ascii.f90: verboseness of ascii read reduced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5071 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-28 dprice * src/plotstep.f90: pixel map filenames from -o ascii now clearly indicate whether logged or not git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5070 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-28 dprice * src/asciiutils.f90: number of the beast bug: too much use of 666 leading to incorrect ncolumns from pixel maps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5069 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-28 dprice * src/analysis.f90: bug fix with 0/0 in splash calc ratio: now gives 0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5068 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-28 dprice * src/menu.f90: setting up a multiplot only changes nacross, ndown if mod(nacross*ndown,nplot)=0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5067 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-28 dprice * src/plotstep.f90: bug fix with handling of log(0) in -readpix pixel map plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5066 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-28 dprice * src/calc_quantities.f90: plasma \beta (giza) not plasma \gb (pgplot) in example quantities git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5065 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-28 dprice * src/calc_quantities.f90: bug fix with formatting of example calc quantities git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5064 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-23 dprice * src/plotstep.f90: BUG with previous error check fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5063 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-23 dprice * src/plotstep.f90, src/splash.f90: do not continue with splash if X11 device not opened git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5062 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-08 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.3.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5061 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-08 dprice * src/splash.f90: v2.3.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5060 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-08 dprice * src/fieldlines.f90: 3D vec plot routine restores original line width on exit git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5059 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-08-07 dprice * src/kernels.f90: BUG FIX/workaround for gfortran 4.8 issue with pure attribute on procedure pointer git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5058 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-28 dprice * src/fieldlines.f90: 3D field line plotting much improved git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5057 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-25 dprice * src/prompting.f90: prompt prints exponentials with scientific notation 1.e8 instead of 0.1e9 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5056 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-25 dprice * src/colourbar.f90: floating/inset colour bars now same width as usual colour bars git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5055 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-25 dprice * src/particleplot.f90: error bars use translucent shading by default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5054 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/plotstep.f90: hacked label only if icolpixmap=irender git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5053 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/shapes.f90: warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5052 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/plotstep.f90: BUG FIX with z not being read during partial data read for multiplot+rotation git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5051 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/plotstep.f90: hack: use z and label pixmap for Bpol/Bphi plots; bug fix with tiling + pixmap plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5050 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/analysis.f90: minor bug fixes with splash calc ratio git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5049 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/menu.f90: x column is 1 for pixmap plots by default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5048 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/splash.f90: version incremented git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5047 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-21 dprice * src/asciiutils.f90: | deleted from safe filenames git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5046 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-19 dprice * src/geomutils.f90, src/read_data_sphNG.f90: moved integrate_labels routine into labels module; required moving unitslabel and labelzintegration into this module also git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5045 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-19 dprice * src/asciiutils.f90, src/calc_quantities.f90, src/get_data.f90, src/labels.f90, src/options_data.f90, src/plotstep.f90, src/read_data_dragon.f90, src/read_data_seren.f90, src/read_data_sro.f90, src/units.f90, src/write_sphdata.f90: moved integrate_labels routine into labels module; required moving unitslabel and labelzintegration into this module also git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5044 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-19 dprice * src/menu.f90: bug fix with out-of-bounds error for 2D pixmap plots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5043 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-19 dprice * src/calc_quantities.f90, src/labels.f90, src/plotstep.f90, src/write_pixmap.f90: major improvements to read/write of pixel maps (ascii format) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5042 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/globaldata.f90: labels and part_utils modules moved into separate files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5041 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/asciiutils.f90: safename function improved; removes brackets and other stuff git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5040 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * build/Makefile: updated makefile with new files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5039 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/labels.f90, src/partutils.f90: labels and part_utils modules moved into separate files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5038 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/fieldlines.f90: increased length of lines in 3D field line plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5037 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/analysis.f90: added calc ratio option to compute ratio between two or more files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5036 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/get_data.f90: files are allowed to contain more than 64 columns for the purpose of calc/analysis routines git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5035 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/convert.f90: added calc ratio option to compute ratio between two or more files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5034 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/write_pixmap.f90: unused variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5033 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/read_data_ascii.f90: end-of-file error message toned down git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5032 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/asciiutils.f90: allow recognition of up to 5000 chars/1000 reals when determining number of columns in ascii files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5031 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/plotstep.f90: device resolution printout silenced (unless debug mode turned on) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5030 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/write_griddata.F90: gridtest output format now gridascii2; now documented git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5029 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/plotstep.f90: exact solution panel selection uses new ipanelselect routine; less repeated code git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5028 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/write_pixmap.f90: ppm and ascii pixmap output uses tagline from filenames module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5027 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/read_data_sphNG.f90: bug fix with labelling of eta git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5026 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/asciiutils.f90, src/write_pixmap.f90: splash can now read back its own pixmaps (produced via -o ascii) via the -readpix option git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5025 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/get_data.f90: better info in print statement git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5024 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/interactive.f90: bug fix with saving vector plot limits in interactive mode + multiple plots per page git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5023 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/get_data.f90, src/read_data_sphNG.f90: verbosity reduced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5022 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-18 dprice * src/units.f90: formatting in print statement git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5021 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-17 dprice * src/interpolate3D_projection.F90: less verbose printing of interpolation; prints wall time, not cpu time git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5020 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-17 dprice * src/plotstep.f90: less verbose printing of rotation angles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5019 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-17 dprice * src/shapes.f90: shape printing less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5018 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/limits.f90: less verbose read of limits file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5017 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/read_data_sphNG.f90: sphNG+MPI read much less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5016 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/calc_quantities.f90, src/get_data.f90, src/limits.f90: verboseness reduced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5015 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/units.f90: verboseness reduced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5014 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * LICENCE, LICENSE: LICENSE->LICENCE git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5013 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/kernels.f90, src/read_data_sphNG.f90, src/splash.f90: verboseness reduced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5012 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/defaults.f90, src/splash.f90: welcome message less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5011 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/splash.f90: updated version info git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5010 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-14 dprice * src/timing.f90: timing info does not include (=blah s) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5009 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * src/plotstep.f90, src/shapes.f90: text shapes can include time git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5008 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * src/legends.f90, src/options_page.f90, src/plotstep.f90: can adjust number of significant figures in time legend git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5007 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * src/legends.f90, src/plotstep.f90: time legend on top of vector plots drawn with translucent box git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5006 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * src/legends.f90, src/options_page.f90, src/plotstep.f90: added ability to customise position of time and units labels in time legend git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5005 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * build/Makefile, src/read_data_sphysics.f90: preliminaries added for sphysics data read (placeholder routines only at present) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5004 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * src/plotstep.f90: debugging line removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5003 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * build/Makefile, src/legends.f90, src/options_vecplot.f90, src/plotstep.f90, src/render.f90: added ability to select panel for vector plot legend git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5002 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * src/fieldlines.f90, src/rotate.f90: year updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5001 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-06-12 dprice * src/exact_mhdshock_other.f90: obsolete file removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5000 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-13 dprice * src/read_data_jjm.f90: changes to read jjm format from .mve files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4997 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-10 dprice * docs/version_history, docs/version_history_tex.tex: version 2.2.2 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4996 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-10 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.2.2 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4995 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-10 dprice * src/splash.f90: v2.2.2 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4994 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-10 dprice * docs/splash.tex: updated docs for v2.2.2 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4993 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-09 dprice * src/discplot.f90, src/globaldata.f90, src/plotstep.f90, src/read_data_vanaverbeke.f90: Toomre Q plots use actual speed of sound if read from dump file (if ispsound=column containing sound speed) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4992 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-09 dprice * src/exact.f90: unused variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4991 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-09 dprice * src/calc_quantities.f90: unused variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4990 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-01 dprice * src/calc_quantities.f90, src/globaldata.f90, src/read_data_ndspmhd.f90: one fluid stuff uses dust fraction instead of dust-to-gas ratio git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4980 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-01 dprice * src/setpage.f90: bug fix preventing compilation with gfortran 4.6 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4979 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-01 dprice * src/options_xsecrotate.f90: brightness correction NEVER applied for opacity-rendering (until I fix it) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4978 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-05-01 dprice * src/read_data_sphNG.f90: sphNG read a bit less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4977 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-23 dprice * build/Makefile, src/plotstep.f90, src/setpage.f90: bug fix with iaxis=4 (re-scaled y axis) if transformations applied; now works OK git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4974 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-23 dprice * build/Makefile: added extra -lX11 flag to link step; seems to solve issues with XFlush+Ubuntu git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4973 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-23 dprice * src/interactive.f90: preliminary work on interactive switch-to-movie mode (commented out) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4972 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-22 dprice * src/options_page.f90, src/plotstep.f90, src/setpage.f90: added alternative y-axis as option in axes menu git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4968 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-22 dprice * src/setpage.f90: bug fix with length of alt y label git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4967 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-22 dprice * src/setpage.f90: bug fix with alt y axis stuff git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4966 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-22 dprice * src/asciiutils.f90, src/setpage.f90: added ability to plot second y axis to setpage routines git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4965 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-18 dprice * src/plotstep.f90: BUG FIX with overlaid ticks not appearing on first panel pdf/eps/ps plots (thanks to M. Bate) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4964 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-18 dprice * src/read_data_gadget.f90: bug fix with reading gadget initial conditions files; also only looks for Nh, Ne if iFlagCool=1 instead of iFlagCool.ne.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4963 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-04-18 dprice * build/Makefile, src/read_data_aly.f90: added data read for Aly Reheam (splash-aly/make aly) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4962 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-28 bayliffe * src/analysis.f90: Added calc amp to give the amplitude rather than just the peak to peak difference; differs by factor of a half. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4949 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-28 dprice * src/analysis.f90: output from splash calc to screen to many more decimal places git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4948 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-25 dprice * src/read_data_ndspmhd.f90: added fictional dust particle creation for one-fluid dust visualisation (NSPLASH_TWOFLUID=yes) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4941 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-25 dprice * src/exact.f90: bug fix with read of Kdrag from ndspmhd .in file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4940 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-25 dprice * src/calc_quantities.f90, src/globaldata.f90, src/read_data_ndspmhd.f90: pre-calculation of one-fluid dust quantities added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4939 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-06 dprice * src/plotlib_giza.f90, src/plotlib_pgplot.f90: plot_pap interface includes optional units argument git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4911 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-01 dprice * src/analysis.f90: compiler warning (type conversion) fixed in calc diff git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4910 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-01 dprice * src/calc_quantities.f90, src/defaults.f90, src/geomutils.f90, src/globaldata.f90, src/interactive.f90, src/options_data.f90, src/options_limits.f90, src/plotstep.f90: Implemented particle tracking by type; can be saved to splash.defaults git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4909 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-01 dprice * docs/splash.tex: added some more docs about SPLASH_CENTRE_ON_SINK git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4908 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-01 dprice * docs/splash.tex: docs added for calc diff and SPLASH_CENTRE_ON_SINK git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4907 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-01 dprice * src/analysis.f90: minor change to help info git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4906 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-03-01 dprice * src/get_data.f90: SPLASH_CENTRE_ON_SINK environment variable added; works for ALL data reads git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4905 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-26 dprice * src/convert_grid.f90, src/system_utils.f90: SPLASH_TO_GRID env variable can be used to specify particular columns in splash to grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4904 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-26 dprice * src/exact_shock.f90: bug fix with dustyshock + isothermal eos git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4903 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-25 dprice * build/Makefile, src/read_data_dansph.f90, src/read_data_ndspmhd.f90: renamed read_data_dansph->read_data_ndspmhd git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4902 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-25 dprice * src/read_data_dansph.f90: ndspmhd read handles one-fluid dust arrays (iformat=5) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4901 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-24 dprice * src/read_data_sphNG.f90: bug fix with reading real4s from sphNG files if splash compiled in double precision git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4895 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-22 bayliffe * src/read_data_sphNG.f90: Force single precision read of density from sphNG dumps (as it is stored) even when compiling splash as double precision; otherwise the values returned are junk. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4894 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-20 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.2.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4893 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-20 dprice * src/splash.f90: v2.2.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4892 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-20 dprice * src/globaldata.f90, src/splash.f90: v2.2.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4891 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-07 dprice * src/plotstep.f90: minor fix to comment git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4884 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-07 dprice * src/menu.f90, src/prompting.f90: bug fix if multiplot read from defaults file refers to columns not present: now re-prompts for this git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4883 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-07 dprice * src/read_data_ascii.f90: better recognition of density and pressure columns in ascii read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4882 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-02-07 dprice * src/plotstep.f90: bug fix with axes printing if >1 plot per page, now more transparently handled git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4881 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-01-30 dprice * build/Makefile, src/options_render.f90: bug fix with projections if kernel radius changed via menu git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4880 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-01-30 dprice * src/kernels.f90: added Wendland kernels as options; reverted to usual definition of m5 kernel git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4879 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-01-30 dprice * src/plotstep.f90: bug fix with particle tracking of dark matter particles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4878 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-01-18 dprice * src/plotstep.f90: implemented exact solution plotting on top of surface density/toomre Q/pdf plots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4877 cab04810-efc7-4a10-8ecf-f366c833a2ad 2013-01-18 dprice * src/options_page.f90: added page size option for 4KTV/Ultra HD git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4876 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-12-13 dprice * src/exact.f90: bug fix with exact solutions if time not read from file (now assumes t=0); also can specify shock position in mhd shock solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4875 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-12-13 dprice * src/exact_mhdshock.f90: Brio-Wu solution fixed! git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4874 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-12-02 bayliffe * src/analysis.f90: Added calculation of difference between maximum and minimum of the properties, called using calc diff. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4873 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-11-16 dprice * src/splash.f90: v2.2.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4871 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-11-16 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.2.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4870 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-11-16 dprice * src/splash.f90: v2.2.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4869 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-11-16 dprice * docs/splash.bbl, docs/splash.tex: docs updated for 2.2.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4868 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-11-16 dprice * src/interpolate3D_proj_geom.F90: rendering in non-cartesian coords uses normalised interpolation if 3rd dimension is not a length git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4867 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-11-16 dprice * src/shapes.f90: maxshapes increased to 32 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4866 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-26 dprice * src/plotstep.f90: bug fix with axes being redrawn with multiple steps per page (looks odd in eps) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4852 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-26 dprice * build/Makefile, src/exact.f90, src/exact_gresho.f90: added gresho vortex exact solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4850 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-26 dprice * src/plotstep.f90: titles continue on next page if ntitles > nacross*ndown git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4849 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-26 dprice * src/exact.f90: bug fix with axes colours in residual error plots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4848 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-15 dprice * src/read_data_gadget_hdf5.f90: bug fix: GSPLASH_DARKMATTER_HSOFT now works with gadget hdf5 read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4818 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-15 dprice * src/exact_function.f90: minor changes to comments git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4817 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-15 dprice * build/Makefile, src/geomutils.f90, src/get_data.f90, src/menu.f90, src/options_particleplots.f90, src/splash.f90: automatically turns on plotting of dark matter particles if no gas particles read; dependencies rejigged to enable this (set_coordlabels moved; also does not reread coord labels when resetting coord system) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4816 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-15 dprice * src/read_data_gadget_hdf5.f90, src/read_data_gadget_hdf5_utils.c: bug fix with gadget HDF5 read with dark matter only + no gas git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4815 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-03 dprice * src/geometry.f90, src/interpolate3D_proj_geom.F90, src/plotstep.f90: much faster r-z and non-cartesian rendering git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4814 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-03 dprice * src/menu.f90: bug fix with allowed range of columns in render prompts if extra quantities present git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4813 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * src/fparser.f90: commented out cruft removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4812 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * src/write_sphdata.f90: splash to ascii uses origin settings if cyl/sph coords are used git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4811 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * src/calc_quantities.f90, src/geomutils.f90, src/write_sphdata.f90: bug fix with velocities in cylindrical coords + calc quantities if radius is relative to tracked particle git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4810 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * src/geomutils.f90, src/plotstep.f90: changecoords and changeveccoords routines moved to geomutils module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4809 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * src/interpolate3D_projection.F90: integrated kernel table setup does not print anything git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4808 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * src/geomutils.f90: BUG FIX with splash to ascii if coordinate transform set (now works) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4807 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * build/Makefile, src/calc_quantities.f90, src/write_sphdata.f90: BUG FIX with splash to ascii if coordinate transform set (now works) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4806 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-02 dprice * src/discplot.f90: bug fix with weird limit-changing behaviour with a) on surface density/toomre Q plots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4805 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-01 dprice * src/options_page.f90: minor bug with string indexing fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4802 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-01 dprice * docs/splash.tex: footnote fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4801 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-01 dprice * src/options_render.f90: compiler warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4800 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-10-01 dprice * src/kernels.f90: compile error in gfortran 4.7 fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4799 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-30 dprice * build/Makefile: Makefile uses FC, FFLAGS instead of F90C, F90FLAGS; also version number checked for gfortran compatibility git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4797 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-28 dprice * src/plotstep.f90: consistent definition of lastplot done in page_setup; printing of plot limits less verbose for multiple steps-per-page git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4796 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-28 dprice * src/read_data_ascii.f90: ascii data read prints column assignment info only for first file read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4795 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-28 dprice * src/asciiutils.f90: get_columns no longer prints number of columns (less verbosity) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4794 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-28 dprice * src/interactive.f90: line break before interactive help (looks nicer) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4793 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-19 dprice * src/kernels.f90: added kernel function for M5 quartic squashed to 2h git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4792 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-19 dprice * src/options_data.f90: better question about buffered data git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4791 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * src/defaults.f90, src/globaldata.f90, src/menu.f90, src/options_xsecrotate.f90, src/splash.f90: .anim files no longer used, animation sequence options now just saved to splash.defaults; much less confusing git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4782 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * src/shapes.f90: uses print_shapeinfo to pretty-print shapes during plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4781 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * src/splash.f90: updated version info git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4780 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * src/colourbar.f90: compiler warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4779 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * src/interactive.f90: unused variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4778 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * src/options_xsecrotate.f90: animation sequences menu uses new list prompting module: much less confusing git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4777 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * build/Makefile: added new prompt_list module for list-based menus; shapes menu now implemented using this git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4776 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-17 dprice * src/interactive.f90, src/promptlist.f90, src/shapes.f90: added new prompt_list module for list-based menus; shapes menu now implemented using this git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4775 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-14 dprice * src/interactive.f90, src/shapes.f90: better error handling with ctrl-t in interactive mode if hit array limits for text shapes git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4773 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-14 dprice * src/shapes.f90: vastly improved the menu interface for adding/editing shapes/annotation git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4772 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-14 dprice * src/colourbar.f90, src/interactive.f90, src/options_render.f90: implemented floating/inset and customisable colour bar options git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4771 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-14 dprice * src/interactive.f90: interactive mode prints help screen automatically on first call git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4770 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-12 dprice * src/kernels.f90: new kernel module added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4769 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-12 dprice * src/options_render.f90: kernel swapping implemented as menu option in r) menu; also choice saved to splash.defaults, overrides SPLASH_KERNEL setting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4768 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-12 dprice * src/interpolate3D.F90: bug fix with openMP in splash to grid + kernel swapping git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4767 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-12 dprice * src/convert_grid.f90: bug fix with memory allocation in splash to grid if npixels exceeds int4 limit git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4766 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-12 dprice * src/interpolate3D.F90, src/interpolate3D_proj_geom.F90, src/interpolate3D_projection.F90: openMP bugs fixed with kernel swapping stuff git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4765 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-12 dprice * build/Makefile, src/fieldlines.f90, src/interpolate1D.f90, src/interpolate2D.f90, src/interpolate3D.F90, src/interpolate3D_opacity.f90, src/interpolate3D_proj_geom.F90, src/interpolate3D_projection.F90, src/interpolate3D_xsec.f90, src/interpolate_vec.f90, src/splash.f90: kernel swapping implemented (using SPLASH_KERNEL environment variable): applies to ALL interpolation routines git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4764 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-11 dprice * build/Makefile: confusing/obsolete linkerror diagnostic stuff removed from Makefile git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4763 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-10 dprice * build/Makefile: build dependency fixed (thanks to Shazrene Mohamed) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4762 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-09 dprice * build/Makefile, src/write_data_gadget.f90, src/write_sphdata.f90: added splash to gadget option to convert files to basic gadget code format git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4761 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-09 dprice * src/convert_grid.f90, src/interpolate2D.f90, src/plotstep.f90, src/write_griddata.F90: implemented splash to grid in 2D git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4760 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-07 dprice * src/colours.f90: added CMRmap colour scheme: A colormap for effective black and white rendering of colour scale images git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4759 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-06 dprice * src/read_data_jules.f90: updated jules data read to handle his latest format git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4758 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-06 dprice * src/get_data.f90: catches problems with vector labelling in data reads git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4757 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-03 dprice * src/read_data_sphNG.f90: BUG FIX with sink particle read in phantom small dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4751 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-03 dprice * src/get_data.f90: less verbose warning if no gas particles (warns for first file only) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4750 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-09-03 dprice * src/globaldata.f90, src/read_data_sphNG.f90: BUG FIX/regression with int*8 and int*1 definitions in sphNG data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4748 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-31 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.1.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4732 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-31 dprice * src/splash.f90: v2.1.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4731 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-31 dprice * src/globaldata.f90: tagline update git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4730 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-31 dprice * docs/splash.tex: minor issues with docs fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4729 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-31 dprice * : added example shock tube figure to userguide git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4728 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-31 dprice * docs/splash.tex: userguide updated for new version/obsolete references to PGPLOT removed/updated appropriately for GIZA git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4727 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/interactive.f90: more concise/better formatted help for interactive mode git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4726 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/globaldata.f90, src/read_data_sphNG.f90: BUG FIX/regression with definition of int8 kind (sphNG read) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4725 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_sphNG.f90: handles ncolumns > maxplot error cleanly git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4724 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/get_data.f90: ncolumns set to zero if no data read to avoid out-of-bounds issues git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4723 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/calc_quantities.f90, src/exact_ringspread.f90, src/get_data.f90, src/interactive.f90, src/menu.f90, src/options_particleplots.f90, src/plotstep.f90, src/read_data_gadget.f90, src/read_data_seren.f90, src/write_data_phantom.f90: compiler warnings about unused module variables fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4722 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_VINE.f90: unused parameter warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4721 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/plotstep.f90, src/write_pixmap.f90: unused dummy variables removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4720 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/powerspectrums.f90: unused dummy variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4719 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/convert.f90, src/convert_grid.f90, src/write_griddata.F90: unused dummy variable removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4718 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_sro.f90: unused dummy variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4717 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_seren.f90: compiler warnings silenced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4716 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/analysis.f90, src/convert.f90: unused dummy variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4715 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_VINE.f90: compiler warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4714 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_sphNG.f90: compiler warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4713 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/exact_rochelobe.f90: compiler warning silenced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4712 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_gadget.f90, src/write_data_phantom.f90: compiler warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4711 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/exact_shock_sr.f90: compiler warnings (unused dummy variables, real*8 declarations) fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4710 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/read_data_gadget.f90: pedantic warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4709 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * build/Makefile: -pedantic and -Wextra added to debug flags for gfortran git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4708 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/options_limits.f90: unused variables removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4707 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-30 dprice * src/calc_quantities.f90: compiler warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4706 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/options_xsecrotate.f90: ifort remarks silenced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4702 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/analysis.f90, src/read_data_gadget.f90, src/read_data_sphNG.f90, src/read_data_sro.f90, src/read_data_tipsy.F90, src/timestepping.f90: ifort remarks silenced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4701 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/exact_rhoh.f90: ifort compiler remark silenced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4700 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/options_limits.f90, src/options_page.f90: prompts added to adjust plot limits to device aspect ratio when changing paper size and in limits menu git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4699 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/interpolate3D.F90: bug fix/regression with openMP in splash to grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4698 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/options_data.f90: ifort remark silenced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4697 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * build/Makefile: fixed dependency issue during compilation git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4696 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/fieldlines.f90: unused variable warning fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4684 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/calc_quantities.f90, src/get_data.f90, src/globaldata.f90, src/options_particleplots.f90: compilation/dependency issue fixed with iexact git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4683 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-29 dprice * src/convert_grid.f90, src/interpolate3D.F90, src/plotstep.f90, src/powerspectrums.f90, src/system_utils.f90: BUG FIX with wrapping to periodic boundaries in splash to grid; can also now specify periodicity in x,y and z boundaries separately in splash to grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4682 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-28 dprice * src/calc_quantities.f90, src/get_data.f90, src/options_particleplots.f90: BUG FIX with calculated quantities + change of coordinate systems git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4681 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-22 dprice * src/read_data_gadget.f90, src/read_data_gadget_hdf5.f90, src/read_data_gadget_hdf5_utils.c: BUGS FIXED with gadget HDF5+multiple files; seems to work now; better error handling in GADGET reads git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4663 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-22 dprice * src/read_data_gadget_hdf5_utils.c: preprocessing added so that gadget-hdf5 read compiles with both hdf5 1.8 as well as against earlier versions git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4662 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-21 dprice * src/fparser.f90, src/setpage.f90: compiler warnings under gfortran 4.6 fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4661 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-21 dprice * build/Makefile: added DOUBLEPRECISION=yes option to compile splash in double precision (currently only works for certain data reads) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4660 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-21 dprice * src/prompting.f90: minor bug fix in real prompt interface if min/max used git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4659 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-21 dprice * src/prompting.f90: better kind selection for single precision prompt routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4658 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-08-21 dprice * src/prompting.f90, src/timing.f90: fixed issues compiling in double precision git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4657 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-15 dprice * src/legends.f90, src/plotlib_pgplot.f90: vector plot legend uses rounded, semi-transparent rectangle for background (giza only) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4622 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-15 dprice * src/interactive.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90: implemented irregular shaped particle selection on shift-click in interactive mode (pgplot+giza), plus circular selection/marking of particles with middle click (giza backend only) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4621 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-15 dprice * src/interpolate3D_opacity.f90: contact details updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4620 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-15 dprice * src/allocate.f90, src/limits.f90: contact details updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4619 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-13 dprice * install-cairo.sh: install-cairo script works with cairo-1.12.2.tar.xz (xz not gz compression); plus gives correct hint for Darwin library path git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4618 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-13 dprice * src/shapes.f90: arrow shape takes justification parameter so either head or tail can be at specified position git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4617 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-12 dprice * src/read_data_h5part.f90: h5part read now recognises any vector quantity from _0, _1, _2 subscripts git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4616 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-08 dprice * src/read_data_dansph.f90: BUG FIX with itype warning when reading public ndspmhd code output; also ndspmhd read less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4610 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-08 dprice * src/read_data_h5part.f90: h5part read less verbose for second and subsequent files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4609 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-08 dprice * src/read_data_h5part.f90: h5part data read reads types from Phase if MatID is not present git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4608 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-08 dprice * src/legends.f90: vector legend uses semi-transparent background git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4607 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-08 dprice * src/read_data_h5part.f90: bug fix with h5part read if smoothing length present in file, also with ndimV setting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4606 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-08 dprice * src/interactive.f90: pressing numbers now sets the timestep jump according to the digits typed (MUCH more sensible); also pressing 0 gives timestep jump of 10, 100 etc (thanks to Terry Tricco for the rather obvious suggestion) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4605 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-06-08 dprice * src/plotstep.f90: BUG FIX with exact solution not appearing on second and subsequent panels if multiplot is used git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4604 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-17 dprice * src/options_page.f90, src/setpage.f90: added axis=3 option to draw box, ticks and numbers but no labels git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4597 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-16 dprice * build/Makefile: fixed install target so that installs gsplash-hdf5, seren read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4596 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-16 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 2.1.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4595 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-16 dprice * src/splash.f90: version 2.1.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4594 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-16 dprice * install-cairo.sh: cairo/pixman versions updated in install-cairo script git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4593 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-14 dprice * src/read_data_gadget_hdf5.f90, src/read_data_gadget_hdf5_utils.c: GADGET hdf5 read now reads and uses particle ID to resort particles/track identities git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4589 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-14 dprice * src/interpolate3D_projection.F90: silenced h<0 warning in interpolate_projection (spurious when mixed particle types) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4588 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-14 dprice * src/read_data_gadget_hdf5.f90, src/read_data_gadget_hdf5_utils.c: implemented GADGET HDF5 data read (works on available test cases) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4587 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-14 dprice * src/read_data_sphNG.f90: phantom+cleaning labelling fixed in sphNG read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4586 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-05-06 dprice * src/get_data.f90: less verboseness git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4560 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-03-13 dprice * src/fieldlines.f90: minor parameter adjustments to fieldline rendering git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4547 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-03-13 dprice * src/options_xsecrotate.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/plotstep.f90, src/render.f90: plot_imag_alpha interfaces added; ppm stuff no longer used with opacity rendering (but new stuff not quite working yet) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4546 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-03-07 dprice * src/splash.f90: date updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4545 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-03-07 dprice * src/exact.f90, src/exact_fromfile.f90, src/plotstep.f90: exact solution from file can have arbitrary number of columns (prompts if ncols>2); can have one exact file per dump git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4544 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-03-07 dprice * src/read_data_seren.f90: bug fix with seren data read labelling of vector quantities in different coordinate systems git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4543 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-03-06 dprice * src/colours.f90: few more colour schemes added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4542 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-02-15 dprice * src/options_limits.f90: adjust limits to device OFF by default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4541 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-01-27 dprice * src/calc_quantities.f90: bug fix with newly added calculated quantities being skipped git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4540 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-01-26 dprice * src/calc_quantities.f90: BUG FIX with calculated quantities and alternative coordinate systems (thanks to Farzana Meru); also with printed output of nused git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4539 cab04810-efc7-4a10-8ecf-f366c833a2ad 2012-01-26 dprice * src/calc_quantities.f90: minor bug fix with identification of calc quantities/debug mode git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4538 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-20 dprice * src/read_data_sphNG.f90: added units for resistivity parameters to sphNG read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4537 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-19 dprice * src/plotstep.f90: minor debugging stuff added; bug partially fixed with no axes on multiplots + multiple steps per page git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4536 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-19 dprice * src/get_data.f90: endian information now only printed if BIG endian is found git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4535 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-19 dprice * src/legends.f90: header updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4534 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-19 dprice * src/read_data_sphNG.f90: fixed labelling for eta/psi/extra stuff in MHD dumps with sphNG git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4533 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-18 dprice * src/colours.f90: added Terrys Alice WBYR colour scheme git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4532 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-14 dprice * INSTALL: updated installation instructions to use install-cairo script + package info git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4530 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-14 dprice * install-cairo.sh: added script to install cairo and pixman if they are not already present git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4529 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-13 dprice * src/fieldlines.f90: 3D field line plotting added; now default if streamlines are set and 3D projection plot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4528 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-13 dprice * src/plotstep.f90: bug fix with weights not being calculated for vector plots not drawn on top of another render plot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4527 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-13 dprice * src/interactive.f90: bug fix with effect of u,U,d,D in interactive mode for 3D perspective git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4526 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-09 dprice * src/fieldlines.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/plotstep.f90: new 3D field line plotting implemented (not yet live) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4525 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-08 dprice * src/convert.f90: bug fix with interface to analysis not having been committed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4524 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-08 dprice * src/analysis.f90: analysis does max/min/mean only for types being plotted; also calculates total ang mom for energies git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4523 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-12-06 dprice * src/interactive.f90: bug fix with vector limits not being saved in interactive mode on multiplots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4522 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-16 dprice * src/prompting.f90: minor fix to prompting module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4517 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-16 dprice * src/read_data_sphNG.f90: env variable for reading dust added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4516 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-14 dprice * src/plotlib_giza.f90: bug fix in giza interface git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4512 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-14 dprice * src/colourbar.f90, src/colours.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/render.f90: inverse greyscale colour bars now working in giza; also use new extend arguments to giza_render to determine padding of image (used for colour bars, not for main image) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4511 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-11 dprice * src/plotlib_giza.f90: added support for inverse colour tables with giza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4510 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-09 dprice * src/read_data_sphNG.f90: sphNG read less verbose git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4509 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-09 dprice * src/analysis.f90: ekiny/kh analysis added (undocumented) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4508 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-11-03 dprice * src/read_data_sphNG.f90: sphNG read gets curl v from .divv file if present for phantom dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4507 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-21 dprice * src/plotstep.f90: smarter plot tiling: can still tile plots with different colour bars as long as all colour bars in the row are the same git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4486 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-20 dprice * src/calc_quantities.f90: bug fix with dependency calculations in calculated quantities/partial data reads git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4485 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-19 dprice * src/calc_quantities.f90, src/get_data.f90, src/plotstep.f90: optimisation with calculated quantities: now only reads required quantities from file and only computes those actually being used git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4482 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-19 dprice * src/options_page.f90: bug fix with saving alphalegend to splash.defaults git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4481 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-19 dprice * src/read_data_ascii.f90: less verbose output git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4480 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-19 dprice * src/get_data.f90, src/globaldata.f90, src/options_data.f90, src/read_data_ascii.f90, src/units.f90: verboseness of splash calc reduced git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4479 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-19 dprice * src/analysis.f90: vrms/rhomach analyses hidden from documentation (as not recommended for general use) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4478 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-19 dprice * src/calc_quantities.f90: calculated quantities output less verbose when skipped git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4477 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-11 dprice * build/Makefile: make clean deletes bin/splash bin/ssplash etc git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4472 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-11 dprice * src/read_data_gadget.f90: minor changes to output in gadget read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4471 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-11 dprice * bin/.keep: added .keep to bin directory so it appears in svn git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4470 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-10-10 dprice * src/exact.f90, src/plotstep.f90: added option to plot exact solution only on selected panels; also bug fix with fixed npix + auto-adjusted limits git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4469 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-21 dprice * src/plotstep.f90: bug fix with non-cartesian rendering and auto-adjusted plot limits (also r-z gives square plot by default) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4465 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-15 dprice * src/interactive.f90: bug fix with uninitialised variable in getpanel git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4451 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-14 dprice * src/interactive.f90: bug fix with uninitialised variable git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4446 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-09 dprice * src/plotstep.f90: minor bug fix with round-off error in automatic pixel selection git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4442 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-09 dprice * src/options_limits.f90: auto-adjust is set by default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4441 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-09 dprice * src/options_limits.f90, src/options_page.f90, src/plotstep.f90, src/setpage.f90: added option to automatically adjust the plot limits to match the device aspect ratio git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4440 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-09 dprice * README: README file updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4439 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-09 dprice * src/options_page.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/plotstep.f90: page sizes can now be specified in pixels (giza only) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4438 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-09-09 dprice * src/plotlib_giza.f90: updated interface to giza_set_paper_size git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4437 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * src/setpage.f90: whitespace bug fixed in tiled non-square plots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4431 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * docs/version_history_tex.tex: version 2.0-beta git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4430 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * docs/version: version 2.0-beta git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4429 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * src/interactive.f90: bug fix with + in interactive mode for double rendering git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4428 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * build/Makefile: bug fixes with giza build with ifort/icc git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4427 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * build/Makefile: default backend now giza (for v2.0) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4426 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * INSTALL, INSTALL.macosx, INSTALLv1.x: updated install instructions for 2.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4425 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * src/splash.f90: more pgplot refs removed; version is 2.0beta git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4424 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * src/exact.f90, src/options_particleplots.f90, src/setpage.f90, src/splash.f90: PGPLOT references removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4423 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * build/Makefile: -Wall only done if debug flags set in SYSTEM=gfortran git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4412 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.15.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4411 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-29 dprice * docs/splash.tex: docs updated for 1.15.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4410 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-28 dprice * src/splash.f90: v1.15.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4409 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-28 dprice * src/exact.f90, src/options_page.f90, src/options_particleplots.f90, src/particleplot.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/shapes.f90, src/timestepping.f90: added plotlib_maxlinestyle, plotlib_maxlinecolour and plotlib_maxfillstyle; these are used where appropriate instead of hardwired values git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4408 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-26 dprice * build/Makefile: c compiler and flags passed to giza makefile git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4407 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-26 dprice * build/Makefile: added build target (libgiza) to just build giza, no splash git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4406 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-26 dprice * build/.depends, build/Makefile: .depends moved to separate file; other cleanups in Makefile git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4405 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-26 dprice * build/Makefile: removed unnecessary include stuff now we are using libgiza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4404 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-26 dprice * build/Makefile: new build process for giza; uses libgiza instead of direct use of object files; uses recursive make to build giza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4403 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-25 dprice * src/interactive.f90, src/plotstep.f90: bug fix with interactive mode on double-rendered multiplots; also better panel determination in colour bar click git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4402 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-25 dprice * src/plotstep.f90: bug fix with seg fault on double-rendering in multiplots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4401 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-25 dprice * src/particleplot.f90: line plotting for particle type 2 added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4400 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-25 dprice * src/interactive.f90, src/plotstep.f90: preliminaries for interactive setting of double-rendered colour bar on multiplots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4399 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-25 dprice * src/interactive.f90, src/plotstep.f90: interactive limits setting on double-rendered colour bar fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4398 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-24 dprice * src/exact_dustywaves.f90: bug fix in dustywave solution if density .ne. unity git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4397 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-24 dprice * src/exact.f90, src/exact_shock.f90: dustyshock solution added (modification of shock); also dustywave reads Kdrag from ndspmhd input file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4396 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-23 dprice * src/read_data_sphNG.f90: sphNG read handles batcode format git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4395 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-18 dprice * scripts/splash_parallel.pl: minor updates to splash_parallel from sun grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4394 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-17 dprice * src/system_utils.f90: valgrind error silenced in renvironment (does not attempt to read blank string) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4393 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-17 dprice * src/get_data.f90: bug fix in get_data if no data read (does not access ix if it is not set) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4392 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-15 dprice * src/allocate.f90, src/analysis.f90, src/calc_quantities.f90, src/colourbar.f90, src/colourparts.f90, src/colours.f90, src/convert.f90, src/convert_grid.f90, src/cubicsolve.f90, src/defaults.f90, src/discplot.f90, src/exact.f90, src/exact_densityprofiles.f90, src/exact_dustywaves.f90, src/exact_fromfile.f90, src/exact_function.f90, src/exact_mhdshock.f90, src/exact_mhdshock_other.f90, src/exact_polytrope.f90, src/exact_rhoh.f90, src/exact_ringspread.f90, src/exact_rochelobe.f90, src/exact_sedov.f90, src/exact_shock.f90, src/exact_shock_sr.f90, src/exact_torus.f90, src/exact_toystar1D.f90, src/exact_toystar2D.f90, src/exact_wave.f90, src/fieldlines.f90, src/fparser.f90, src/geometry.f90, src/get_data.f90, src/globaldata.f90, src/interactive.f90, src/interpolate1D.f90, src/interpolate2D.f90, src/interpolate3D_opacity.f90, src/interpolate3D_xsec.f90, src/interpolate_vec.f90, src/interpolation.f90, src/legends.f90, src/limits.f90, src/menu.f90, src/options_data.f90, src/options_limits.f90, src/options_page.f90, src/options_particleplots.f90, src/options_powerspec.f90, src/options_render.f90, src/options_vecplot.f90, src/options_xsecrotate.f90, src/pagecolours.f90, src/particleplot.f90, src/pdfs.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/plotstep.f90, src/plotutils.f90, src/powerspectrums.f90, src/prompting.f90, src/read_data_UCLA.f90, src/read_data_VINE.f90, src/read_data_ascii.f90, src/read_data_bauswein.f90, src/read_data_dansph.f90, src/read_data_dansph_old.f90, src/read_data_dragon.f90, src/read_data_egaburov.f90, src/read_data_flash_hdf5.f90, src/read_data_foulkes.f90, src/read_data_gadget.f90, src/read_data_gadget_hdf5.f90, src/read_data_gadget_jsb.f90, src/read_data_h5part.f90, src/read_data_jjm.f90, src/read_data_jjm_multiphase.f90, src/read_data_jules.f90, src/read_data_kitp.f90, src/read_data_mbate.f90, src/read_data_mbate_hydro.f90, src/read_data_mbate_mhd.f90, src/read_data_oilonwater.f90, src/read_data_rsph.f90, src/read_data_scw.f90, src/read_data_seren.f90, src/read_data_snsph.f90, src/read_data_sphNG.f90, src/read_data_spyros.f90, src/read_data_sro.f90, src/read_data_urban.f90, src/read_data_vanaverbeke.f90, src/render.f90, src/rotate.f90, src/setpage.f90, src/shapes.f90, src/splash.f90, src/system_f2003.f90, src/system_unix.f90, src/system_unix_NAG.f90, src/system_utils.f90, src/timestepping.f90, src/timing.f90, src/titles.f90, src/transform.f90, src/units.f90, src/write_data_phantom.f90, src/write_pixmap.f90, src/write_sphdata.f90: spurious whitespace at end of lines removed (script) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4390 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-15 dprice * src/read_data_sphNG.f90: less verbose output git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4389 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-15 dprice * build/Makefile: CC set to gcc only if not already set git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4388 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-15 dprice * src/options_particleplots.f90, src/particleplot.f90: implemented outlined solid marker types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4387 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-15 dprice * build/Makefile, src/contours.f90, src/options_render.f90, src/render.f90: implemented manual level/label setting for contour plots (thanks to Andy McLeod) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4386 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-15 dprice * src/asciiutils.f90: BUG FIX in read_asciifile_real; affects only splash calc massaboverho; added additional routine for contouring git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4385 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-11 dprice * src/get_data.f90, src/read_data_dansph.f90: reads multiple types from ndspmhd; bug fix with check_data_read and multiple types if get_label not called in read_data routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4382 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-05 dprice * build/Makefile: better giza compilation with icc git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@4368 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-04 dprice * src/menu.f90: allow rendering in alternative coordinate systems git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1675 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-04 dprice * src/interpolate3D_proj_geom.F90, src/plotstep.f90: minor tweaks to rendering in alternative coord systems git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1674 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-04 dprice * src/interpolate3D_proj_geom.F90, src/plotstep.f90: minor fixes to interp3D_geom, trying to get r-z to work git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1673 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-04 dprice * build/Makefile, src/interactive.f90, src/particleplot.f90: circles of interaction done in other coordinate systems in interactive mode git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1672 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-04 dprice * build/Makefile, src/geometry.f90, src/interpolate3D_proj_geom.F90, src/plotstep.f90: implemented rendering in alternative coordinate systems (works but slow!) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1671 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-02 dprice * src/geometry.f90: added parameter variables for each coordinate system to geometry module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1665 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-02 dprice * src/plotstep.f90, src/setpage.f90: interface to 2D interpolation fixed; plus redraw_axes now done with giza but only if rendering git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1664 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-02 dprice * src/interpolate2D.f90: 2D interpolation works with non-square pixels git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1663 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-02 dprice * src/read_data_sphNG.f90: better warning about lowmem+multiple types for phantom read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1662 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-02 dprice * src/analysis.f90: bug fix with momentum calculation in splash calc energies git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1661 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-02 dprice * src/read_data_sphNG.f90: bug fix causing seg fault in phantom+dust+low memory mode git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1660 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-08-02 dprice * src/globaldata.f90: BUG FIX with igettype routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1659 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/discplot.f90, src/globaldata.f90, src/interactive.f90, src/plotstep.f90: bug fix with interactive particle queries: now ignores particle types not plotted git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1653 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/read_data_sphNG.f90: bug fix with accreted particles + dust in phantom read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1652 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/discplot.f90, src/plotstep.f90: surface density/toomre Q plots respect particle types turned on/off git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1651 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolate3D.F90: use shared instead of firstprivate for hmin git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1650 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolate3D.F90: parallel interpolate3D_vec routine: so all 3D grid interpolations can be done in parallel git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1649 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * build/Makefile: bug fix with dependencies in Makefile git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1648 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolate3D_projection.F90: compiler warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1647 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolate3D.F90: parallelised interpolation to 3D grid (splash to grid) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1646 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolate3D.F90, src/interpolate3D.f90: .f90->.F90 for parallel 3D interpolation git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1645 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/get_data.f90: bug fix with ifort compilation git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1644 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolate3D.f90, src/interpolate3D_opacity.f90, src/interpolate3D_projection.F90: minor formatting of timings/header git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1643 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolate3D_projection.F90: timing is formatted better; with openmp clearly indicates cpu-s not s git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1642 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * build/Makefile, src/get_data.f90, src/timing.f90: timing module added; data read timing now walltime not cpu time git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1641 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolation.f90: bug fix in openmp git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1640 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interpolation.f90: parallel set_interpolation_weights git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1639 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-27 dprice * src/interactive.f90, src/plotstep.f90: bug fix with a in interactive mode: now adapts only to types being plotted git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1638 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-26 dprice * src/plotstep.f90: bug fix with adaptive limits + mixed particle types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1637 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-26 dprice * src/particleplot.f90: minor amendment to header git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1636 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-15 dprice * src/read_data_sphNG.f90: labels fixed on H2 chemistry small dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1597 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-14 dprice * src/read_data_sphNG.f90: labelling of H2 chemistry more robust (works with mhd) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1596 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-14 dprice * src/units.f90: bug fix/more robust write/read of units files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1595 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-12 dprice * src/read_data_sphNG.f90: fix for corrupt sphNG dump files (now checks that RT=on in file header - assumes block 3 not present if not) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1588 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-11 dprice * src/plotstep.f90: colour bar plotted as expected (for 2nd quantity) if double rendering is used git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1587 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-11 dprice * src/render.f90: minor formatting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1586 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-11 dprice * src/colourbar.f90: uses plot_gray if icolours=1 for colour bar git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1585 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-11 dprice * src/read_data_sphNG.f90: labelling of H2 chemistry stuff implemented (for Phantom) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1583 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-07-01 dprice * src/plotlib_pgplot.f90: bug fix with plotlib_pgplot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1552 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-30 dprice * src/discplot.f90, src/plotstep.f90: bug fix (for Ben): surface density and Toomre Q plots now use only particles turned on git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1551 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-30 dprice * src/plotlib_giza.f90: translates unit 3 to giza_units_pixels not giza_units_device git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1550 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-30 dprice * src/menu.f90, src/options_render.f90, src/plotstep.f90, src/splash.f90: implemented menu options for double rendering git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1549 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-30 dprice * src/colourbar.f90, src/options_page.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/plotstep.f90, src/setpage.f90: plotlib_is_pgplot etc are parameters not query functions git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1548 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-30 dprice * src/options_render.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/plotstep.f90, src/render.f90: double rendering implemented; seems to work git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1547 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-29 dprice * src/convert_grid.f90: safer default grid size for splash to grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1546 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-27 dprice * src/exact_rochelobe.f90: bug fix with ifort compilation git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1545 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-23 dprice * src/interpolate3D_projection.F90, src/interpolate3D_xsec.f90, src/plotstep.f90: non-square axes implemented for cross section slices git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1518 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-23 dprice * build/Makefile, src/exact.f90, src/exact_rochelobe.f90: added roche lobe exact solution (somewhat restricted at present) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1515 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-21 dprice * scripts/makemovie.sh: movie script from Ben Ayliffe added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1487 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-21 dprice * src/options_data.f90: minor header change git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1486 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-17 dprice * src/calc_quantities.f90: only print info in debug mode for column identification git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1483 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-17 dprice * src/get_data.f90: BUG FIX with labels not being set on first call to calc_quantities causing calculated quantities to be inactive git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1482 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-17 dprice * src/calc_quantities.f90: calc_quantities module identifies calculated quantities so they can be used in the exact solutions (in particular, the radius) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1481 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-14 dprice * src/get_data.f90: less verbose endian information git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1480 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-10 dprice * src/defaults.f90: file unit is a parameter rather than hard coded in defaults file read/write git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1479 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-10 dprice * src/plotstep.f90: extra spaces removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1478 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-10 dprice * src/asciiutils.f90: header updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1477 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-10 dprice * src/setpage.f90: A long-standing bug with numbers being chopped in half at the edge of the viewport fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1476 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-02 dprice * src/allocate.f90: dat array zeroed when memory first allocated; avoids uninitialised variable problems (valgrind) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1475 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-02 dprice * src/limits.f90: header info updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1474 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-02 dprice * src/limits.f90, src/units.f90: checks if limits/units files exist before trying to open (removes valgrind warning) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1473 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-06-01 dprice * src/colourbar.f90: minor cleanups in colourbar routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1472 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-31 dprice * src/plotstep.f90: minor debugging output added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1471 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-26 dprice * src/calc_quantities.f90: added h*divB/B and plasma beta to list of examples/prefilled calculated quantities git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1470 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-26 dprice * src/calc_quantities.f90: arithmetic operators removed from labels git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1469 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-26 dprice * src/calc_quantities.f90: implemented pre-filling of calculated quantities list with *all* of the known examples (requested by Ben Ayliffe) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1468 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-18 dprice * src/plotstep.f90: enters single plot interactive mode if only one step exists (suggested by Ben Ayliffe) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1467 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-17 dprice * src/splash.f90: BUG FIX with global SPLASH_DEFAULTS variable setting/use git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1464 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-16 dprice * src/exact.f90, src/exact_sedov.f90: added vr solution for Sedov blast wave git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1459 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-15 dprice * scripts/png2theora.sh: png2theora script added (contributed by Pau Amari-Seoane) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1458 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-13 dprice * src/interpolation.f90: minor change to header git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1457 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-13 dprice * src/plotstep.f90: BUG FIX with non-interactive multiplot and partial data reads (required) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1456 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-09 dprice * src/defaults.f90, src/options_particleplots.f90: minor change to header git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1455 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-09 dprice * src/defaults.f90, src/globaldata.f90, src/menu.f90, src/plotstep.f90, src/prompting.f90: allow multiplots consisting of different particle types: seems to work git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1454 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-05-04 dprice * src/cubicsolve.f90: bug fix with seg fault in cubic solver for dustywave solution git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1448 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-31 dprice * src/calc_quantities.f90, src/interactive.f90: radius in calculated quantities is now computed relative to tracked particle if x0,y0 and z0 are used; calculated quantities are recomputed when necessary (that is, when t is set and quantities use x0,y0 or z0 in the calculation) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1439 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-31 dprice * src/colours.f90: added debug info in colour_set git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1438 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-24 dprice * src/read_data_sphNG.f90: better warning if end of file reached (explicitly pauses and asks user to continue) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1436 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-17 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.14.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1433 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-17 dprice * src/splash.f90: v1.14.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1432 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-17 dprice * INSTALL.macosx: updated install instructions for OS/X git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1431 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-17 dprice * src/splash.f90: v1.14.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1430 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-17 dprice * docs/splash.tex: docs updated for 1.14.1; more compiler info added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1429 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-17 dprice * src/cubicsolve.f90: replaced cubicsolve_complex with version that does not require sinh or asinh (for maximum portability, these are F2008 features) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1428 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-17 dprice * src/interpolate3D_projection.F90: spurious debug line removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1427 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-14 dprice * src/plotstep.f90: uninitialised variable bug fix (valgrind) with gotcontours git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1424 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-07 dprice * src/splash.f90: version info for 1.14.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1416 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-07 dprice * src/read_data_gadget.f90, src/read_data_gadget_hdf5.f90: BUG fix with massoftype in header if ntypes > 6 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1415 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-07 dprice * src/read_data_gadget.f90: bug fix with new maxpartypes setting and gadget read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1414 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-07 dprice * src/calc_quantities.f90: better formatting on write statement git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1413 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-07 dprice * src/plotstep.f90: labeltimeunits has length lenunitslabel git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1412 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-03 dprice * src/calc_quantities.f90: added magnitude of all vector quantities to example calculated quantities list; also magnetic pressure git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1411 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-03 dprice * src/plotlib_giza.f90: scir and qcir implemented in giza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1410 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-02 dprice * src/plotlib_giza.f90: updated plotlib_giza with new routines git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1409 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-03-02 dprice * src/globaldata.f90: year bumped to 2011 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1408 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-28 dprice * src/read_data_sphNG.f90: reads generalised euler potentials from phantom dump git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1407 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/plotstep.f90: minor formatting change git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1406 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/plotstep.f90: minor change git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1405 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/plotstep.f90: minor change git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1404 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/plotstep.f90: minor change to resolve conflict git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1403 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/globaldata.f90: max number of particle types increased to 12 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1402 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/units.f90: units labels actually *use* lenunitslabel git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1401 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * build/Makefile, src/read_data_seren.f90: seren data read added, now included in default build (thanks to Andrew McLeod) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1400 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/read_data_dragon.f90: added updated dragon read (thanks to Andrew McLeod) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1399 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/calc_quantities.f90: use lenlabel instead of fixed length for calculated quantity string git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1398 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-27 dprice * src/interpolation.f90: unit_interp moved to after the rescaling git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1397 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-18 dprice * src/colourbar.f90: save added to declaration git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1396 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-18 dprice * utils/grid2pdf.f90: updated grid2pdf utility git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1395 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-18 dprice * src/legends.f90, src/options_page.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90, src/plotstep.f90: implemented transparency for legend text (with giza only) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1394 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-18 dprice * src/convert_grid.f90, src/globaldata.f90, src/interpolation.f90, src/units.f90: added unit_interp for SEREN data read, for Andrew McLeod git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1393 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-02-01 dprice * src/exact.f90, src/exact_dustywaves.f90: dustywaves solution takes rhogas and dust-to-gas ratio as parameters git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1380 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-01-25 dprice * scripts/mapletofortran.pl: script for converting maple .tex to Fortran added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1363 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-01-25 dprice * src/exact_dustywaves.f90: bug fixes with dusty wave exact solution: now seems to work OK git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1362 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-01-24 dprice * build/Makefile, src/cubicsolve.f90, src/exact.f90, src/exact_dustywaves.f90: exact solution for two fluid dust/gas waves added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1361 cab04810-efc7-4a10-8ecf-f366c833a2ad 2011-01-24 dprice * src/exact.f90: changed order of exact solutions so that arbitrary function is #1, read from file is #2, rest come later git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1360 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-22 dprice * src/read_data_gadget.f90: bug fix if h not present in block-labelled gadget format (i.e. ICs files) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1359 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * build/Makefile, src/read_data_flash_hdf5.f90: bug fixes in flash hdf5 read compilation git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1338 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * build/Makefile: pgplot makefile check first checks if PGPLOT_DIR/makefile exists; cuts out spurious errors git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1337 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * src/splash.f90: version date bumped git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1336 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * build/Makefile: use of DESTDIR and PREFIX complies with gnu coding standards git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1335 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * Makefile, build/Makefile: bug fixes with make install target git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1334 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * build/Makefile: uses DESTDIR instead of DEST for make install; for compatibility with macports; portfile uses SYSTEM=gfortran git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1333 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * build/Makefile: working on macports build git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1332 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * build/Makefile: added SYSTEM=macports git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1331 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-08 dprice * docs/splash.tex: some more minor config for HeVeA git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1330 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-07 dprice * docs/splash.bbl: splash userguide modified to work with HEVEA translation to html; build for htmldocs added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1329 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-07 dprice * .gitignore, build/Makefile, docs/splash.tex: splash userguide modified to work with HEVEA translation to html; build for htmldocs added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1328 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-07 dprice * : arrow files updated (oops) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1327 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-07 dprice * : added html docs dir git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1326 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * docs/version_history, docs/version_history_tex.tex: version 1.14.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1325 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * docs/version_history, docs/version_history_tex.tex: version 1.14.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1324 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.14.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1323 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * src/splash.f90: v1.14.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1322 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * docs/splash.tex: updated docs with env variable options + f/F git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1321 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * src/globaldata.f90, src/read_data_gadget.f90: F. Buerzle: minor changes to gadget read to handle poloidal/toroidal field reading git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1320 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * src/plotstep.f90: BUG fix with -666 and 10^38 plot limits if NaNs in rendered quantity; also if rendermin=rendermax git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1319 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * src/plotstep.f90: added SPLASH_MARGIN_XMAX/SPLASH_MARGIN_XMIN etc env. variables for setting page margins git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1318 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-12-06 dprice * src/plotlib_giza.f90: added set_text_background stuff to giza interface git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1317 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-11-25 dprice * src/plotlib_giza.f90: plotlib uses new giza_format_number routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1316 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-11-05 dprice * src/read_data_sphNG.f90: reads external binary masses from phantom header (backwards compatible with old format) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1279 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-11-05 dprice * src/read_data_sphNG.f90: bug fix in memory allocation for iphase with phantom dumps + external binary git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1278 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * src/read_data_sphNG.f90: MORE bug fixes with phantom+sinks; this time if idim=idimptmass git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1272 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * src/get_data.f90: checks that number of particles from iamtype is consistent with npartoftype git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1271 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * src/plotstep.f90: minor bug fix with debug mode if npart < 10 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1270 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * src/setpage.f90: allow slightly bigger offsets for title and labels (to look OK with giza) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1267 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * build/Makefile: debug flags updated for gfortran 4.5 (uses -fcheck=all) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1266 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * src/read_data_sphNG.f90: bug fix with memory allocation and sinks git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1265 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * src/colours.f90: added Dolag colour schemes back in git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1264 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-15 dprice * src/read_data_sphNG.f90: bugs fixed with read of sink particle only phantom dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1262 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-14 dprice * src/read_data_sphNG.f90: no colouring of particles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1261 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-14 dprice * src/read_data_sphNG.f90: read of sink particles in phantom dumps added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1260 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-11 dprice * src/read_data_sphNG.f90: bug fix with sinks + phantom read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1227 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-10-07 dprice * src/read_data_sphNG.f90: bug fix with stepping backwards + accreted particles in phantom dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1222 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-28 dprice * src/read_data_sphNG.f90: bug fix with iphase + blank plots from phantom dumps git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1207 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-28 dprice * src/read_data_sphNG.f90: bug fix with phantom dumps + accreted particles, now treated much better git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1206 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-27 dprice * src/plotlib_giza.f90: added contouring routines to giza interface git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1205 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-27 dprice * docs/splash.tex, src/read_data_sphNG.f90: expanded SSPLASH_TIMEUNITS settings; added to docs git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1204 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-27 dprice * src/read_data_sphNG.f90: SSPLASH_TIMEUNITS env variable added to change default time units git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1203 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-21 dprice * src/read_data_sphNG.f90: debug statements added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1201 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-21 dprice * src/read_data_sphNG.f90: reads iphase from phantom dumps and assigns types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1194 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-09-16 dprice * src/read_data_sphNG.f90: bug fix with reading dust+gas files from phantom git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1189 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-27 dprice * src/plotlib_giza.f90: better calls to routines specifying units; units are converted from pgplot to giza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1188 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-27 dprice * build/Makefile: nsplash added to the default make git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1187 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-17 dprice * build/Makefile: build order bug fix (thanks to Robert Thompson) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1181 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-16 dprice * src/shapes.f90: text field in shapes can now be up to 120 characters git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1180 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-12 dprice * src/shapes.f90: arbitrary function can also be plotted as a shape: more flexible in terms of line style, colour etc git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1179 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-05 dprice * src/particleplot.f90: bug fixes with lines + 3D perspective git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1178 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-05 dprice * src/plotstep.f90: bug fixes with lines + rotation; no prompt for unit magnification distance; rotated axes: bug fix if coords not in first ndim columns git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1177 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-05 dprice * src/plotlib_giza.f90: plotlib_giza cleaned up; few more things added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1176 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-08-05 dprice * src/read_data_ascii.f90: asplash recognises coordinates even if they are not in the first ndim columns git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1172 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/interactive.f90: bug fix with F/f in interactive mode git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1168 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * build/Makefile: bug fix with build order git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1167 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * docs/splash.tex: docs updated for SPLASH_DEFAULTS git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1166 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/menu.f90: removed PDF option from the main menu unless SPLASH_TURB=yes is set git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1165 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/splash.f90: Monash email address updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1164 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/splash.f90: implemented SPLASH_DEFAULTS environment variable that can be used to set a system-wide defaults file used if no local files are present git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1163 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/analysis.f90: splash calc energies now only uses particle types that are turned on git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1162 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/asciiutils.f90, src/read_data_ascii.f90: improved treatment of blank lines in header of ascii data git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1161 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * docs/splash.tex, src/read_data_ascii.f90: added several more environment variable for getting the time and gamma from the header in the ascii data read; added to docs also git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1160 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/get_data.f90: warning added if set ix but number of dimensions not set correctly from data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1159 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/plotstep.f90: .le.ndim -> is_coords; now done everywhere so in principle everything should work if coords are not in the first ndim columns git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1158 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/interactive.f90: .le.ndim -> is_coord git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1157 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/particleplot.f90: uses is_coord instead of .le.ndim git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1156 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/particleplot.f90: neatened up source code git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1155 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/limits.f90: coords not assumed in 1:ndim => uses ix() explicitly git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1154 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/options_limits.f90: uses is_coord instead of .le.ndim; neatened up formatting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1153 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/exact.f90: .le.ndim --> is_coord in exact solution plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1152 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * tests/test_interpolate3D.f90: test uses new interface to interpolate3D_projection git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1151 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/render.f90: render accepts non-square pixels git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1150 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-28 dprice * src/interpolate3D_opacity.f90, src/interpolate3D_projection.F90, src/plotstep.f90: changes to 3D interpolation interfaces: can use different pixel width in the y direction; plus 3D opacity rendering now ignores particles with zero or negative weights git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1149 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-23 dprice * build/Makefile: build added for prompt and slicer tests git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1148 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-23 dprice * src/calc_quantities.f90: editing of individual calc quantities entries now works; plus uses same routine to print the quantities at startup git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1147 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-23 dprice * src/calc_quantities.f90: edit option in calc quantities setting: can now choose which column git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1145 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-23 dprice * src/read_data_egaburov.f90: read by E.Gaburov added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1144 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-23 dprice * src/prompting.f90: integer prompt with min2:max2 range tested and working git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1142 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-22 dprice * src/prompting.f90: integer prompt handles two ranges (not checked yet) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1141 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-22 dprice * src/prompting.f90: integer prompt handles two ranges (not checked yet) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1140 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-22 dprice * src/plotlib_giza.f90: bug fix with translation of tr to affine; added new utility routine for this git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1139 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-22 dprice * src/exact.f90, src/exact_mhdshock.f90: all MHD shock tube solutions are labelled and work for all times git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1138 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-21 dprice * src/exact_function.f90: less confusing naming of internal routines in exact_function git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1137 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-21 dprice * src/exact_function.f90: exact solution can be f(x,t) not just f(x) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1136 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-21 dprice * src/exact.f90: exact solution can be f(x,t) not just f(x) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1135 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-21 dprice * src/exact.f90, src/exact_function.f90: exact solution can be f(x,t) not just f(x) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1134 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-21 dprice * src/exact_mhdshock.f90: added time scaling for mshk7 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1133 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-21 dprice * src/exact_mhdshock.f90: Brio/Wu problem scaled with time git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1132 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-17 dprice * src/read_data_gadget.f90, src/read_data_gadget_hdf5.f90, src/read_data_gadget_jsb.f90: added correct labels for gadget particle types 3 and 4 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1131 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-17 dprice * src/plotlib_giza.f90: implemented more of plot_qinf in giza interface git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1130 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-17 dprice * .gitignore: added some more files to .gitignore git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1129 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-17 dprice * src/read_data_gadget_hdf5.f90, src/read_data_gadget_hdf5_utils.c: gadget HDF5 read: so far just reads the header git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1128 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-17 dprice * build/Makefile: gadget hdf5 read added to Makefile; tests build correctly git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1127 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-17 dprice * src/read_data_flash_hdf5_utils.c: bug fix with number of datasets read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1126 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-17 dprice * src/plotlib_giza.f90: plot_numb interface calls giza_format_number -- seems to work OK git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1125 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-07-06 dprice * src/read_data_sphNG.f90: plots sink particles from phantom with binary potential git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1099 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-20 dprice * src/plotlib_giza.f90: Added the interface for plot_circ and plot_arro. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1015 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-17 dprice * src/read_data_gadget.f90: minor bug fix with uninitialised hsoft variable in gadget read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1005 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-17 dprice * src/read_data_gadget.f90: multi-file gadget read tested with block-labelled format and seems to work OK; info about neighbour number added; slight bug fix with this git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@1004 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/get_data.f90: bug fix with minimum h setting (now not applied to -ve smoothing lengths) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@999 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/read_data_gadget.f90: some minor cleanups to gadget read: better errors/warnings git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@998 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/read_data_gadget.f90: particle id read code neatened; plus bug fix with rescaling of h git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@997 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/read_data_gadget.f90: cleanup after multiple file read stuff; commented out sections removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@996 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/options_xsecrotate.f90: trailing whitespace fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@995 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/options_xsecrotate.f90: slightly more user-friendly prompts when setting animation sequences git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@994 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/interpolate3D_projection.F90: minor update to warning about h <= 0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@993 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-13 dprice * src/read_data_gadget.f90: GADGET read across multiple files: bugs fixed, tested and seems to work OK git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@992 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-12 dprice * src/read_data_gadget.f90: neighbour warning happens only once git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@991 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-12 dprice * src/read_data_gadget.f90: neighbour warning happens only once git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@990 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-12 dprice * src/read_data_gadget.f90: clean up of multiple file read; should work with all formats + dm smoothing lengths; friendly neighbour warning added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@989 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-12 dprice * docs/splash.tex: minor doc changes git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@988 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * src/read_data_gadget.f90: gadget read seems to work across multiple files; a few issues remaining git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@987 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * src/convert_grid.f90: parallel min/max/mean on grid commented (reduction on arrays does not work with ifort 10) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@986 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * docs/splash.tex: docs updated with splash to grid + splash_vzero_codeunits git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@985 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * src/splash.f90: date updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@984 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * scripts/time_average_pdfs.f90: bug with checking bin positions fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@983 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * src/convert_grid.f90: SPLASH_TO_GRID_DENSITY_ONLY; plus counts how many empty grid cells there are git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@982 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * src/pdfs.f90: bug with normalisation fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@981 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-11 dprice * src/get_data.f90: environment variable SPLASH_VZERO_CODEUNITS added to subtract mean velocity field git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@980 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-10 dprice * src/plotlib_giza.f90: bug fix in plot_vect interface to giza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@979 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-10 dprice * src/read_data_h5part.f90: minor changes to format statements git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@978 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-07 dprice * src/plotlib_giza.f90: Added vectors to interface. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@977 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-05 dprice * src/plotstep.f90: debug statements added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@973 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-05 dprice * src/options_powerspec.f90, src/pdfs.f90, src/plotstep.f90: pdf calculation more obvious: always does raw quantity (not transformed); pdf options moved to iotions_powerspec, will be saved; means pdf is a more standalone module git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@972 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-05 dprice * src/convert.f90: bug fix with low memory mode + splash to grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@971 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-05 dprice * src/convert_grid.f90: env variable for density only in splash to grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@970 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-05 dprice * src/analysis.f90: uses tagline git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@969 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-05 dprice * src/write_griddata.F90: minor git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@968 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/calc_quantities.f90: default prompt reverts to q after first entry in calc_quantities git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@967 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/allocate.f90, src/exact_shock_sr.f90, src/interpolate3D.f90, src/plotlib_giza.f90, src/write_data_phantom.f90: compiler warnings fixed (g95) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@966 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * build/Makefile: read_data_sphNG_otherendian now builds; does not leave .f90 files in build dir git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@965 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/convert_grid.f90: compiled warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@964 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * build/Makefile, utils/grid2pdf.f90: added grid2pdf utility that calculates PDF from output of splash to gridbinary git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@963 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/splash.f90: new module names git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@962 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/pdfs.f90, src/plotstep.f90: pdf module restructured so more standalone; not dependent on plotting library; calc separate to write git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@961 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/globaldata.f90: tagline updated git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@960 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/convert.f90, src/convert_grid.f90, src/write_griddata.F90: write_griddata module renamed readwrite_griddata; read routines added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@959 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-05-03 dprice * src/write_griddata.F90: gridbinary format explicitly explained in the command line options git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@958 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-29 dprice * src/read_data_VINE.f90: VINE read ignores ipindx array if there are values < 0 or > ntot; other minor changes git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@957 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-27 dprice * src/analysis.f90: rhomach calculation volume setting affects mean only, not variance git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@956 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-23 dprice * docs/splash.tex: page size larger; manual is smaller git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@955 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-23 dprice * src/legends.f90: bug fix with set/unset line cap/style for legends with giza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@954 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-22 dprice * build/Makefile: giza objects only defined if BACKEND=giza git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@953 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-22 dprice * src/options_particleplots.f90, src/particleplot.f90, src/plotstep.f90: implemented more general error bars; can be for x and y axis; error bar location for each column stored; also bug fix/regression with interactive change of irender git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@952 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-22 dprice * src/read_data_ascii.f90: docs added to header git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@951 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-22 dprice * docs/splash.tex: updated endian section; details of h5part read added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@950 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-22 dprice * src/plotlib_pgplot.f90: minor change git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@949 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-12 dprice * build/Makefile: h5part compiles in munich git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@948 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-12 dprice * src/splash.f90: bumped version number/date git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@947 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-12 dprice * src/options_xsecrotate.f90: sets default rotation if none is set when 3D perspective turned on git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@946 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-12 dprice * build/Makefile: H5partAttrib added to build git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@945 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-12 dprice * src/interactive.f90, src/plotstep.f90: f/F flips rendered quantity to next one (only for 1-plot-per-page interactive call) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@944 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-08 dprice * src/plotstep.f90: debugging of step legend, minor formatting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@943 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-08 dprice * src/H5Part/H5Part.F90, src/H5Part/H5Pt.F90: .F90 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@942 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-08 dprice * src/H5Part/H5Part.f90, src/H5Part/H5Pt.F90: rename to .F90 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@941 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-08 dprice * src/H5Part/H5Part.f90, src/H5Part/H5PartAttrib.f90, src/H5Part/H5PartAttribF.c, src/H5Part/H5PartF.c, src/read_data_h5part.f90: finished the new H5Part interface (phew!); h5part read now seems to work OK git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@940 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-08 dprice * src/interactive.f90, src/plotlib_pgplot.f90, src/plotstep.f90, src/shapes.f90: Changed plot_curs and plot_band to functinos, all calls modified accordingly. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@939 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-08 dprice * build/Makefile, src/interactive.f90, src/plotlib_giza.f90, src/plotlib_pgplot.f90: Added plot_left_click to the plot libs. Changed giza-fortran.f90 to giza-fortran.F90. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@938 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-04-07 dprice * src/plotlib_giza.f90: Modified the call to giza_render. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@937 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-31 dprice * src/plotstep.f90: legend and shapes only plotted once per page (avoids multiple antialiasing in giza) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@926 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-31 dprice * src/shapes.f90: text shape editing starts from first character (no need to delete -click to edit- first) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@925 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-31 dprice * src/plotlib_giza.f90: more warnings added for unimplemented functionality git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@924 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-31 dprice * src/plotlib_pgplot.f90: minor formatting changes; comments added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@923 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-31 dprice * src/plotlib_giza.f90: added error bar interface and get/set fill style; comments added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@922 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-29 dprice * src/plotstep.f90: paper size set in plot_init; plus axes only drawn once if multiple-steps-on-page git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@921 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-29 dprice * src/plotlib_giza.f90, src/plotlib_pgplot.f90: plot_init handles optional paper size git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@920 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-29 dprice * src/setpage.f90: only redraw axes if using PGPLOT git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@919 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-29 dprice * src/pagecolours.f90: bug fix with page colours the wrong way around! git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@918 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-28 dprice * src/plotstep.f90: bug fix with openMP statements in plotstep git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@917 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * src/read_data_h5part.f90: reads particle IDs and distinguishes between types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@916 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * src/read_data_h5part.f90: reads particle IDs and distinguishes between types git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@915 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * src/plotstep.f90: plotstep works even if coords are not in the first ndim columns git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@914 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * src/H5Part/H5Part.f90, src/H5Part/H5PartAttribF.c, src/H5Part/H5PartF.c: removed unnecessary underscoring business from h5part interface; uses bind(C) instead git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@913 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * src/H5Part/H5Part.f90: version without the bind(C) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@912 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * build/Makefile: h5part reader added; better linking to HDF5 libraries git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@911 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * src/globaldata.f90, src/menu.f90: is_coord function added; used so that coords can be anywhere in data git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@910 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-25 dprice * src/H5Part/COPYING, src/H5Part/H5Part.f90, src/H5Part/H5PartAttribF.c, src/H5Part/H5PartF.c, src/H5Part/README, src/read_data_h5part.f90: h5part reader added; with modified Fortran interface git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@909 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-17 dprice * src/plotlib_giza.f90: added plot_circ, qch and sfs/qfs to giza interface git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@908 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-15 dprice * src/plotstep.f90: minor formatting changes; additional debugging output added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@907 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-15 dprice * src/particleplot.f90: bug fix with commented-out line in particleplot.f90 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@906 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-15 dprice * src/calc_quantities.f90: maximum number of calculated quantities increased to 35; plus bugs fixed + message printed when this limit is reached git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@905 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-05 dprice * build/Makefile: h5part depends on H5part.o git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@904 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-05 dprice * build/Makefile: working on giza backend compilation; compiles ok, new giza-fortran.f90; also started h5part read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@903 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-04 dprice * build/Makefile: bug fix with auto library adding if compiler does not match PGPLOT git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@902 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-04 dprice * src/read_data_tipsy.F90: velocity labels fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@901 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-04 dprice * build/Makefile: Makefile is able to compile with the giza backend; plus much more user-friendly for PGPLOT; ensures PGPLOT_DIR is set plus adds compiler libraries for g77, g95 and gfortran-compiled PGPLOT automatically git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@900 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * bin/tmp: removed tmp git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@899 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * bin/tmp: bin dir added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@898 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * src/plotlib_cpl.f90: removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@897 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * src/plotlib_giza.f90: fixed a few things with the interface [intent(out) variables set, renamed to giza] git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@896 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * src/isosurface.f90: obsolete file removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@895 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * Makefile, build/Makefile: build works with subdirs git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@894 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * Makefile, build/Makefile, src/Makefile: build works with subdirs git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@893 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * Makefile, allocate.f90, analysis.f90, asciiutils.f90, calc_quantities.f90, colourbar.f90, colourparts.f90, colours.f90, convert.f90, convert_grid.f90, defaults.f90, discplot.f90, exact.f90, exact_densityprofiles.f90, exact_fromfile.f90, exact_function.f90, exact_mhdshock.f90, exact_mhdshock_other.f90, exact_polytrope.f90, exact_rhoh.f90, exact_ringspread.f90, exact_sedov.f90, exact_shock.f90, exact_shock_sr.f90, exact_torus.f90, exact_toystar1D.f90, exact_toystar2D.f90, exact_wave.f90, fieldlines.f90, fparser.f90, geometry.f90, get_data.f90, globaldata.f90, interactive.f90, interpolate1D.f90, interpolate2D.f90, interpolate3D.f90, interpolate3D_opacity.f90, interpolate3D_projection.F90, interpolate3D_xsec.f90, interpolate_vec.f90, interpolation.f90, isosurface.f90, legends.f90, limits.f90, menu.f90, options_data.f90, options_limits.f90, options_page.f90, options_particleplots.f90, options_powerspec.f90, options_render.f90, options_vecplot.f90, options_xsecrotate.f90, pagecolours.f90, particleplot.f90, pdfs.f90, plotlib_cpl.f90, plotlib_pgplot.f90, plotstep.f90, plotutils.f90, powerspectrums.f90, prompting.f90, read_data_UCLA.f90, read_data_VINE.f90, read_data_ascii.f90, read_data_bauswein.f90, read_data_dansph.f90, read_data_dansph_old.f90, read_data_dragon.f90, read_data_flash_hdf5.f90, read_data_flash_hdf5_utils.c, read_data_foulkes.f90, read_data_gadget.f90, read_data_gadget_jsb.f90, read_data_jjm.f90, read_data_jjm_multiphase.f90, read_data_jules.f90, read_data_kitp.f90, read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90, read_data_oilonwater.f90, read_data_rsph.f90, read_data_scw.f90, read_data_snsph.f90, read_data_snsph_utils.c, read_data_sphNG.f90, read_data_spyros.f90, read_data_sro.f90, read_data_tipsy.F90, read_data_urban.f90, read_data_vanaverbeke.f90, render.f90, rotate.f90, setpage.f90, shapes.f90, splash.f90, src/Makefile, src/allocate.f90, src/analysis.f90, src/asciiutils.f90, src/calc_quantities.f90, src/colourbar.f90, src/colourparts.f90, src/colours.f90, src/convert.f90, src/convert_grid.f90, src/defaults.f90, src/discplot.f90, src/exact.f90, src/exact_densityprofiles.f90, src/exact_fromfile.f90, src/exact_function.f90, src/exact_mhdshock.f90, src/exact_mhdshock_other.f90, src/exact_polytrope.f90, src/exact_rhoh.f90, src/exact_ringspread.f90, src/exact_sedov.f90, src/exact_shock.f90, src/exact_shock_sr.f90, src/exact_torus.f90, src/exact_toystar1D.f90, src/exact_toystar2D.f90, src/exact_wave.f90, src/fieldlines.f90, src/fparser.f90, src/geometry.f90, src/get_data.f90, src/globaldata.f90, src/interactive.f90, src/interpolate1D.f90, src/interpolate2D.f90, src/interpolate3D.f90, src/interpolate3D_opacity.f90, src/interpolate3D_projection.F90, src/interpolate3D_xsec.f90, src/interpolate_vec.f90, src/interpolation.f90, src/isosurface.f90, src/legends.f90, src/limits.f90, src/menu.f90, src/options_data.f90, src/options_limits.f90, src/options_page.f90, src/options_particleplots.f90, src/options_powerspec.f90, src/options_render.f90, src/options_vecplot.f90, src/options_xsecrotate.f90, src/pagecolours.f90, src/particleplot.f90, src/pdfs.f90, src/plotlib_cpl.f90, src/plotlib_pgplot.f90, src/plotstep.f90, src/plotutils.f90, src/powerspectrums.f90, src/prompting.f90, src/read_data_UCLA.f90, src/read_data_VINE.f90, src/read_data_ascii.f90, src/read_data_bauswein.f90, src/read_data_dansph.f90, src/read_data_dansph_old.f90, src/read_data_dragon.f90, src/read_data_flash_hdf5.f90, src/read_data_flash_hdf5_utils.c, src/read_data_foulkes.f90, src/read_data_gadget.f90, src/read_data_gadget_jsb.f90, src/read_data_jjm.f90, src/read_data_jjm_multiphase.f90, src/read_data_jules.f90, src/read_data_kitp.f90, src/read_data_mbate.f90, src/read_data_mbate_hydro.f90, src/read_data_mbate_mhd.f90, src/read_data_oilonwater.f90, src/read_data_rsph.f90, src/read_data_scw.f90, src/read_data_snsph.f90, src/read_data_snsph_utils.c, src/read_data_sphNG.f90, src/read_data_spyros.f90, src/read_data_sro.f90, src/read_data_tipsy.F90, src/read_data_urban.f90, src/read_data_vanaverbeke.f90, src/render.f90, src/rotate.f90, src/setpage.f90, src/shapes.f90, src/splash.f90, src/system_f2003.f90, src/system_unix.f90, src/system_unix_NAG.f90, src/system_utils.f90, src/timestepping.f90, src/titles.f90, src/transform.f90, src/units.f90, src/write_data_phantom.f90, src/write_griddata.F90, src/write_pixmap.f90, src/write_sphdata.f90, system_f2003.f90, system_unix.f90, system_unix_NAG.f90, system_utils.f90, timestepping.f90, titles.f90, transform.f90, units.f90, write_data_phantom.f90, write_griddata.F90, write_pixmap.f90, write_sphdata.f90: files moved to sub-directory src/ git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@892 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * README: updated contact details git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@891 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-03-03 dprice * scripts/ppm2gif.bash: uses splash filenames not supersphplot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@890 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * docs/version_history, docs/version_history_tex.tex: version 1.13.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@889 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.13.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@888 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * splash.f90: v1.13.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@887 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * splash.f90: v1.13.1 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@886 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * interpolate3D_projection.F90: subgrid warning if nsubgrid > 10% of particles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@885 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * interactive.f90: better message when pressing s git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@884 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * interpolate3D_projection.F90: added warning about subgrid rendering; info about resolution required git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@883 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * options_data.f90: better menu behaviour if calcquantities is initially off git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@882 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-26 dprice * calc_quantities.f90: calc_quantities compiles with ifort; bugs with subsequent variables and label settings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@881 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * splash.f90: version changed to -svn git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@880 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * plotstep.f90: page colour schemes handled slighly differently to avoid use of pgscrn; also simpler; explicit refs to PGPLOT removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@879 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * Makefile, options_page.f90, pagecolours.f90: page colour schemes handled slighly differently to avoid use of pgscrn; also simpler; explicit refs to PGPLOT removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@878 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * calc_quantities.f90: bug fix with physical unit rescaling (ncalc not icalc) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@877 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * render.f90: render_opacity removed (obsolete) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@876 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * plotlib_cpl.f90, plotlib_pgplot.f90, plotstep.f90: bug fix with auto pixel selection (min now 1); check for PGPLOT bugs only done if lib is pgplot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@875 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * interactive.f90: bug fix with a) on multipanel plots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@874 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * interactive.f90: bug fix with a) on multipanel plots git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@873 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * Makefile: resolved conflict git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@872 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * plotlib_pgplot.f90: added header to plotlib routine git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@871 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * splash.f90: added credit to james git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@870 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-25 dprice * Makefile, colourbar.f90, colourparts.f90, colours.f90, discplot.f90, exact.f90, exact_toystar1D.f90, exact_toystar2D.f90, fieldlines.f90, interactive.f90, legends.f90, options_page.f90, particleplot.f90, plotstep.f90, plotutils.f90, render.f90, rotate.f90, setpage.f90, shapes.f90, timestepping.f90: PGPLOT calls replaced by calls to generic plot interface (work by James Wetter) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@869 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * Makefile: permissions fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@868 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * read_data_flash_hdf5_utils.c: permissions fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@867 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * LICENSE, plotlib_cpl.f90, plotlib_pgplot.f90: permissions fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@866 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.13.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@865 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * splash.f90: v1.13.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@864 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * calc_quantities.f90, defaults.f90, options_data.f90: function parser implemented for calc_quantities; tested and seems to work git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@863 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * globaldata.f90: lenunitslabel added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@862 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * menu.f90: print statement removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@861 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * fparser.f90: verboseness optional argument to checkf and parsef git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@860 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * docs/splash.tex: docs updated for 1.13.0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@859 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * calc_quantities.f90: bug fix with units label git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@858 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * read_data_sphNG.f90: bug fix with uninitialised variables git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@857 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * prompting.f90: updated contact details git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@856 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * prompting.f90: string prompt does not accept blank string if noblank=.true. git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@855 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * read_data_ascii.f90: nicer formatting in file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@854 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * INSTALL, INSTALL.macosx, README: permissions changed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@853 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * : figs added to repository git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@852 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * read_data_VINE.f90, read_data_ascii.f90, read_data_bauswein.f90, read_data_dansph.f90, read_data_dansph_old.f90, read_data_gadget_jsb.f90, read_data_jjm.f90, read_data_kitp.f90, read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90, read_data_oilonwater.f90, read_data_rsph.f90, read_data_scw.f90, read_data_snsph.f90, read_data_sphNG.f90, read_data_spyros.f90, read_data_sro.f90, read_data_urban.f90: format printed at the start of all data reads git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@851 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * read_data_timli.f90: renamed to jjm_multiphase git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@850 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * read_data_jjm_multiphase.f90: renamed to jjm_multiphase git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@849 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * plotlib_pgplot.f90: plotlib added for pgplot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@848 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * plotlib_cpl.f90: added plotlib for cairoplot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@847 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * get_data.f90: more error checks on data read added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@846 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * get_data.f90: debugging statements added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@845 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * menu.f90: bug fix if ncolumns=0 from data read + menu git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@844 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * read_data_urban.f90: bug fix with urban data read if no columns found git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@843 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-24 dprice * Makefile: the splash binary is now the same as asplash git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@842 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-10 dprice * menu.f90: re-formatting; plus no extra columns if ncolumns=0 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@833 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-10 dprice * get_data.f90, read_data_urban.f90: bug fix with ncol<0 in data reads: added check for this git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@832 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-10 dprice * read_data_urban.f90: reads time; fixed bug with not closing file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@831 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-05 dprice * read_data_urban.f90: sink particle file name substitutes _number for _S git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@830 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-02 dprice * Makefile, docs/splash.tex: urban binary called usplash git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@829 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-02-02 dprice * docs/splash.tex: andrea urban format added to docs git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@828 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-27 dprice * read_data_ascii.f90: vector labels are set by default git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@827 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-27 dprice * prompting.f90: optional list argument to string prompt git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@826 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-27 dprice * get_data.f90: units labels always applied if iRescale is true git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@825 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-27 dprice * fparser.f90: checks for -ve numbers to fractional powers and zero to negative power git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@824 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-27 dprice * Makefile, read_data_urban.f90: data read added for Andrea Urban git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@823 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-27 dprice * plotstep.f90: uninitialised variable errors fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@822 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-25 dprice * plotstep.f90: bug fix with unset variables if irotate but not coord plot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@821 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-21 dprice * get_data.f90: nicer endian info printout git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@820 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-21 dprice * prompting.f90: uses len_trim instead of len(trim()) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@819 cab04810-efc7-4a10-8ecf-f366c833a2ad 2010-01-21 dprice * plotstep.f90: catches incorrect setting of iplotx,iploty to avoid seg fault if internal error git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@818 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-12-23 dprice * options_page.f90, plotstep.f90: panels can be plotted in column-major or row-major order git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@817 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-12-23 dprice * interactive.f90: extra safety on the panel determination git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@816 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-12-23 dprice * plotstep.f90: iplotxtemp and iplotytemp given default values for safety (prevents seg fault even if plotting page is screwed up) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@815 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-12-15 dprice * options_page.f90, timestepping.f90: allows max colour index setting and mod for line styles git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@814 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-12-15 dprice * globaldata.f90, read_data_gadget.f90: added iax label + sink particle type for gadget read (from Florian Buerzle) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@813 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-12-04 dprice * setpage.f90: bug fix with labelling of the y-axis and tiling git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@812 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-04 dprice * get_data.f90, menu.f90, options_data.f90, splash.f90: single routine used for resetting coordinate and vector labels after coordinate system change; fixes bugs with labels not being set properly under some circumstances git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@780 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-04 dprice * convert_grid.f90: skips interpolation if array is zero git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@779 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-03 dprice * convert_grid.f90: does velocity components one at a time if large grid used git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@778 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-03 dprice * convert_grid.f90, interpolate3D.f90, write_griddata.F90: added gridtest format; sub-grid interpolation implemented on 3D interpolation, gives much better results git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@777 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-03 dprice * write_griddata.F90: returns ierr = 0 if not set git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@776 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-03 dprice * write_sphdata.f90: created by git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@775 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-03 dprice * write_griddata.F90: jumps out if error in write git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@774 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-03 dprice * globaldata.f90, write_griddata.F90, write_sphdata.f90: implemented ascii grid format (also default) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@773 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-03 dprice * convert.f90, convert_grid.f90, interpolate3D.f90, write_griddata.F90: bug fixes in splash to grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@772 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * Makefile: new files added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@771 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * convert.f90, convert_grid.f90, interpolate3D.f90, plotstep.f90, powerspectrums.f90, splash.f90, write_griddata.F90: splash to grid feature implemented; seems to work ok (limited formats at present) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@770 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * get_data.f90: better checks on labels (checks ix.ne.0 if ndim>0) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@769 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * analysis.f90: minor change to log output for rhomach git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@768 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * INSTALL: comments on old gfortran added to install instructions git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@767 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * Makefile, interpolation.f90, plotstep.f90: set_interpolation_weights moved to separate module so can be called for sph to grid conversion git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@766 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * Makefile: added SYSTEM for old gfortran; new gfortran uses f2003 system file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@765 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-11-02 dprice * read_data_mbate.f90: reads all headers first to allocate memory properly; fixes seg fault git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@764 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-19 dprice * analysis.f90: variance and mean of ln(rho) computed in calc rhomach git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@760 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-19 dprice * particleplot.f90: line colour but not style used for error bars git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@759 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-09 dprice * analysis.f90: rhomach spits out b values also git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@52 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-09 dprice * Makefile: build order fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@51 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-09 dprice * analysis.f90: calc rhomach fixed; option to override volume with environment variable; spits out more to file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@50 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-09 dprice * analysis.f90: added calc rms and vrms, plus rhomach calculation using Knuth-style variance git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@49 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-08 dprice * Makefile: added build for gadget dual endian read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@48 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-08 dprice * get_data.f90: commented out stuff about read_data_otherendian git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@47 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-08 dprice * interpolate3D_opacity.f90: added commented-out parallelisation from zen git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@46 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-08 dprice * calc_quantities.f90: minor changes from zen (to dudtrad) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@45 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-10-08 dprice * Makefile: merged changes from zen into makefile: read_data_otherendian for sphNG stuff added git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@44 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-28 dprice * docs/splash.tex: docs added for splash calc timeaverage git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@43 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-28 dprice * interactive.f90, shapes.f90: ctrl-t adds a text shape at current location; seems to work ok git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@42 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-28 dprice * exact.f90, globaldata.f90, read_data_dansph.f90: sr shock tube solution for rho* plotted; plus memory explicitly allocated/deallocated for exact soln plotting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@41 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-28 dprice * get_data.f90: less verbose: timing only printed if takes > 1s for data read git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@40 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-28 dprice * exact_shock_sr.f90: special rel shock tube zooms correctly, instead of fixed x grid git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@39 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-17 dprice * read_data_sphNG.f90: out-of-bounds error in low mem sphNG read fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@38 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * analysis.f90, convert.f90: added ability to compute time average of a whole sequence of files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@37 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * read_data_ascii.f90: reads splash.columns file in preference to columns git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@36 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * fparser.f90: BUG FIX: exits after calling ParseErrMsg; avoids array-out-of-bounds error git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@35 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * exact.f90: uses read_asciifile to read .func files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@34 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * asciiutils.f90: bug fix if comments at the end of real columns: now works ok (gets n columns correctly) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@33 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * asciiutils.f90: bug fixes with error returned (0 by default) on read_asciifile; also spurious warning if nlines=nmax removed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@32 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * exact_function.f90: allow less verbose checking git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@31 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * exact.f90: allow up to 10 functions; functions can be read from .func file (dumpfile.func or splash.func) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@30 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * Makefile: added cleanall and distclean target to remove installed files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@29 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * get_data.f90: endian info printed first time; neatened up formatting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@28 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * legends.f90: blank legend entries are not printed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@27 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-09-04 dprice * interactive.f90: less verbose if non-interactive device git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@26 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * plotstep.f90: legend entries continue over multiple panels if there are enough lines in the step legend file git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@25 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * get_data.f90: unused variables removed from only clauses git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@24 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * Makefile: added install target; controlled by DEST= setting git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@23 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * fparser.f90: commented out unused routines/calls git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@22 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * exact.f90: allows up to five functions to be plotted git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@21 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * plotstep.f90: bug fix with log labels if iaxis=20 git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@20 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * fparser.f90: function parser recognises mathematical constants (currently just pi) and parses them (not using substitution) git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@19 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-27 dprice * exact.f90, exact_function.f90: implemented sub-functions in call to function parser git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@18 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-10 dprice * exact_function.f90: minor change git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@17 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-07 dprice * write_data_phantom.f90: compiler warnings fixed git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@16 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-07 dprice * asciiutils.f90: string_replace does all occurrences git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@15 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-07 dprice * Makefile: function parser added; new exact solution plots arbitrary function git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@14 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-07 dprice * exact.f90, exact_function.f90, fparser.f90: function parser added; new exact solution plots arbitrary function git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@13 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-08-07 dprice * allocate.f90, analysis.f90, asciiutils.f90, calc_quantities.f90, colourbar.f90, colourparts.f90, colours.f90, convert.f90, defaults.f90, discplot.f90, exact.f90, exact_densityprofiles.f90, exact_fromfile.f90, exact_mhdshock.f90, exact_mhdshock_other.f90, exact_polytrope.f90, exact_rhoh.f90, exact_ringspread.f90, exact_sedov.f90, exact_shock.f90, exact_shock_sr.f90, exact_torus.f90, exact_toystar1D.f90, exact_toystar2D.f90, exact_wave.f90, fieldlines.f90, geometry.f90, get_data.f90, globaldata.f90, interactive.f90, interpolate1D.f90, interpolate2D.f90, interpolate3D.f90, interpolate3D_opacity.f90, interpolate3D_projection.F90, interpolate3D_xsec.f90, interpolate_vec.f90, isosurface.f90, legends.f90, limits.f90, menu.f90, options_data.f90, options_limits.f90, options_page.f90, options_particleplots.f90, options_powerspec.f90, options_render.f90, options_vecplot.f90, options_xsecrotate.f90, particleplot.f90, pdfs.f90, plotstep.f90, plotutils.f90, powerspectrums.f90, prompting.f90, read_data_UCLA.f90, read_data_VINE.f90, read_data_ascii.f90, read_data_bauswein.f90, read_data_dansph.f90, read_data_dansph_old.f90, read_data_dragon.f90, read_data_flash_hdf5.f90, read_data_foulkes.f90, read_data_gadget.f90, read_data_gadget_jsb.f90, read_data_jjm.f90, read_data_jules.f90, read_data_kitp.f90, read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90, read_data_oilonwater.f90, read_data_rsph.f90, read_data_scw.f90, read_data_snsph.f90, read_data_sphNG.f90, read_data_spyros.f90, read_data_sro.f90, read_data_timli.f90, read_data_tipsy.F90, read_data_vanaverbeke.f90, render.f90, rotate.f90, setpage.f90, shapes.f90, splash.f90, system_f2003.f90, system_unix.f90, system_unix_NAG.f90, system_utils.f90, timestepping.f90, titles.f90, transform.f90, units.f90, write_data_phantom.f90, write_pixmap.f90, write_sphdata.f90: header notice added to all .f90 files git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@12 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-24 dprice * plotstep.f90: prints limits for non-interactive plots for the first plot git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@11 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-23 dprice * read_data_dansph.f90: added labels for vector potential git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@10 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-17 dprice * Makefile: adds openMP flags if OPENMP=yes or if PARALLEL=yes git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@9 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-17 dprice * : commit 523eb26e751b3fa84eb22b5e6cb92d307dd20ed0 Author: dprice Date: Fri Jul 17 12:34:51 2009 +0000 2009-07-17 dprice * : deleted empty dirs git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@6 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-17 Daniel Price * docs/splash.tex: updated thanks to users 2009-07-17 dprice * trunk/Makefile: test of svn commit git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@5 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-17 dprice * Makefile: test of svn commit git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash/trunk@5 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-17 dprice * : 328 0 trunk/INSTALL 112 0 trunk/INSTALL.macosx 280 0 trunk/LICENSE 692 0 trunk/Makefile 23 0 trunk/README 250 0 trunk/allocate.f90 471 0 trunk/analysis.f90 374 0 trunk/asciiutils.f90 433 0 trunk/calc_quantities.f90 335 0 trunk/colourbar.f90 29 0 trunk/colourparts.f90 410 0 trunk/colours.f90 91 0 trunk/convert.f90 269 0 trunk/defaults.f90 167 0 trunk/discplot.f90 1181 0 trunk/docs/bibstyle.bst 8488 0 trunk/docs/figs/colourschemes.ps 22724 0 trunk/docs/figs/hyperbolic.ps - - trunk/docs/figs/sedov_example.png - - trunk/docs/figs/starpart1.png - - trunk/docs/figs/starpart2.png - - trunk/docs/figs/starpart3.png - - trunk/docs/figs/starpart4.png - - trunk/docs/figs/starpart5.png - - trunk/docs/figs/starpart6.png - - trunk/docs/figs/starpartfinal.png - - trunk/docs/figs/surfdens.pdf - - trunk/docs/figs/surfpart1.png - - trunk/docs/figs/surfpart2.png - - trunk/docs/figs/surfpart3.png - - trunk/docs/figs/surfpart4.png - - trunk/docs/figs/surfpart5.png - - trunk/docs/figs/surfpart6.png - - trunk/docs/figs/surfpartfinal.png 551 0 trunk/docs/figs/xsec2D.eps 61 0 trunk/docs/figs/xsec2D.fig 177 0 trunk/docs/figs/xsec3D.eps 33 0 trunk/docs/figs/xsec3D.fig 44 0 trunk/docs/splash.bbl 2576 0 trunk/docs/splash.tex 1 0 trunk/docs/version 98 0 trunk/docs/version_history 38 0 trunk/docs/version_history_tex.tex 936 0 trunk/exact.f90 100 0 trunk/exact_densityprofiles.f90 48 0 trunk/exact_fromfile.f90 446 0 trunk/exact_mhdshock.f90 261 0 trunk/exact_mhdshock_other.f90 104 0 trunk/exact_polytrope.f90 47 0 trunk/exact_rhoh.f90 321 0 trunk/exact_ringspread.f90 247 0 trunk/exact_sedov.f90 400 0 trunk/exact_shock.f90 850 0 trunk/exact_shock_sr.f90 122 0 trunk/exact_torus.f90 414 0 trunk/exact_toystar1D.f90 465 0 trunk/exact_toystar2D.f90 49 0 trunk/exact_wave.f90 319 0 trunk/fieldlines.f90 531 0 trunk/geometry.f90 441 0 trunk/get_data.f90 185 0 trunk/globaldata.f90 2510 0 trunk/interactive.f90 147 0 trunk/interpolate1D.f90 580 0 trunk/interpolate2D.f90 227 0 trunk/interpolate3D.f90 456 0 trunk/interpolate3D_opacity.f90 790 0 trunk/interpolate3D_projection.F90 327 0 trunk/interpolate3D_xsec.f90 155 0 trunk/interpolate_vec.f90 89 0 trunk/isosurface.f90 279 0 trunk/legends.f90 356 0 trunk/limits.f90 662 0 trunk/menu.f90 219 0 trunk/options_data.f90 238 0 trunk/options_limits.f90 410 0 trunk/options_page.f90 312 0 trunk/options_particleplots.f90 81 0 trunk/options_powerspec.f90 194 0 trunk/options_render.f90 145 0 trunk/options_vecplot.f90 750 0 trunk/options_xsecrotate.f90 613 0 trunk/particleplot.f90 237 0 trunk/pdfs.f90 3561 0 trunk/plotstep.f90 123 0 trunk/plotutils.f90 307 0 trunk/powerspectrums.f90 511 0 trunk/prompting.f90 188 0 trunk/read_data_UCLA.f90 481 0 trunk/read_data_VINE.f90 351 0 trunk/read_data_ascii.f90 250 0 trunk/read_data_bauswein.f90 403 0 trunk/read_data_dansph.f90 519 0 trunk/read_data_dansph_old.f90 659 0 trunk/read_data_dragon.f90 270 0 trunk/read_data_flash_hdf5.f90 304 0 trunk/read_data_flash_hdf5_utils.c 245 0 trunk/read_data_foulkes.f90 975 0 trunk/read_data_gadget.f90 343 0 trunk/read_data_gadget_jsb.f90 197 0 trunk/read_data_jjm.f90 232 0 trunk/read_data_jules.f90 180 0 trunk/read_data_kitp.f90 368 0 trunk/read_data_mbate.f90 314 0 trunk/read_data_mbate_hydro.f90 339 0 trunk/read_data_mbate_mhd.f90 393 0 trunk/read_data_oilonwater.f90 342 0 trunk/read_data_rsph.f90 289 0 trunk/read_data_scw.f90 172 0 trunk/read_data_snsph.f90 115 0 trunk/read_data_snsph_utils.c 1280 0 trunk/read_data_sphNG.f90 230 0 trunk/read_data_spyros.f90 781 0 trunk/read_data_sro.f90 234 0 trunk/read_data_timli.f90 443 0 trunk/read_data_tipsy.F90 256 0 trunk/read_data_vanaverbeke.f90 260 0 trunk/render.f90 293 0 trunk/rotate.f90 36 0 trunk/scripts/cpfiles.bash 59 0 trunk/scripts/fixpgplotnames.bash 37 0 trunk/scripts/getav.pl 9 0 trunk/scripts/ppm2gif.bash 200 0 trunk/scripts/splash_parallel.pl 90 0 trunk/scripts/time_average_pdfs.f90 562 0 trunk/setpage.f90 422 0 trunk/shapes.f90 619 0 trunk/splash.f90 38 0 trunk/system_f2003.f90 39 0 trunk/system_unix.f90 39 0 trunk/system_unix_NAG.f90 145 0 trunk/system_utils.f90 281 0 trunk/tests/test_fieldlines.f90 387 0 trunk/tests/test_interpolate3D.f90 339 0 trunk/timestepping.f90 66 0 trunk/titles.f90 699 0 trunk/transform.f90 276 0 trunk/units.f90 294 0 trunk/write_data_phantom.f90 355 0 trunk/write_pixmap.f90 239 0 trunk/write_sphdata.f90 create mode 100755 trunk/INSTALL create mode 100755 trunk/INSTALL.macosx create mode 100755 trunk/LICENSE create mode 100755 trunk/Makefile create mode 100755 trunk/README create mode 100755 trunk/allocate.f90 create mode 100644 trunk/analysis.f90 create mode 100644 trunk/asciiutils.f90 create mode 100755 trunk/calc_quantities.f90 create mode 100644 trunk/colourbar.f90 create mode 100755 trunk/colourparts.f90 create mode 100755 trunk/colours.f90 create mode 100644 trunk/convert.f90 create mode 100755 trunk/defaults.f90 create mode 100644 trunk/discplot.f90 create mode 100755 trunk/docs/bibstyle.bst create mode 100755 trunk/docs/figs/colourschemes.ps create mode 100755 trunk/docs/figs/hyperbolic.ps create mode 100644 trunk/docs/figs/sedov_example.png create mode 100644 trunk/docs/figs/starpart1.png create mode 100644 trunk/docs/figs/starpart2.png create mode 100644 trunk/docs/figs/starpart3.png create mode 100644 trunk/docs/figs/starpart4.png create mode 100644 trunk/docs/figs/starpart5.png create mode 100644 trunk/docs/figs/starpart6.png create mode 100644 trunk/docs/figs/starpartfinal.png create mode 100644 trunk/docs/figs/surfdens.pdf create mode 100644 trunk/docs/figs/surfpart1.png create mode 100644 trunk/docs/figs/surfpart2.png create mode 100644 trunk/docs/figs/surfpart3.png create mode 100644 trunk/docs/figs/surfpart4.png create mode 100644 trunk/docs/figs/surfpart5.png create mode 100644 trunk/docs/figs/surfpart6.png create mode 100644 trunk/docs/figs/surfpartfinal.png create mode 100755 trunk/docs/figs/xsec2D.eps create mode 100755 trunk/docs/figs/xsec2D.fig create mode 100755 trunk/docs/figs/xsec3D.eps create mode 100755 trunk/docs/figs/xsec3D.fig create mode 100644 trunk/docs/splash.bbl create mode 100755 trunk/docs/splash.tex create mode 100644 trunk/docs/version create mode 100644 trunk/docs/version_history create mode 100644 trunk/docs/version_history_tex.tex create mode 100755 trunk/exact.f90 create mode 100755 trunk/exact_densityprofiles.f90 create mode 100755 trunk/exact_fromfile.f90 create mode 100755 trunk/exact_mhdshock.f90 create mode 100755 trunk/exact_mhdshock_other.f90 create mode 100755 trunk/exact_polytrope.f90 create mode 100755 trunk/exact_rhoh.f90 create mode 100644 trunk/exact_ringspread.f90 create mode 100755 trunk/exact_sedov.f90 create mode 100755 trunk/exact_shock.f90 create mode 100755 trunk/exact_shock_sr.f90 create mode 100755 trunk/exact_torus.f90 create mode 100755 trunk/exact_toystar1D.f90 create mode 100755 trunk/exact_toystar2D.f90 create mode 100755 trunk/exact_wave.f90 create mode 100755 trunk/fieldlines.f90 create mode 100755 trunk/geometry.f90 create mode 100755 trunk/get_data.f90 create mode 100755 trunk/globaldata.f90 create mode 100755 trunk/interactive.f90 create mode 100755 trunk/interpolate1D.f90 create mode 100755 trunk/interpolate2D.f90 create mode 100755 trunk/interpolate3D.f90 create mode 100755 trunk/interpolate3D_opacity.f90 create mode 100644 trunk/interpolate3D_projection.F90 create mode 100755 trunk/interpolate3D_xsec.f90 create mode 100755 trunk/interpolate_vec.f90 create mode 100755 trunk/isosurface.f90 create mode 100755 trunk/legends.f90 create mode 100755 trunk/limits.f90 create mode 100755 trunk/menu.f90 create mode 100755 trunk/options_data.f90 create mode 100755 trunk/options_limits.f90 create mode 100755 trunk/options_page.f90 create mode 100755 trunk/options_particleplots.f90 create mode 100755 trunk/options_powerspec.f90 create mode 100755 trunk/options_render.f90 create mode 100755 trunk/options_vecplot.f90 create mode 100755 trunk/options_xsecrotate.f90 create mode 100755 trunk/particleplot.f90 create mode 100644 trunk/pdfs.f90 create mode 100755 trunk/plotstep.f90 create mode 100644 trunk/plotutils.f90 create mode 100755 trunk/powerspectrums.f90 create mode 100755 trunk/prompting.f90 create mode 100755 trunk/read_data_UCLA.f90 create mode 100755 trunk/read_data_VINE.f90 create mode 100755 trunk/read_data_ascii.f90 create mode 100644 trunk/read_data_bauswein.f90 create mode 100755 trunk/read_data_dansph.f90 create mode 100755 trunk/read_data_dansph_old.f90 create mode 100644 trunk/read_data_dragon.f90 create mode 100755 trunk/read_data_flash_hdf5.f90 create mode 100755 trunk/read_data_flash_hdf5_utils.c create mode 100755 trunk/read_data_foulkes.f90 create mode 100755 trunk/read_data_gadget.f90 create mode 100755 trunk/read_data_gadget_jsb.f90 create mode 100755 trunk/read_data_jjm.f90 create mode 100755 trunk/read_data_jules.f90 create mode 100644 trunk/read_data_kitp.f90 create mode 100755 trunk/read_data_mbate.f90 create mode 100755 trunk/read_data_mbate_hydro.f90 create mode 100755 trunk/read_data_mbate_mhd.f90 create mode 100755 trunk/read_data_oilonwater.f90 create mode 100755 trunk/read_data_rsph.f90 create mode 100755 trunk/read_data_scw.f90 create mode 100644 trunk/read_data_snsph.f90 create mode 100644 trunk/read_data_snsph_utils.c create mode 100755 trunk/read_data_sphNG.f90 create mode 100755 trunk/read_data_spyros.f90 create mode 100755 trunk/read_data_sro.f90 create mode 100755 trunk/read_data_timli.f90 create mode 100644 trunk/read_data_tipsy.F90 create mode 100644 trunk/read_data_vanaverbeke.f90 create mode 100755 trunk/render.f90 create mode 100755 trunk/rotate.f90 create mode 100755 trunk/scripts/cpfiles.bash create mode 100755 trunk/scripts/fixpgplotnames.bash create mode 100755 trunk/scripts/getav.pl create mode 100755 trunk/scripts/ppm2gif.bash create mode 100755 trunk/scripts/splash_parallel.pl create mode 100644 trunk/scripts/time_average_pdfs.f90 create mode 100755 trunk/setpage.f90 create mode 100755 trunk/shapes.f90 create mode 100644 trunk/splash.f90 create mode 100755 trunk/system_f2003.f90 create mode 100755 trunk/system_unix.f90 create mode 100755 trunk/system_unix_NAG.f90 create mode 100644 trunk/system_utils.f90 create mode 100644 trunk/tests/test_fieldlines.f90 create mode 100755 trunk/tests/test_interpolate3D.f90 create mode 100755 trunk/timestepping.f90 create mode 100755 trunk/titles.f90 create mode 100755 trunk/transform.f90 create mode 100644 trunk/units.f90 create mode 100644 trunk/write_data_phantom.f90 create mode 100644 trunk/write_pixmap.f90 create mode 100644 trunk/write_sphdata.f90 2009-07-17 dprice * : making trunk,tags,branches dirs git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@3 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-07-16 Daniel Price * Makefile: minor reformatting 2009-07-15 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.12.2 2009-07-15 dprice * exact_wave.f90: does not multiply by ymean if it is zero; warns if period -ve 2009-07-15 dprice * splash.f90: v1.12.2 description, plus uses argument 0 in usage 2009-07-15 dprice * docs/splash.bbl, docs/splash.tex: docs updated for v1.12.2 2009-07-15 dprice * options_particleplots.f90, particleplot.f90: variable marker sizes implemented; can plot particles as filled or outlined circles with radius proportional to h 2009-07-15 dprice * Makefile: added write_data_phantom.f90 to source files 2009-07-15 dprice * convert.f90, write_data_phantom.f90, write_sphdata.f90: convert to phantom dump format implemented 2009-07-15 dprice * globaldata.f90: single precision defined; bug fix with int8 definition 2009-07-15 dprice * system_utils.f90: lenvironment accepts 1 as true 2009-07-15 dprice * plotstep.f90: bug fix with opacity-based rendering + dark matter 2009-07-15 dprice * read_data_gadget.f90: BUG FIX: creates h and rho columns when using GSPLASH_DARKMATTER_HSOFT with block-labelled data read; also read from .hsml and .dens files implemented better -- dark matter rendering now works OK in this case 2009-07-14 dprice * menu.f90, options_render.f90: bug fix with contour plotting and icolours=0; behaviour better defined; contour prompt does not appear in this case 2009-07-14 dprice * plotstep.f90: interpolation weights only set if needed; avoids pointless warnings, also bug fix with contour plotting and icolours=0 2009-07-14 dprice * read_data_VINE.f90: implemented read of star/point mass particles from VINE dumps 2009-07-14 dprice * read_data_ascii.f90: does not override vector labels 2009-07-13 dprice * defaults.f90, get_data.f90, globaldata.f90, menu.f90, options_data.f90: does not override coordinate and vector labels by default (unless not set) 2009-07-13 dprice * read_data_sphNG.f90: speed improvements for low memory mode - skips faster if no columns need to be read 2009-07-13 dprice * read_data_ascii.f90: r and z recognised as coordinates 2009-07-13 dprice * interactive.f90: cursor position now saved relative to viewport, stops weird cursor jumping 2009-07-13 dprice * allocate.f90: spaces removed 2009-06-25 dprice * read_data_sphNG.f90: BUG FIX with B field read in sphNG 2009-06-11 dprice * plotstep.f90: debug mode; temporary arrays allocated one at a time; low memory mode does not allocate temp arrays if not needed 2009-06-11 dprice * menu.f90: minor bug fix with irendermulti resetting before prompt (icolpixmap related) 2009-06-11 dprice * write_pixmap.f90: oops 2009-06-11 dprice * write_pixmap.f90: better warning if cant find .pix files 2009-06-11 dprice * particleplot.f90: allow arbitrary sizes for input arrays; gracefully warns if z array size too small 2009-06-11 dprice * read_data_sro.f90, setpage.f90: compiler warnings fixed 2009-06-11 dprice * globaldata.f90, splash.f90: debug mode added 2009-06-10 dprice * plotstep.f90: bug fix with tiling decision for pixmap plotting 2009-06-10 dprice * globaldata.f90, menu.f90, plotstep.f90, splash.f90, write_pixmap.f90: -readpix option added for plotting grid based data alongside SPH, limited formats at present 2009-06-10 dprice * asciiutils.f90: basename function added for stripping directory names 2009-06-01 dprice * read_data_dansph.f90: bug fix with garbled geomfile in header printing 2009-05-25 dprice * read_data_timli.f90: better memory reallocation 2009-05-21 dprice * plotstep.f90: shocking bug with saving of number of pixels and automatic pixel numbers fixed 2009-05-20 dprice * globaldata.f90, read_data_oilonwater.f90: units in rsun and msun for oilonwater; module physcon added 2009-05-20 dprice * plotstep.f90: temporary arrays are explicitly allocated instead of being left up to the compiler 2009-05-19 dprice * Makefile, read_data_oilonwater.f90: added new oilonwater read for Ross Church, Melvyn Davies 2009-05-19 dprice * analysis.f90, plotstep.f90: bug fixes blocking compilation with ifort8 2009-05-14 dprice * read_data_sphNG.f90: bug fix with reading Bens small dumps 2009-05-14 dprice * read_data_sphNG.f90: few more debugging statements added 2009-05-11 dprice * read_data_gadget.f90: lcase in asciiutils module 2009-05-11 dprice * plotstep.f90: bug fix with plot tiling; buffer for line width changes removed 2009-05-08 dprice * INSTALL: added some extra bits; simplified others 2009-05-07 dprice * Makefile, read_data_timli.f90: added timli data read 2009-05-07 dprice * options_particleplots.f90, particleplot.f90, plotstep.f90: error bar plotting implemented for particle plots 2009-04-30 dprice * read_data_ascii.f90: guessing of column identities from columns file is case-insensitive 2009-04-30 dprice * analysis.f90, asciiutils.f90, convert.f90, get_data.f90, prompting.f90: functions ucase, lcase moved from prompting module into asciiutils module 2009-04-29 dprice * particleplot.f90: memory only allocated for temporary arrays when required (when plotting circles of interaction as error bars) 2009-04-27 dprice * asciiutils.f90, docs/splash.bbl: minor changes 2009-04-22 dprice * read_data_ascii.f90: better error handling on bad lines - carries on reading but gives warning 2009-04-21 dprice * Makefile, read_data_snsph.f90, read_data_snsph_utils.c: snsph data read added 2009-04-21 dprice * read_data_tipsy.F90: works with ifort 10.0.0 stream access which is still old style 2009-04-20 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.12.1 2009-04-20 dprice * docs/version_history, docs/version_history_tex.tex: version 1.12.1 2009-04-20 dprice * splash.f90: v1.12.1 2009-04-20 dprice * docs/splash.tex: extra GSPLASH env variables added to docs 2009-04-20 dprice * read_data_gadget.f90: added GSPLASH_IGNORE_IFLAGCOOL and GSPLASH_HSML_COLUMN 2009-04-20 dprice * INSTALL, INSTALL.macosx: updated install instructions 2009-04-20 dprice * docs/splash.tex: docs updated for v1.12.1 2009-04-20 dprice * setpage.f90: bug fix with round-off error on exact pixel boundary selection 2009-04-20 dprice * analysis.f90: BUG FIXES with analysis mode -- thanks to Florian Buerzle. Format statements now work with arbitrary numbers of columns (up to 999), also massaboverho analysis works with masses in dump file headers 2009-04-08 dprice * colourbar.f90: bug fix with separation in colour bar label 2009-03-30 dprice * write_sphdata.f90: bug fix with convert to rsph format 2009-03-27 dprice * write_sphdata.f90: convert to Steinars rsph file format added 2009-03-25 dprice * calc_quantities.f90: dudtrad added 2009-03-23 dprice * plotstep.f90, render.f90: removed need to render twice when contour limits differ from render limits 2009-03-23 dprice * splash.f90: date/version bumped 2009-03-23 dprice * limits.f90: allow contour max=min 2009-03-23 dprice * interactive.f90, limits.f90, menu.f90, plotstep.f90: ability to set contour limits separately from render limits for same quantity implemented 2009-03-23 dprice * render.f90: bug fix with formatting of contour limits 2009-03-19 dprice * splash.f90: bug fix with broken -d and -l command line options 2009-03-11 dprice * splash.f90: version 1.12.1beta 2009-03-11 dprice * docs/figs/colourschemes.ps: new colour schemes added to figure 2009-03-11 dprice * colourbar.f90, interactive.f90, shapes.f90: can interactively edit text shapes and the colour bar label 2009-03-11 dprice * asciiutils.f90, options_render.f90, plotstep.f90: option to customize label on projection plots implemented 2009-03-11 dprice * Makefile: dependencies added to Makefile properly, still try to get files in the right order 2009-03-06 dprice * plotutils.f90, render.f90: formatreal utility added; used for contour level labels; also character height of contour labels increased 2009-03-06 dprice * get_data.f90: label check done after every get_labels call; added SPLASH_HMIN_CODEUNITS environment variable to set minimum h 2009-03-06 dprice * options_render.f90, plotstep.f90, render.f90: option added for numeric labelling of contours 2009-03-06 dprice * render.f90: contour levels set better: exactly on min and max apart from with nc=1 which uses min; also prints out full list of levels 2009-02-11 pgdixon * : new dir splash git-svn-id: https://svn-vre.its.monash.edu.au/mathsci/splash@2 cab04810-efc7-4a10-8ecf-f366c833a2ad 2009-02-07 dprice * plotstep.f90: bug fix with separate types in contours 2009-02-06 dprice * read_data_sphNG.f90: tabs removed 2009-02-06 dprice * exact_shock_sr.f90: compiler warnings (unused variables, no intents) fixed 2009-02-06 dprice * exact_sedov.f90, exact_toystar1D.f90, exact_toystar2D.f90, interactive.f90, interpolate3D.f90, interpolate3D_projection.F90, menu.f90, options_data.f90, plotstep.f90, prompting.f90, splash.f90, system_utils.f90: compiler warnings (unused variables, no intents) fixed 2009-02-06 dprice * docs/splash.tex: docs updated with command line options 2009-02-06 dprice * read_data_dansph.f90: minor change to the way it prints geometry info 2009-02-06 dprice * prompting.f90: mask= added to print_logical 2009-02-06 dprice * Makefile, options_particleplots.f90, plotstep.f90: contours of different particle type to rendered quantity implemented 2009-02-05 dprice * read_data_sphNG.f90: bug fix with seg fault in low memory mode 2009-02-05 dprice * read_data_sphNG.f90: location of u in mhd small dumps known 2009-02-05 dprice * read_data_sphNG.f90: new location for u in small dumps 2009-02-05 dprice * read_data_sphNG.f90: fixed labelling on pure RT small dumps 2009-02-05 dprice * read_data_sphNG.f90: ilocpmassinitial is 23 for small sphNG dumps; 15 for phantom 2009-02-05 dprice * splash.f90: updated contact details, year 2009-01-29 dprice * read_data_sphNG.f90: bug fix with MHD_RT small dumps; debug as environment variable 2009-01-15 dprice * system_utils.f90: BUG FIX with integer environment variable read 2008-12-22 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.12.0 2008-12-22 dprice * splash.f90: v1.12.0 2008-12-22 dprice * read_data_tipsy.F90: bug fix with preprocessing of ifort checks 2008-12-22 dprice * read_data_tipsy.F90, read_data_tipsy.f90: added preprocessor option for older ifort compilers + stream access 2008-12-22 dprice * splash.f90: no longer prompts for filenames (obsolete), instead prints usage; also bug fix with command-line plot invocation - if interactive device is invoked, will enter menu instead of quitting 2008-12-16 dprice * read_data_tipsy.f90: access=stream for ifort 9 added (will comment later) 2008-12-10 dprice * plotstep.f90, shapes.f90: BUG FIX: transforms applied to shape coordinates 2008-12-09 dprice * read_data_sphNG.f90: bug fix with Phantom MPI read (missing particles) 2008-12-08 dprice * scripts/time_average_pdfs.f90: bug fix with time averaged pdf calculation 2008-12-08 dprice * plotstep.f90: bug fix with required array for PDF plots 2008-12-07 dprice * pdfs.f90, plotstep.f90: ability to manually set the number of bins for pdf plots 2008-12-07 dprice * scripts/time_average_pdfs.f90: f90 script to produce time averaged pdfs from a bunch of SPLASH PDF files 2008-12-05 dprice * transform.f90: ln transformation added 2008-12-05 dprice * transform.f90: ln transformation added 2008-12-05 dprice * read_data_flash_hdf5_utils.c: spaces removed from SPH density dataset name 2008-12-05 dprice * asciiutils.f90: uses tiny instead of arbitrary number 2008-12-05 dprice * pdfs.f90: bug fix if normalisation is zero in PDF 2008-12-05 dprice * menu.f90: bug fix with PDFs in multiplot 2008-12-05 dprice * read_data_flash_hdf5.f90, read_data_flash_hdf5_utils.c: updated flash tracer particle read/write (reads SPH density dataset if present) 2008-12-01 dprice * docs/splash.tex, splash.f90: documentation for -x -y -render -vec -cont -dev added 2008-12-01 dprice * read_data_flash_hdf5.f90, read_data_flash_hdf5_utils.c: partial data reading+low memory mode implemented for FLASH tracer particles format 2008-12-01 dprice * Makefile: typo in HDF5INCLUDE fixed 2008-12-01 dprice * read_data_flash_hdf5.f90, read_data_flash_hdf5_utils.c: puts particles in id order, uses bind(c) for linking with c (more portable) 2008-12-01 dprice * Makefile: FLASH code +HDF5 compiling and linking; also LDFLAGS always put at the end of the compile-time line (seems to be more standard) 2008-12-01 dprice * read_data_flash_hdf5.f90, read_data_flash_hdf5_utils.c: read data routine added for FLASH code tracer particles (hdf5 format). HDF5 requires linking with HDF5 libraries and compiling/calling c routine 2008-11-30 dprice * asciiutils.f90: uses len not len_trim, should be more portable 2008-11-27 dprice * interactive.f90: ctrl-C in interactive window kills it 2008-11-27 dprice * asciiutils.f90: function to convert a fortran string into a c string added 2008-11-27 dprice * limits.f90: formatted output 2008-11-27 dprice * plotstep.f90, shapes.f90: shapes can be plotted on only some panels, or first row, first column etc 2008-11-26 dprice * read_data_gadget.f90: oops! now bug really fixed in block-labelled read 2008-11-26 dprice * system_utils.f90: more robust integer environment variable read 2008-11-26 dprice * menu.f90: bug fix with allowrendering if mass not present 2008-11-26 dprice * read_data_gadget.f90: BUG FIX with block labelled gadget read if BFLD present 2008-11-26 dprice * options_xsecrotate.f90, plotstep.f90: BUG FIX: cross section slice thickness is saved - no longer resets in prompt 2008-11-21 dprice * calc_quantities.f90: calculates gas temperature in K for barytropic EOS runs 2008-11-21 dprice * read_data_sphNG.f90: bug fix with reading of B from sphNG files 2008-11-21 dprice * read_data_sphNG.f90: minor bug fix with labelling 2008-11-20 dprice * read_data_ascii.f90: bug fix with auto-labelling: ndimV = 0 if ndim = 0 2008-11-13 dprice * options_render.f90: nicer printing of logical options after they have been set 2008-11-12 dprice * defaults.f90, globaldata.f90, menu.f90, plotstep.f90, splash.f90, timestepping.f90, transform.f90: contour plotting of second quantity (ie. different to rendered quantity) implemented; tested and seems to work OK 2008-11-12 dprice * units.f90: bug fix with units for calculated quantities not being read properly from units file 2008-11-12 dprice * limits.f90: improved formatting on min=max warning after reading limits file; less repeated code 2008-11-12 dprice * options_data.f90: bug fix if only changing unit labels: now prompts to write units file 2008-11-11 dprice * interpolate3D_projection.F90: atomic statements added to openMP parallelism - fixes "black dots" bug 2008-11-11 dprice * options_data.f90: prints info about z integration unit 2008-11-11 dprice * plotstep.f90: bug fix with normalised column integrated plots if unit for z integration set 2008-11-11 dprice * scripts/cpfiles.bash: cpfiles script added for renaming .defaults, .limits files etc 2008-11-10 dprice * plotstep.f90: can plot step legend on panels other than the first one 2008-11-10 dprice * options_page.f90, timestepping.f90: options for finer control of line-style changing / line colour changing added 2008-11-10 dprice * plotstep.f90, splash.f90: bug fixes with command line plot/device specification 2008-11-10 dprice * defaults.f90, menu.f90, options_page.f90, plotstep.f90, splash.f90, timestepping.f90: command line plotting implemented: -x, -y, -render and -vecplot can be used to specify the plot from the command line (ie. no prompts needed), also -dev to specify the pgplot device 2008-11-07 dprice * asciiutils.f90: bug fix in format statement 2008-11-07 dprice * Makefile, analysis.f90, convert.f90, splash.f90: "splash calc" command line utility implemented; calculates energies, min,max,mean of all columns and mass above rho vs time using all the dump files on the command ine 2008-11-07 dprice * write_sphdata.f90: minor changes to formatting 2008-11-07 dprice * asciiutils.f90: read_asciifile now generic interface that can return either array of strings or array of reals from an ascii file 2008-11-07 dprice * get_data.f90: blank filenames not allowed in prompt 2008-10-30 dprice * read_data_sphNG.f90: debug flag set back to false 2008-10-21 dprice * read_data_sphNG.f90: bug fixes with RT+MHD small dump read 2008-10-21 dprice * read_data_sphNG.f90: minor change to low memory mode 2008-10-20 dprice * interactive.f90: backspace key added to interactive mode - progressively removes annotation from the plot (ie. axes and colour bar, legends, titles, shapes, scale) - legends and titles can be restored by pressing G, T and H for each 2008-10-16 dprice * system_utils.f90: BUG FIX with envlist routine (cause of seg fault in GADGET read): thanks to Daniel Cunnama 2008-10-13 dprice * docs/version_history, docs/version_history_tex.tex: version 1.11.1 2008-10-13 dprice * docs/version_history, docs/version_history_tex.tex: version 1.11.1 2008-10-13 dprice * docs/version_history_tex.tex: version 1.11.1 2008-10-13 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.11.1 2008-10-13 dprice * splash.f90: v1.11.1 2008-10-13 dprice * docs/splash.tex: docs updated for v1.11.1 2008-10-13 dprice * transform.f90: function interface; not used yet 2008-10-13 dprice * plotstep.f90: sends brightness into particleplot for opacity rendering; also origin sent into interactive routines 2008-10-13 dprice * interpolate2D.f90, particleplot.f90: sets brightness to 1. if present for writing sinks direct to ppm 2008-10-13 dprice * read_data_foulkes.f90: bugs fixed; only reads up to smoothing length by default 2008-10-13 dprice * colourbar.f90: only does split-colourbar workaround if > 1024 pixels actually needed 2008-10-13 dprice * setpage.f90: bug fix: tol reduced when finding exact pixel boundaries 2008-10-10 dprice * Makefile, read_data_foulkes.f90: read_data added for steve foulkes 2008-10-10 dprice * interactive.f90: o in interactive mode recentres plot on origin (ie. not zero if origin set to something different 2008-10-07 dprice * colourbar.f90: one-sided colour bars implemented as both vertical or horizontal 2008-10-07 dprice * plotstep.f90: npix = 1024/nacross in auto mode for pixel devices 2008-10-07 dprice * plotstep.f90: automatic resolution determination limited to 800/nacross on vector devices 2008-10-07 dprice * plotstep.f90: automatic resolution determination limited to 400/nacross on vector devices 2008-10-07 dprice * plotstep.f90: bug fix with new colour bar plot order: now uses foreground colour again 2008-10-02 dprice * read_data_sphNG.f90: less verbose header printout for MPI dumps 2008-10-02 dprice * shapes.f90: shapes can be plotted relative to viewport for each panel as well as using plot coords; also longer text string allowed 2008-09-26 dprice * prompting.f90: blank="blank" in prompt, not null= 2008-09-26 dprice * Makefile, colourbar.f90, setpage.f90: colour bar lies on exact pixel boundaries; calls same routine as setpage to determine this 2008-09-26 dprice * plotstep.f90: frame changes on a per-page basis, not per dump file; does not quite work with interactive mode step navigation 2008-09-25 dprice * plotstep.f90: small page buffer if box is drawn to allow for line width changes 2008-09-25 dprice * plotstep.f90, titles.f90: lensteplegend a parameter to avoid pgf90 bug 2008-09-25 dprice * plotstep.f90: colour bar now plotted AFTER renderings, so can in principle plot colour bar on top of rendered plot 2008-09-25 dprice * plotstep.f90: lower stacksize footprint; renderplot now only allocated when necessary (ie. for rendering with particle colouring instead of pixels) 2008-09-24 dprice * read_data_sphNG.f90: parallelisation uses default(none) 2008-09-24 dprice * Makefile: pgf90 flags updated 2008-09-24 dprice * get_data.f90: compiles with pgf90 2008-09-24 dprice * globaldata.f90, plotstep.f90: workaround for crash in pgf90 compiler; now runs OK 2008-09-23 dprice * options_render.f90: auto npix back on by default 2008-09-23 dprice * read_data_sphNG.f90: ssplash_omegat environment variable added 2008-09-18 dprice * menu.f90, splash.f90: v1.11.1alpha; contact details updated to Monash 2008-09-18 dprice * options_render.f90: npix=200 by default for 1.11.1alpha 2008-09-18 dprice * read_data_gadget.f90: BUG FIX with block-labelled GADGET read if mass array not present; also labelling added for every column that appears in io.c in GADGET-3 2008-09-18 dprice * plotstep.f90: minor bug fixes with interpolation weights when mass not read from dump file 2008-09-17 dprice * exact_shock_sr.f90: minor formatting 2008-09-10 dprice * Makefile, exact.f90, exact_shock_sr.f90, riemann_sr.f: special relativistic shock tube exact solution added 2008-09-07 dprice * plotstep.f90: BUG fix with particle coordinates in different coordinate systems 2008-09-05 dprice * options_page.f90: line width allowed to be >5 2008-09-03 dprice * get_data.f90: rendering works if mass not read as column (just as a single number for each type); works only for sphNG read at the moment in low-memory mode; endian check added but commented 2008-09-03 dprice * menu.f90, read_data_sphNG.f90: rendering works if mass not read as column (just as a single number for each type); works only for sphNG read at the moment in low-memory mode 2008-09-03 dprice * plotstep.f90: bug fix with circles of interaction on particle plots 2008-09-03 dprice * Makefile: changes committed by mistake reverted 2008-09-03 dprice * options_render.f90, setpage.f90: automatic pixel numbers re-activated (will appear in v1.11.1); bug fix with multiple panels 2008-09-02 dprice * Makefile, read_data_jjm.f90, read_data_jules.f90: jules data read added 2008-08-15 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.11.0 2008-08-15 dprice * splash.f90: v1.11.0 2008-08-15 dprice * plotstep.f90: bug fix with auto pixel selection 2008-08-15 dprice * docs/splash.tex: extra info re: data reads/environment variables added 2008-08-15 dprice * read_data_gadget.f90: BUG FIX with reading masses from gadget files if particle mass < 1.e-8 (thanks to Thomas Grief); also GSPLASH_CHECKIDS added 2008-08-15 dprice * read_data_VINE.f90: minor changes to VINE format: VSPLASH_MHD and VINE_MHD both work; VSPLASH_HFAC added as option for compatibility with older vine output 2008-08-15 dprice * options_render.f90: automatic pixel numbers disabled for v1.11.0 2008-08-15 dprice * setpage.f90: exact pixel boundaries improved; disabled for v1.11.0 2008-08-15 dprice * plotstep.f90: bug fixes, improvements to automatic pixel selection 2008-08-15 dprice * Makefile, read_data_UCLA.f90: data read for Sky King (UCLA) added 2008-08-15 dprice * options_render.f90: bug fix: prompt for label distance appears for plot-hugging colour bars 2008-08-07 dprice * plotstep.f90: bug fix with frames not changing 2008-08-06 dprice * exact_sedov.f90: out-of-bounds error fixed at t=0 2008-07-28 dprice * plotstep.f90: BUG FIX with velocity components in different coordinate systems (VPHI WAS WRONG!) - thanks to Giuseppe Lodato 2008-07-22 dprice * exact_shock_sr.f90, riemann_sr.f: exact solution for special relativistic riemann problem 2008-07-21 dprice * options_render.f90, plotstep.f90: AUTO-SELECT npix so pixels exactly match those on device (MUCH SMOOTHER PLOTS WITH NO ARTIFACTS); rendering of sinks to ppm implemented 2008-07-21 dprice * interpolate2D.f90, particleplot.f90: rendering of sinks to ppm files implemented (slightly inflexible at the moment) 2008-07-21 dprice * setpage.f90: viewport automatically adjusted to lie exactly on pixel boundaries (no blank spaces) 2008-07-10 dprice * interactive.f90: bug fix with C 2008-07-10 dprice * interactive.f90: C key re-centres plot on cursor in interactive mode 2008-07-10 dprice * allocate.f90: bug fix with reallocation of iamtype variable 2008-07-10 dprice * read_data_sphNG.f90: divvcol read only if required 2008-07-10 dprice * read_data_sphNG.f90: star particle type added for sphNG read 2008-07-04 dprice * read_data_sphNG.f90: bug fix with reading phantom small dumps + MPI 2008-06-25 dprice * docs/splash.tex, options_page.f90: documentation added for shapes; better scale menu option 2008-06-25 dprice * shapes.f90: bug fixes with shape plotting 2008-06-24 dprice * read_data_sphNG.f90: prints RK2, tff, dtmax, rhozero as read from sphNG header 2008-06-24 dprice * exact_polytrope.f90: bug fix: handles gamma 4/3 case now 2008-06-24 dprice * exact.f90: errors in residuals collected into one warning 2008-06-19 dprice * options_render.f90: no prompt for label if no colour bar plotted 2008-06-05 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.11.0beta 2008-06-05 dprice * splash.f90: v1.11.0beta 2008-06-05 dprice * read_data_sphNG.f90: check for zero particle mass in Phantom dumps 2008-06-05 dprice * read_data_ascii.f90: local file called columns takes precedence over ASPLASH_COLUMNSFILE environment variable 2008-06-05 dprice * interactive.f90, plotstep.f90: v,V,w and H implemented in interactive mode on multiple-steps-per-page/multiple panels 2008-06-05 dprice * colourbar.f90, options_render.f90: vertical and horizontal plot-hugging colour bars implemented; option to turn off colour bar label added 2008-06-05 dprice * menu.f90: BUG FIX with multiplots made in 10.5.2 2008-06-03 dprice * read_data_sphNG.f90: correct labelling for MHD+RT dumps 2008-06-02 dprice * plotstep.f90: bug fix with interactive mode + PDF plotting 2008-05-14 dprice * Makefile: plotutils added to makefile 2008-05-13 dprice * transform.f90: utility function to convert log to ln in transforms 2008-05-13 dprice * calc_quantities.f90: imri bug fix + better label for ipmag 2008-05-13 dprice * asciiutils.f90, pdfs.f90: pdf file name removes slashes, spaces and escape characters from label 2008-05-13 dprice * read_data_sphNG.f90: uninitialised bug fix in phantom reads 2008-05-12 dprice * read_data_sphNG.f90: reads .divv file if present (Phantom) 2008-05-12 dprice * pdfs.f90, plotstep.f90: write_pdf routine improved 2008-05-12 dprice * plotutils.f90: plotutils beginning of plot api for generic backend; also line plotting with blanking 2008-05-12 dprice * transform.f90: generic interface added; interface routines to handle single real numbers added 2008-05-12 dprice * read_data_kitp.f90: minor change 2008-05-09 dprice * globaldata.f90: ipdf label 2008-05-09 dprice * Makefile, menu.f90, pdfs.f90, plotstep.f90: PDF plotting implemented 2008-05-09 dprice * defaults.f90, interactive.f90, limits.f90, options_limits.f90, plotstep.f90, splash.f90: parameter range restriction implemented; saves to limits file; also in interactive mode using x, y and r keys after click (R to reset) 2008-05-09 dprice * menu.f90: noblank on fileprefix setting 2008-05-09 dprice * prompting.f90: string prompts accept blank to set null string, noblank optional argument 2008-05-09 dprice * asciiutils.f90: ncolumnsline public function instead of subroutine 2008-05-08 dprice * plotstep.f90: shape plotting call uncommented 2008-05-08 dprice * options_page.f90: plot shapes option added to g) menu 2008-05-08 dprice * defaults.f90: shape options read from defaults file; other changes 2008-05-08 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.10.2 2008-05-08 dprice * docs/splash.tex, splash.f90: v1.10.2 2008-05-08 dprice * options_particleplots.f90, particleplot.f90: option to change plotting order of particle types implemented 2008-05-08 dprice * plotstep.f90: bug fix with array-out-of-bounds in low memory mode + not rendering 2008-05-08 dprice * splash.f90: date updated 2008-05-08 dprice * read_data_vanaverbeke.f90: read_data update for sigfried; new header info read 2008-05-08 dprice * read_data_vanaverbeke.f90: read_data update for sigfried; new header info read 2008-05-08 dprice * discplot.f90, plotstep.f90: toomre Q now correct for ideal gas equation of state (uses gamma from dump file) 2008-05-08 dprice * docs/splash.tex: updated docs with surface density plot info 2008-05-08 dprice * get_data.f90: bug fix with units resetting when turning on/off even if units file present 2008-05-08 dprice * plotstep.f90: bug fix with a) on multiple-plots per page/surface density plots 2008-05-07 dprice * write_sphdata.f90: simple unformatted binary format added as sph conversion option 2008-05-07 dprice * write_pixmap.f90: pixmap write in ascii format uses format statement to prevent ifort rubbish 2008-05-01 dprice * convert.f90, write_sphdata.f90: ascii file conversion writes header with dump file information in it 2008-05-01 dprice * shapes.f90: new shapes module; not yet added as a feature 2008-05-01 dprice * discplot.f90, menu.f90, plotstep.f90: bug fixes with disc quantity plotting (interactive mode, multiple plots per page, zoom) 2008-04-30 dprice * splash.f90: bumped version number to 1.10.2beta 2008-04-30 dprice * Makefile: discplot added to Makefile 2008-04-30 dprice * discplot.f90, globaldata.f90, menu.f90, plotstep.f90: calculation of surface density and Toomre parameter implemented 2008-04-30 dprice * get_data.f90, options_data.f90: splash.columns file can be used to override default column labels 2008-04-30 dprice * Makefile, read_data_vanaverbeke.f90: read data routine for sigfried vanaverbeke added 2008-04-15 dprice * colours.f90: colour schemes from flash code added 2008-04-01 dprice * docs/splash.bbl: updated refs 2008-04-01 dprice * read_data_sphNG.f90: ugly common block removed; bug fixes with labelling of phantom MHD dumps 2008-03-30 dprice * read_data_ascii.f90: ASPLASH_COLUMNSFILE environment variable added 2008-03-17 dprice * INSTALL, INSTALL.macosx: comment about stacksize added to install instructions 2008-03-12 dprice * menu.f90: nacross and ndown not changed if OK when re-setting multiplot 2008-03-11 dprice * docs/splash.tex: version history spans page 2008-03-11 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.10.1 2008-03-11 dprice * read_data_sphNG.f90: reads all velocities if any required 2008-03-11 dprice * read_data_ascii.f90: bug fix with header lines by environment variable 2008-03-11 dprice * splash.f90: v1.10.1 2008-03-11 dprice * plotstep.f90: only velocities relative to tracked particle in different coordinate systems (not B) 2008-03-11 dprice * read_data_gadget.f90: block labelled GADGET data read implemented (GSPLASH_FORMAT=2) 2008-03-11 dprice * docs/splash.tex: updated docs for v1.10.1 2008-03-11 dprice * options_particleplots.f90: default marker for type 5 is * 2008-03-07 dprice * asciiutils.f90, read_data_ascii.f90: number of header lines can be overwritten by environment variable ASPLASH_NHEADERLINES 2008-03-03 dprice * read_data_gadget.f90: gsplash will read additional .hsml and/or .dens files if present containing smoothing length and density for dark matter particles 2008-02-29 dprice * read_data_mbate.f90: bug fix with single/double precision detection 2008-02-28 giuseppe * Makefile: frecord-marker issue 2008-02-27 dprice * read_data_sphNG.f90: more robust single/double precision determination 2008-02-27 dprice * Makefile: exact_ringspread added to Makefile 2008-02-26 dprice * exact.f90, exact_ringspread.f90: Lynden-Bell & Pringle ring spreading exact solution added 2008-02-26 dprice * plotstep.f90: bug fix with mem allocation/size checking with recent vector+rotation fix 2008-02-20 dprice * options_particleplots.f90: itrans resets when changing coordinate systems 2008-02-15 dprice * plotstep.f90: minor bug fixes in previous changes/openmp 2008-02-15 dprice * docs/splash.tex: docs updated for gadget environment variables 2008-02-15 dprice * system_utils.f90: envlist subroutine for extracting list of strings from an environment variable 2008-02-15 dprice * read_data_gadget.f90: extra columns environment variable for gadget read, also star particle information can be read 2008-02-15 dprice * plotstep.f90: BUG FIX with rotation + vector plots: vector components now rotate correctly 2008-02-15 dprice * exact_shock.f90: tabs removed 2008-02-12 dprice * interactive.f90, options_limits.f90, plotstep.f90: other coordinate system radii/velocities are now calculated relative to tracked particle (if particle tracking set) 2008-02-12 dprice * read_data_kitp.f90: read format for KITP comparison project 2008-01-24 dprice * convert.f90: bug fix: convert does calculated quantities now also 2008-01-24 dprice * read_data_sphNG.f90: better labelling of columns for rt and mhd : now always gets start of block right 2008-01-22 dprice * Makefile, convert.f90, splash.f90, write_sphdata.f90: implemented command line SPH dump file conversion (splash to ascii only at present) 2008-01-22 dprice * defaults.f90, globaldata.f90: reset_columnids routine added; minor 2008-01-18 dprice * interpolate3D_projection.F90: catches error causing segfault if NaNs or Infs for q2 in interpolation 2007-12-28 dprice * read_data_sphNG.f90: bug fix with int*8 skipping; reads MPI-Phantom dumps 2007-12-19 dprice * calc_quantities.f90: bug fix in mach number calculation if ivx not set (causes seg fault) 2007-12-13 dprice * docs/splash.tex: updated docs with square xy limits option 2007-12-13 dprice * options_page.f90, plotstep.f90: option for non-square coordinate axes implemented 2007-12-10 dprice * read_data_sphNG.f90: bug fix with sinks in MPI dump read 2007-12-05 dprice * particleplot.f90: bug fix: blocks compilation on NAG: thanks to Andrew McLeod 2007-12-05 dprice * particleplot.f90: bug fix: blocks compilation on NAG: thanks to Andrew McLeod 2007-11-29 dprice * docs/version_history_tex.tex: version 1.10.0 2007-11-29 dprice * globaldata.f90, options_data.f90, transform.f90: compiler warnings fixed 2007-11-29 dprice * calc_quantities.f90: minor bug fix 2007-11-29 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.10.0 2007-11-29 dprice * splash.f90: v1.10 2007-11-29 dprice * docs/splash.tex: userguide updated for version 1.10 2007-11-28 dprice * plotstep.f90: will tile if rendered + adaptive limits but no colour bar plotted 2007-11-28 dprice * render.f90: bug fixes in interface 2007-11-27 dprice * colours.f90: Bate original replaced by reinstated IDL blue-white 2007-11-25 dprice * docs/splash.tex: menu options updated 2007-11-25 dprice * globaldata.f90, splash.f90: better fileprefix changing; implemented save-as from main menu 2007-11-25 dprice * Makefile: intelmac variable added 2007-11-25 dprice * menu.f90, options_page.f90: legend menu made separate; cut-down menu if ndim<2 2007-11-25 dprice * colourbar.f90, plotstep.f90, setpage.f90: bugs with horizontal colour bars fixed 2007-11-25 dprice * write_pixmap.f90: prints usage for -o format 2007-11-25 dprice * INSTALL, INSTALL.macosx: updated and improved install instructions 2007-11-22 dprice * get_data.f90: does not call set_labels if no data read 2007-11-22 dprice * allocate.f90: bug fix in itype allocation 2007-11-20 dprice * read_data_dragon.f90: working data read for dragon code (both binary and ascii formats) 2007-11-20 dprice * allocate.f90, globaldata.f90, particleplot.f90, plotstep.f90, read_data_sphNG.f90, timestepping.f90: disordered particle type storage implemented, used in dragon and sphNG reads at present; remains optional 2007-11-20 dprice * write_pixmap.f90: ppm write implemented as -o option; same routine also used for opacity rendered .ppm 2007-11-20 dprice * get_data.f90: catches error if ix set incorrectly 2007-11-20 dprice * fieldlines.f90: minor conflict resolved; fewer warnings 2007-11-20 dprice * powerspectrums.f90: no warnings 2007-11-20 dprice * options_limits.f90, options_xsecrotate.f90: minor changes to only statements 2007-11-20 dprice * interactive.f90, interpolate3D_opacity.f90, interpolate3D_projection.F90: long subroutine names shortened to be strict f95 compatible 2007-11-20 dprice * defaults.f90: minor cleanup 2007-11-20 dprice * exact.f90, exact_rhoh.f90: only clauses improved; rhoh does rho vs h and h vs rho 2007-11-20 dprice * Makefile: -lg2c removed by default; reshuffle of some routines 2007-11-19 dprice * limits.f90: unused module removed 2007-11-15 dprice * plotstep.f90: BUG FIX on nag compiler; thanks to Sumedh 2007-11-15 dprice * fieldlines.f90: bug with r8 fixed 2007-11-15 dprice * Makefile, read_data_dragon.f90: dragon read implemented; not yet itype 2007-11-08 dprice * calc_quantities.f90, globaldata.f90: radiative transfer stuff calculated 2007-11-08 dprice * read_data_sphNG.f90: radiative transfer stuff labelled/units done 2007-11-02 dprice * colourbar.f90: improvements to horizontal colour bar 2007-10-30 dprice * Makefile: slight change to ukaff1a build 2007-10-30 dprice * defaults.f90: safer default filename opening 2007-10-30 dprice * globaldata.f90: max label length increased 2007-10-30 dprice * legends.f90: text no longer opaque in step legend 2007-10-30 dprice * splash.f90: bug fix on ukaff compiler 2007-10-30 dprice * read_data_sphNG.f90: bug fix in phantom read 2007-10-30 dprice * docs/splash.tex, splash.f90: citation updated 2007-10-30 dprice * read_data_sphNG.f90: bug fix in phantom read 2007-10-26 dprice * read_data_tipsy.f90: temperature labelled properly 2007-10-24 dprice * get_data.f90: catches errors in ndim; prevents seg faulting for strange data reads 2007-10-24 dprice * read_data_tipsy.f90: tipsy read handles both binary and ascii files 2007-10-24 dprice * read_data_gadget.f90: massoftype name clash fixed 2007-10-24 dprice * Makefile: comments and DEV option added 2007-10-24 dprice * read_data_sphNG.f90: seg fault bug fixed 2007-10-24 dprice * options_data.f90: bug fix in initial limits setting for calculated quantities 2007-10-24 dprice * calc_quantities.f90: bug fix in radius calculation 2007-10-23 dprice * read_data_sphNG.f90: compiles on ukaff 2007-10-23 dprice * read_data_sphNG.f90: sphNG read updated for MPI code 2007-10-17 dprice * setpage.f90: minor bug fix for aspect ratios very close to 1 2007-10-16 dprice * options_render.f90: bug fix 2007-10-16 dprice * Makefile, colourbar.f90, interactive.f90, options_render.f90, plotstep.f90, render.f90: option for horizontal colour bar implemented 2007-10-16 dprice * interpolate3D.f90: BUG FIX! 2007-10-15 dprice * plotstep.f90: space left for legend text in margins also 2007-10-15 dprice * tests/test_fieldlines.f90: updated test routine 2007-10-15 dprice * fieldlines.f90: improved fieldlines routine: uses Simpsons rule not trapezoidal; still issues with v.large gradients 2007-10-15 dprice * read_data_sphNG.f90: reads dust mass properly 2007-10-11 dprice * interpolate_vec.f90, plotstep.f90, render.f90: hide arrows where no particles also applies to streamline plotting 2007-10-11 dprice * calc_quantities.f90, plotstep.f90: better log output 2007-10-05 dprice * read_data_sphNG.f90: phantom+dust read 2007-10-05 dprice * Makefile: finds libX11 better on 64 bit systems; stuff added to pgf90 2007-10-05 dprice * read_data_sphNG.f90: dead particles in phantom treated better 2007-10-05 dprice * menu.f90: rendering by colouring particles allowed in different co-ordinate systems 2007-10-05 dprice * plotstep.f90: colour table set if particles have been previously coloured; also bug with a) and particle colouring fixed 2007-10-05 dprice * read_data_ascii.f90: better guess for mass column 2007-10-05 dprice * calc_quantities.f90: info about radius printed 2007-10-05 dprice * plotstep.f90: rotation is about tracked particle 2007-10-05 dprice * interactive.f90: o in interactive mode centres on tracked particle 2007-10-05 dprice * read_data_tipsy.f90: creates smoothing lengths if only softening lengths are dumped 2007-10-04 dprice * read_data_tipsy.f90: fixed tipsy read 2007-10-04 dprice * read_data_tipsy.f90: reads tipsy ascii files properly 2007-10-04 dprice * read_data_tipsy.f90: minor improvements 2007-09-26 dprice * Makefile, read_data_tipsy.f90: tipsy read added 2007-09-25 dprice * read_data_sphNG.f90: minus sign fixed 2007-09-25 dprice * read_data_sphNG.f90: corotating velocity subtraction implemented as environment variable 2007-09-24 dprice * write_pixmap.f90: minor compilation bugs fixed 2007-09-24 dprice * plotstep.f90: better prompt for dscreen 2007-09-24 dprice * particleplot.f90: fast particle plotting implemented for coloured subsets also 2007-09-21 dprice * options_render.f90, plotstep.f90: density weighted interpolation implemented 2007-09-21 dprice * Makefile, plotstep.f90, splash.f90, write_pixmap.f90: command line option to write pixel map to file implemented; only ascii format at present 2007-09-21 dprice * interpolate3D_projection.F90, plotstep.f90, tests/test_interpolate3D.f90: normalised projected plots implemented 2007-09-21 dprice * splash.f90: description of command line options added 2007-09-21 dprice * get_data.f90, globaldata.f90, options_data.f90, options_page.f90, splash.f90, titles.f90: ability to change file prefix for ALL files written by splash (ie. .defaults, .limits, .units, .anim, .titles and .legend) 2007-09-21 dprice * defaults.f90: minor internal change 2007-09-14 dprice * splash.f90: -p command line option added 2007-09-14 dprice * defaults.f90: minor formatting adjustments 2007-09-12 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.9.2 2007-09-12 dprice * splash.f90: v1.9.2 2007-09-12 dprice * docs/splash.bbl, docs/splash.tex: docs updated for v1.9.2 2007-09-12 dprice * options_vecplot.f90, render.f90: minor touch-ups to fixed arrow length option 2007-09-12 dprice * read_data_bauswein.f90: finishing touches added 2007-09-12 dprice * Makefile, read_data_bauswein.f90: read routine for Andreas Bauswein added 2007-09-11 dprice * interpolate3D_opacity.f90: bug fix with integer overflow on progress counter for > 100m particles 2007-09-10 dprice * plotstep.f90: renamed variables to avoid confusion 2007-09-10 dprice * plotstep.f90: smart background/foreground colour changing for legends, titles and overlaid ticks 2007-09-10 dprice * options_page.f90: better prompt for background-colour for axes/text option 2007-09-10 dprice * setpage.f90: slight adjustment to previous improvement 2007-09-10 dprice * plotstep.f90, setpage.f90: better margin determination when title is plotted above page 2007-09-10 dprice * setpage.f90: room left for title on tiled plots 2007-09-10 dprice * splash.f90: updated citation info 2007-09-10 dprice * options_vecplot.f90, render.f90: option to plot all arrows of same length implemented 2007-09-10 dprice * globaldata.f90: module variables declared public by default 2007-09-04 dprice * titles.f90: unused variable removed 2007-08-18 dprice * plotstep.f90: minor bug fix with previous 2007-08-17 dprice * plotstep.f90: axes numbers/labels turn off when rotating/using perspective 2007-08-17 dprice * interactive.f90: bug fix: distance to nearest particle now calculated much better on plots with different axes scaling 2007-08-14 dprice * asciiutils.f90: improved header skipping in ascii data read 2007-08-09 dprice * plotstep.f90: round-off problems fixed with v. large/v. small units (dobbs) 2007-08-09 dprice * interactive.f90: bug fix with a) only zooming on one axis when should zoom on both 2007-08-08 dprice * get_data.f90, globaldata.f90, read_data_sphNG.f90, splash.f90: beginnings of low memory mode implemented (memory allocated up to last required column -- applies to sphNG only at the moment); command line + env variable option added 2007-08-08 dprice * limits.f90: more error catches added 2007-08-08 dprice * allocate.f90: returns having done nothing if array sizes unchanged; also now accepts ncolumns=0 as valid input (with a warning) 2007-07-31 dprice * Makefile: fixed ukaff1b system 2007-07-31 dprice * geometry.f90: bug fix 2007-07-31 dprice * geometry.f90: non-standard declarations fixed which was blocking compilation on pathf95 2007-07-31 dprice * Makefile: new system options for pathf95 and ukaff1b 2007-07-31 dprice * docs/splash.tex: bit about ASPLASH_NCOLUMNS added to docs 2007-07-31 dprice * allocate.f90, globaldata.f90, plotstep.f90, timestepping.f90: changed interfaces to exact and interpolate_opacity; also catches min=max before PGPLOT does; massoftype implemented (but not yet in data reads) 2007-07-31 dprice * interpolate3D_opacity.f90: can send only one mass in via interface 2007-07-31 dprice * system_utils.f90: ienvironment function added 2007-07-31 dprice * read_data_ascii.f90: ASPLASH_NCOLUMNS can be used to override ncolumns settings 2007-07-31 dprice * defaults.f90, splash.f90: asplash -e option (evsplash) for plotting .ev files (ie. energy vs time) 2007-07-31 dprice * options_page.f90, options_particleplots.f90: default options for -ev option added 2007-07-31 dprice * exact.f90: circle on sedov plots; commented out by default 2007-07-31 dprice * exact_sedov.f90: plots circle at shock location 2007-07-26 dprice * calc_quantities.f90: mri deltav added 2007-07-24 dprice * exact_shock.f90: bug fix with rarefaction position in isothermal solution 2007-07-23 dprice * Makefile: spectrum SYSTEM added 2007-07-16 dprice * Makefile: zen system changes 2007-07-11 dprice * splash.f90: v1.9.1 2007-07-11 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.9.1 2007-07-11 dprice * splash.f90: v1.9.1 2007-07-11 dprice * docs/splash.tex, read_data_gadget.f90: info about environment variables added 2007-07-11 dprice * docs/splash.tex: = changed to default= 2007-07-11 dprice * read_data_gadget.f90: GSPLASH_USE_Z environment variable added to use redshift in the legend instead of time 2007-07-11 dprice * read_data_gadget.f90: GSPLASH_USE_Z environment variable added to use redshift in the legend instead of time 2007-07-06 dprice * Makefile: changes to zen system 2007-07-06 dprice * interpolate3D_projection.F90: openMP bug fixed 2007-07-06 dprice * interpolate3D_opacity.f90, options_powerspec.f90: no compiler warnings 2007-07-06 dprice * get_data.f90: warning if no SPH particles in data 2007-07-06 dprice * splash.f90: citation info added 2007-07-06 dprice * read_data_VINE.f90, read_data_gadget.f90, read_data_sphNG.f90, read_data_sro.f90: better memory use in gadget read; also various environment variables implemented 2007-07-06 dprice * Makefile, system_f2003.f90, system_unix.f90, system_unix_NAG.f90, system_utils.f90: system utils separate from system files 2007-07-06 dprice * defaults.f90: errors caught when opening defaults file 2007-07-06 dprice * prompting.f90: functions for upper and lower casing of strings added 2007-06-22 dprice * legends.f90: time is rounded up and down (not just down as previously) 2007-06-22 dprice * splash.f90: excludes blank arguments from command line 2007-06-22 dprice * timestepping.f90: better time display if time not read 2007-06-20 dprice * colours.f90: two more Bate colour schemes added 2007-06-20 dprice * options_page.f90: minor bug fix with formatting 2007-06-20 dprice * splash.f90: v1.9+ 2007-06-20 dprice * plotstep.f90: option for legend only on first row/column/nth plot implemented 2007-06-20 dprice * titles.f90: filenames for titles and legend changed to splash.titles and splash.legend to be consistent with elsewhere 2007-06-20 dprice * options_page.f90: neatened up legend+title menu plus option for legend only on first row/column/nth plot added 2007-06-20 dprice * prompting.f90: prompting now uses default= not = plus quotes around character string default 2007-06-20 dprice * options_page.f90: bug fix with constraints on nacross,ndown 2007-06-19 dprice * colours.f90: black-blue-cyan-yellow colour scheme added (suggested by Vid Irsic) 2007-06-19 dprice * powerspectrums.f90: fftw stuff commented out 2007-06-18 dprice * Makefile, interpolate3D.f90, interpolate3D_xsec.f90, plotstep.f90, powerspectrums.f90: interpolate3D now a separate module so can be optimised 2007-06-18 dprice * interpolate3D_xsec.f90: fastsqrt stuff taken out of interpolate3D 2007-06-18 dprice * plotstep.f90, powerspectrums.f90: power spectrum routines for 3D added (requires library function -- and 3D interpolation which is VERY slow) 2007-06-18 dprice * interpolate3D_projection.F90: normalisation option added to 3D vector projection routine 2007-06-18 dprice * interpolate3D_projection.F90: bug fix with column density units if 3D perspective on 2007-06-18 dprice * interpolate3D_xsec.f90: optimised 3D interpolation routine 2007-05-24 dprice * particleplot.f90: fast particle plot applies only if plotting > 100 particles 2007-05-24 dprice * plotstep.f90, rotate.f90: slightly faster rotation (+done in parallel) 2007-05-22 dprice * colours.f90, render.f90: bug fix with inverse greyscale: greyscale now behaves like other colour schemes 2007-05-22 dprice * read_data_sphNG.f90: bug fixes with phantom read 2007-05-21 dprice * docs/splash.tex: star formation tutorial added 2007-05-21 dprice * : star formation tutorial figures 2007-05-21 dprice * read_data_gadget.f90: better label for density on gadget read 2007-05-21 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.9.0 2007-05-21 dprice * : sedov example 2007-05-21 dprice * : figs for surface rendering tutorial 2007-05-21 dprice * splash.f90: v1.9 2007-05-21 dprice * docs/splash.bbl, docs/splash.tex: more improvements to user guide 2007-05-03 dprice * splash.f90: v1.9beta 2007-05-03 dprice * read_data_VINE.f90: vine data read now works for 2D, also added MHD read based on VINE_MHD environment variable 2007-05-03 dprice * plotstep.f90: bug fix in declarations 2007-05-03 dprice * Makefile, read_data_VINE.f90: bug fixes with VINE 2007-05-03 dprice * interpolate_vec.f90: minor change to comment 2007-05-03 dprice * options_page.f90, plotstep.f90: automatic line width selection implemented 2007-05-03 dprice * docs/splash.tex: more added to tutorials 2007-05-03 dprice * read_data_sphNG.f90: minor bug fix with declarations 2007-04-30 dprice * docs/splash.tex: more userguide updates 2007-04-30 dprice * Makefile: asplash also builds universal binary on maccluster 2007-04-30 dprice * plotstep.f90: minor bug fix with terminal log for 2D xsec 2007-04-30 dprice * plotstep.f90: x axis label reads x if 2D cross section is not oblique 2007-04-30 dprice * plotstep.f90: allocation clean-up + minor change to 2D xsec setup 2007-04-30 dprice * read_data_sphNG.f90: reset centre of mass option added for sphNG read 2007-04-26 dprice * options_xsecrotate.f90: log steps used for optical depth in animation sequences if tauend> 1000.*taustart or tauend<0.001*tauend 2007-04-26 dprice * interactive.f90: minor bug fix with zoom and - on colour bar in interactive mode 2007-04-26 dprice * colours.f90: bate colour scheme name change 2007-04-26 dprice * options_particleplots.f90, options_xsecrotate.f90: better menu labels 2007-04-26 dprice * plotstep.f90: bug fix with opacity setting if h limit very close to zero 2007-04-26 dprice * docs/splash.tex: vast amount added to userguide 2007-04-24 dprice * titles.f90: bug fix with log output if title/legend files do not exist 2007-04-24 dprice * splash.f90: alternative to command line filename specification is to create a file called splash.filenames (only read if nothing on command line) -- this is a workaround for a problem on the ukaff (xlf) compiler with lots of command line arguments 2007-04-24 dprice * Makefile, asciiutils.f90, read_data_ascii.f90, titles.f90: new utility module for reading ascii files; neatened up other routines which now use this module instead of repeating code 2007-04-24 dprice * interactive.f90: help displays options even if not applicable to current plot 2007-04-24 dprice * Makefile, calc_quantities.f90, globaldata.f90, interactive.f90, options_data.f90, options_limits.f90, plotstep.f90: radius is calculated relative to tracked particle if particle tracking limits are set 2007-04-24 dprice * Makefile, calc_quantities.f90, globaldata.f90, options_data.f90, options_xsecrotate.f90, plotstep.f90: origin settings now also apply in transformation to cylindrical and spherical coords 2007-04-24 dprice * options_xsecrotate.f90: bug fix with origin not being saved 2007-04-24 dprice * Makefile: dependency order fixed 2007-04-24 dprice * calc_quantities.f90: radius calculation uses origin settings 2007-04-13 dprice * docs/splash.tex: more added to vastly-improved user guide 2007-04-12 dprice * get_data.f90, globaldata.f90, limits.f90, menu.f90, options_particleplots.f90, plotstep.f90: initial limits setting also applies coordinate transformation: icoordsnew now in settings_data 2007-04-12 dprice * geometry.f90: limits also transformed for toroidal coordinate system 2007-04-12 dprice * options_page.f90, options_xsecrotate.f90: improved menu option descriptions 2007-04-12 dprice * setpage.f90: minor print statement changed 2007-04-12 dprice * interpolate3D_xsec.f90: skips particles with h < 0 and carries on 2007-04-05 dprice * interpolate3D_opacity.f90: optimisations + just skips parts if h<0 2007-04-04 dprice * plotstep.f90: bug fix: colour bar off for 2D cross section 2007-04-04 dprice * plotstep.f90: bug fix: rotation only allowed in cartesian coords 2007-04-04 dprice * plotstep.f90: gives warning about rotation+vectors 2007-04-04 dprice * options_xsecrotate.f90: bug fix with nframes not being set for interactive sequence setting 2007-04-04 dprice * interactive.f90, options_xsecrotate.f90, plotstep.f90: bug fix with sequences with logged axes; also sequences can now be set interactively using e) in interactive mode 2007-04-04 dprice * globaldata.f90, interactive.f90, menu.f90, options_xsecrotate.f90, plotstep.f90, splash.f90: animation sequences implemented 2007-04-04 dprice * options_page.f90: tiling on by default; titles off by default 2007-03-28 dprice * scripts/supersphplot_parallel.pl: obsolete 2007-03-28 dprice * docs/version, docs/version_history, docs/version_history_tex.tex: version 1.8.1 2007-03-28 dprice * docs/version: version 1.8.1 2007-03-28 dprice * splash.f90: version 1.8.1 2007-03-28 dprice * docs/splash.tex: some improvements to the manual (still kind of outdated, but slightly less so) 2007-03-26 dprice * interpolate_vec.f90, options_vecplot.f90, plotstep.f90: minimum number of particles for arrow to be plotted can be specified 2007-03-26 dprice * interpolate_vec.f90: comments added 2007-03-26 dprice * interpolate_vec.f90, options_vecplot.f90, plotstep.f90: option to hide vector arrows where there are no particles implemented; seems to work 2007-03-23 dprice * interpolate3D_projection.F90: info about uthermcutoff printed in synchrotron plots 2007-03-23 dprice * plotstep.f90: integrated vector plots use z in code units, not unit of z integration (avoids round-off issues with physical units) 2007-03-23 dprice * interpolate3D_projection.F90, options_vecplot.f90, plotstep.f90: utherm cutoff added to synchrotron options 2007-03-23 dprice * plotstep.f90: minor bug fix with npixy calculation for vector plots 2007-03-23 dprice * plotstep.f90: better synchrotron plotting sequence (arrows appear before intensity is calculated) 2007-03-23 dprice * interpolate3D_projection.F90: openmp bug fixes 2007-03-23 dprice * interpolate3D_projection.F90, plotstep.f90: better contours on synchrotron map (uses more pixels) 2007-03-23 dprice * calc_quantities.f90: minor change to tiny() fixing compiler issue (g95) with debug flags set 2007-03-23 dprice * options_render.f90: can set number of contours to zero 2007-03-23 dprice * plotstep.f90: label changed back to int B dz for vector plots in 3D 2007-03-23 dprice * interpolate3D_projection.F90, plotstep.f90: minimum resolution length implemented: equal to pixel size - means plots are much smoother 2007-03-20 dprice * interactive.f90: z(Z) key in interactive mode now goes up to x10^6 2007-03-20 dprice * interpolate_vec.f90: bug with interface 2007-03-20 dprice * interpolate_vec.f90, plotstep.f90: vector plot reverted to averaging routine (smoother plots where field is highly disordered) 2007-03-20 dprice * Makefile, plotstep.f90: interpolate_vec used (trial) 2007-03-20 dprice * interpolate3D_opacity.f90, plotstep.f90, read_data_dansph.f90, read_data_gadget.f90: only clauses improved; fewer compiler warnings 2007-03-19 dprice * plotstep.f90: bug fixes with a) on multiple-plots per page; some internal restructuring required 2007-03-19 dprice * interactive.f90: more information given when hitting a) 2007-03-19 dprice * options_xsecrotate.f90: writeppm now optional for opacity-rendered plots 2007-03-19 dprice * interpolate3D_opacity.f90: writeppm now separate routine 2007-03-15 dprice * interpolate3D_projection.F90: corrections for particles entirely within a single pixel removed 2007-03-15 dprice * interpolate3D_projection.F90: corrections for particles entirely within a single pixel added 2007-03-15 dprice * plotstep.f90: bug fix with labels for vector plot legend in physical units 2007-03-15 dprice * Makefile: openmp flag added properly for gfortran 2007-03-15 dprice * interpolate3D_projection.F90: parallel versions of vector interpolations added 2007-03-15 dprice * interpolate3D_projection.F90: bug fix with synchrotron stuff 2007-03-15 dprice * calc_quantities.f90, plotstep.f90: bad bug fixes in yesterdays build (2 seg faults fixed) 2007-03-15 dprice * Makefile: debug flags added for ifort 2007-03-15 dprice * Makefile, interpolate3D_projection.F90: bug fix with _openmp 2007-03-15 dprice * Makefile: Makefile handles new preprocessed parallel routine 2007-03-15 dprice * interpolate3D_projection.F90: new unified, preprocessed parallel routine 2007-03-15 dprice * interpolate3D_projection.f90, interpolate3D_projection_P.f90: obsolete 2007-03-14 dprice * interpolate3D_projection.f90, interpolate3D_projection_P.f90, options_vecplot.f90, plotstep.f90: implemented synchrotron map calculation 2007-03-14 dprice * splash.f90: version 1.8 2007-03-14 dprice * calc_quantities.f90: much neater calc_quantities routine (subroutine addcolumn added) 2007-03-13 dprice * options_vecplot.f90, render.f90: option to turn arrow heads off implemented 2007-03-13 dprice * interactive.f90, plotstep.f90: bug fixes with a) implementation for multiple plots per page 2007-03-12 dprice * plotstep.f90: bug fix with seg fault if multiplot settings > ncolumns (e.g. in defaults file) 2007-03-12 dprice * interactive.f90, plotstep.f90: implemented a) in interactive mode for multiple-plots-per-page (restricted at present to max,min over all panels) 2007-03-08 dprice * plotstep.f90: opacity rendering uses hmin and pmassmin (easier to get kappa right) 2007-03-08 dprice * INSTALL, INSTALL.macosx, README: name changed to splash 2007-03-08 dprice * Makefile: debug flags added for ukaff 2007-03-08 dprice * units.f90: bug fix with z integration units reading (causing seg fault) 2007-03-08 dprice * interactive.f90: bug fix with o) in interactive mode for y axis 2007-03-08 dprice * calc_quantities.f90: v. minor bug fix 2007-03-08 dprice * defaults.f90, options_data.f90, units.f90: units defaults now set in units module 2007-03-07 dprice * options_data.f90, plotstep.f90, read_data_sphNG.f90, units.f90: implemented unit for z integration (means can have different units for x, y, z like kpc but still have column density in g/cm^2 for example 2007-03-07 dprice * plotstep.f90: bug fix with background foreground colour on vector plots if axes are overlaid in background colour 2007-03-07 dprice * interactive.f90: g)radient option implemented for interactive mode with multiple-plots-per-page 2007-03-07 dprice * read_data_ascii.f90: minor typo fixed in warning 2007-02-26 dprice * Makefile: astromac system variable added 2007-02-21 dprice * splash.f90: version uses same string in both places; 1.8beta 2007-02-21 dprice * read_data_sphNG.f90: reads dumps from phantom 2007-02-21 dprice * exact_shock.f90: bug fix with left going shock wave 2007-02-21 dprice * interactive.f90, interpolate1D.f90, interpolate2D.f90, interpolate3D_opacity.f90, interpolate3D_projection.f90, interpolate3D_projection_P.f90, interpolate3D_xsec.f90, plotstep.f90: hidden particles now also not used in rendering; means can isolate portions of flow; can select particles even on render plots in interactive mode 2007-02-20 dprice * read_data_sro.f90: hfact can be set via RSPLASH_HFACT environment variable 2007-02-20 dprice * interpolate3D_opacity.f90: minor change to log output 2007-02-20 dprice * interpolate1D.f90, interpolate2D.f90, interpolate3D_xsec.f90: log output indicates whether normalised or not 2007-02-19 dprice * read_data_sphNG.f90: bug fix with small dump reads with extra quantities 2007-02-19 dprice * read_data_sphNG.f90: bug fix with small dump reads with extra quantities; preliminary stuff for phantom data read 2007-02-19 dprice * interactive.f90, plotstep.f90: x option for interactively setting cross section can be used in column density mode (ie. changes automatically from projection to cross section) 2007-02-19 dprice * splash.f90: v1.7.2 2007-02-19 dprice * docs/splash.tex, geometry.f90: overhaul of geometry module: vector components are now all physical components (have same dimensions as original vector, ie. vphi = r\dot{\phi} etc; done now for all co-ordinate systems; docs updated accordingly 2007-02-19 dprice * menu.f90, options_data.f90, options_page.f90, options_particleplots.f90, options_render.f90, options_vecplot.f90, options_xsecrotate.f90: menu shortcuts implemented 2007-02-19 dprice * options_limits.f90: menu shortcuts implemented; help mode obsolete 2007-02-19 dprice * docs/splash.tex: v minor bug fix in manual 2007-02-19 dprice * Makefile: v minor debugflag changes 2007-02-19 dprice * interactive.f90: z) also zooms (same as Z) in interactive mode 2007-02-19 dprice * calc_quantities.f90, limits.f90: bug fix if no data read and calc_quantities called 2007-02-08 dprice * exact.f90, exact_torus.f90: exact solution added for Jphi in tokamak torus 2007-02-08 dprice * exact.f90, exact_torus.f90: exact solution for Btheta in torus added 2007-02-08 dprice * menu.f90, options_particleplots.f90: menu shortcuts implemented (trial only with o menu at present) 2007-02-07 dprice * docs/splash.tex, geometry.f90: bug fixes to angular vector components in toroidal co-ordinates 2007-02-07 dprice * calc_quantities.f90: rho*u calculated for hydro 2007-02-07 dprice * exact_torus.f90: fixed exact solution for nu=2 torus 2007-02-06 dprice * plotstep.f90: BUG fix with units label showing on vector plots even when in code units 2007-02-06 dprice * geometry.f90: BUG FIX with phi component of vectors in cylindrical geometry 2007-02-05 dprice * geometry.f90: v\phi really v\phi for cylindricals 2007-02-03 dprice * options_limits.f90: more minor improvements to menu prompt 2007-02-02 dprice * read_data_sphNG.f90: more robust data read: fixes Clares problem with single precision reads 2007-02-02 dprice * options_limits.f90: slight improvements to user prompts 2007-02-02 dprice * read_data_ascii.f90: minor change only 2007-02-02 dprice * read_data_ascii.f90: minor change only 2007-02-02 dprice * read_data_ascii.f90: minor change only 2007-02-02 dprice * tests/test_fieldlines.f90: new test for fieldlines added (currently fails dismally) 2007-02-02 dprice * interactive.f90: o) option works better in interactive mode + zooming now always centred (not relative to cursor position) 2007-02-02 dprice * allocate.f90, plotstep.f90: time not plotted if has not been read from file; also better replotting behaviour when nplots < npanels 2007-01-25 dprice * read_data_sro.f90: no longer makes assumptions about file names 2007-01-25 dprice * read_data_sphNG.f90: BUG FIX with MHD reads for columns > 13 2007-01-18 dprice * scripts/splash_parallel.pl: improved ssh/xgrid farming utility 2007-01-18 dprice * tests/test_fieldlines.f90: interface to streamlines updated 2007-01-18 dprice * fieldlines.f90, plotstep.f90: bug fixes with streamline plotting 2007-01-18 dprice * options_page.f90: restrictions on page size removed; titles back on by default 2007-01-17 dprice * get_data.f90: bug fix with limits file reading with buffered data 2007-01-15 dprice * timestepping.f90: regression/bug with colour-by-type 2007-01-15 dprice * splash.f90: -v valid command line option; no compiler warnings 2007-01-15 dprice * options_particleplots.f90: label particles option removed (but not yet deleted) 2007-01-15 dprice * options_particleplots.f90, timestepping.f90: improved colour-particle-by-type option; makes clear what is going on; overrides interactive settings 2007-01-15 dprice * Makefile: minor changes to comments, debugflags, also universal binary build added for maccluster settings 2007-01-15 dprice * interactive.f90, particleplot.f90, plotstep.f90: bug fix/regression in sink particle plotting (again): icolour now = -1 for non-plotted particles; only checks z * particleplot.f90, plotstep.f90: BUG FIX/regression with particle plotting (sinks not appearing...) 2007-01-10 dprice * Makefile: minor changes for sun compiler 2007-01-10 dprice * splash.f90: spits out number of filenames read from command line 2007-01-10 dprice * options_limits.f90: obsolete options removed 2007-01-04 dprice * splash.f90: version 1.7.1 2007-01-04 ayliffe * get_data.f90: bug fix with character declaration 2007-01-04 ayliffe * read_data_sphNG.f90: bug fix with iphase read 2006-12-15 dprice * read_data_sro.f90: units for WD read implemented 2006-12-15 dprice * defaults.f90: bug fix with new command line options 2006-12-14 dprice * splash.f90: bug fix with command line read 2006-12-14 dprice * defaults.f90, globaldata.f90, menu.f90, splash.f90: command line options for defaults and limits files implemented 2006-12-13 dprice * read_data_sro.f90: minor changes; better labels for abundances; also bug fix with dump file number getting 2006-12-12 dprice * splash.f90: version 1.7.0 2006-12-12 dprice * read_data_sro.f90: nearly there with abun read 2006-12-12 dprice * read_data_sro.f90: bug fix with abun read 2006-12-12 dprice * read_data_sro.f90: reads abundance files 2006-12-12 dprice * read_data_sro.f90: hydro read implemented, plus environment variable settings 2006-12-12 dprice * system_f2003.f90, system_unix.f90, system_unix_NAG.f90: environment variable reading added to system commands 2006-12-11 dprice * interpolate3D_projection.f90, interpolate3D_projection_P.f90, particleplot.f90, plotstep.f90: bug fix with 3D projections (particles with z > zobserver no longer plotted) 2006-12-07 dprice * Makefile, defaults.f90, docs/splash.bbl, docs/splash.tex, docs/supersphplot.bbl, docs/supersphplot.tex, get_data.f90, interpolate3D_opacity.f90, menu.f90, options_data.f90, options_limits.f90, read_data_gadget.f90, splash.f90, supersphplot.f90, transform.f90: name changed to splash for version 1.7 2006-12-06 dprice * plotstep.f90, timestepping.f90: BUG FIX with vector components in partial data reads 2006-12-05 dprice * calc_quantities.f90, get_data.f90, units.f90: improved units setting prompts and units labelling of calculated quantities 2006-11-24 dprice * units.f90: minor changes to warnings/ label suggestions 2006-11-24 dprice * calc_quantities.f90: automatically sets unit label for vector magnitudes 2006-11-24 dprice * Makefile: minor flag changes for maccluster 2006-11-24 dprice * interactive.f90, plotstep.f90: BUG FIX with panel determination in interactive mode on multiplots if nsteps < nacross*ndown 2006-11-23 dprice * read_data_ascii.f90: attempts to read gamma from ascii file header 2006-11-23 dprice * read_data_ascii.f90: attempts to read gamma from ascii file header 2006-11-21 dprice * read_data_ascii.f90: minor changes; warns about NaNs and Infs and recognises B field in columns file 2006-11-21 dprice * exact_shock.f90: solution implemented for left-going and right-going shocks and rarefactions 2006-11-20 dprice * Makefile: various presets added/changed 2006-11-20 dprice * docs/supersphplot.tex, geometry.f90: bug fix with spherical vector transforms; also toroidal coordinate system implemented for vectors; documentation added for these 2006-11-20 dprice * docs/supersphplot.tex: preliminary docs for geometry module 2006-11-17 dprice * plotstep.f90: bug fix with partial data reads 2006-11-17 dprice * exact.f90, exact_torus.f90: exact solution for tokamak torus added 2006-11-17 dprice * geometry.f90: toroidal co-ordinates added 2006-11-10 dprice * get_data.f90, options_data.f90, units.f90: working units file save 2006-11-09 dprice * Makefile, calc_quantities.f90, get_data.f90, globaldata.f90, menu.f90, options_data.f90, plotstep.f90, read_data_mbate.f90, read_data_sphNG.f90, read_data_sro.f90, units.f90: new units module; preliminary implementation of units file saving 2006-11-09 dprice * scripts/supersphplot_parallel.pl: minor changes 2006-11-09 dprice * read_data_sphNG.f90: Bfield units implemented 2006-11-09 dprice * interactive.f90: minor bug fix with inexact exception with uninitialised xpt2,ypt2 2006-11-09 dprice * menu.f90: BUG FIX if nplots set to 1 in multiplot options 2006-11-09 dprice * options_page.f90: minor bug fix with menu options 2006-11-09 dprice * options_particleplots.f90: bug fix with menu option > 10 not working 2006-11-09 dprice * read_data_ascii.f90: more column labels recognised 2006-11-09 dprice * calc_quantities.f90, get_data.f90, globaldata.f90, plotstep.f90, read_data_gadget.f90, read_data_sphNG.f90, timestepping.f90: partial data read implemented in gadget and sphNG reads (factor of ~2-3 speedup in read from disk for >1 files) 2006-11-09 dprice * interpolate2D.f90: comments only 2006-11-09 dprice * read_data_rsph.f90: bug fixes with rsph read 2006-11-09 dprice * colours.f90: very minor change to label 2006-11-09 dprice * interpolate3D_xsec.f90: very minor optimisation 2006-11-08 dprice * colours.f90: Bate red-yellow-white colour scheme added 2006-11-07 dprice * read_data_sphNG.f90: temporary hack to catch corrupt small dump files 2006-11-07 dprice * options_limits.f90, options_render.f90, options_xsecrotate.f90: new style menus 2006-11-07 dprice * options_data.f90, options_vecplot.f90: new menu format 2006-11-07 dprice * options_page.f90, setpage.f90: iaxis=-4 option added 2006-11-06 dprice * plotstep.f90: improved behaviour for interactive mode with nstepsperpage > 1 (uses interactive_multi) 2006-11-06 dprice * options_particleplots.f90: bug fix with formatting for ntypes<=1 2006-11-02 dprice * legends.f90: minor cleanup, documentation added for legend_scale subroutine 2006-11-01 dprice * options_particleplots.f90, timestepping.f90: option for default colours for particle types implemented; some issues remain 2006-11-01 dprice * read_data_sphNG.f90: time units are free-fall times; various minor clean ups 2006-10-31 dprice * options_page.f90, plotstep.f90: option to use background colour for overlaid axes and text added 2006-10-31 dprice * legends.f90, options_page.f90, plotstep.f90: option to plot scale on co-ordinate plots implemented; also units label on column densities works for sphNG 2006-10-31 dprice * prompting.f90: added function for printing logical variables in menus as ON or OFF 2006-10-31 dprice * options_page.f90, plotstep.f90: improvements to legend and title option settings; also option to plot time legend only for first row added 2006-10-24 dprice * supersphplot.f90: version 1.6.2 2006-10-24 dprice * read_data_sphNG.f90: bug fix with units in new read 2006-10-20 dprice * read_data_sphNG.f90: reads both full and small dumps and can mix the two 2006-10-16 dprice * scripts/supersphplot_parallel.pl: working ssh version 2006-10-16 dprice * scripts/supersphplot_parallel.pl: minor changes 2006-10-13 dprice * scripts/supersphplot_parallel.pl: working xgrid version 2006-10-12 dprice * scripts/supersphplot_parallel.pl: parallel farming utility to do one-frame-per-processor 2006-10-12 dprice * Makefile: make all option 2006-10-12 dprice * tests/test_fieldlines.f90: error check added 2006-10-12 dprice * options_particleplots.f90, particleplot.f90: fast particle plotting implemented 2006-10-12 dprice * plotstep.f90: bug fix with colour bar limits changing for multiple plots per page; also much neater 2006-10-12 dprice * interactive.f90: bug fix with colour bar limits changing for multiple plots per page 2006-10-12 dprice * menu.f90: bug fix with default values of vector plotting prompt for multiplots 2006-10-06 dprice * tests/test_fieldlines.f90: added test for fieldlines module 2006-10-06 dprice * Makefile: fieldlines test added; gfortran system type 2006-10-06 dprice * interpolate3D_xsec.f90: minor optimisations 2006-10-05 dprice * docs/supersphplot.tex: bug fix with L2 definition in manual 2006-10-05 dprice * fieldlines.f90: minor changes 2006-10-05 dprice * fieldlines.f90, options_vecplot.f90, plotstep.f90: plot streamlines option implemented; works OK in 2D; a bit funny in 3D 2006-09-28 dprice * setpage.f90: spurious print statement removed 2006-09-21 dprice * scripts/getav.pl: bug fix with error parsing script 2006-09-21 dprice * scripts/getav.pl: minor improvements 2006-09-19 dprice * options_page.f90: default line width is now 1 (looks better on pixel images e.g. gif/png) 2006-09-19 dprice * plotstep.f90: bug fix with adaptive limits changing on logged plots (-666) 2006-09-15 dprice * interactive.f90: bug fix with zoom on colourbar for multiple-plots-per-page 2006-09-15 dprice * plotstep.f90: bug fix with floating exception with optimisation on sun compiler 2006-09-14 dprice * render.f90: no labels printed on contour plots 2006-09-14 dprice * options_particleplots.f90: menu arranged better 2006-09-12 dprice * globaldata.f90: maxfile is now 10001 2006-09-11 dprice * read_data_sphNG.f90: bug fix with sink particles/dead particles 2006-09-07 dprice * colours.f90: haze colour scheme improved 2006-09-07 dprice * exact.f90, exact_densityprofiles.f90: solution for two-component plummer/hernquist spheres 2006-08-24 dprice * supersphplot.f90: version 1.6.1 2006-08-24 dprice * Makefile: dependencies removed 2006-08-24 dprice * interactive.f90: log output for particle tracking 2006-08-23 dprice * options_page.f90: minor changes to prompts 2006-08-23 dprice * interactive.f90: cursor stays put on multiplots 2006-08-23 dprice * plotstep.f90: bug fix with particle tracking+rotation 2006-08-18 dprice * setpage.f90: bug fix with margins/aspect ratios under some circumstances on tiled plots 2006-08-18 dprice * setpage.f90: buffer removed from y axis label 2006-08-18 dprice * interactive.f90, plotstep.f90: bug fixes with interactive colour bar changing on tiled plots 2006-08-18 dprice * interactive.f90: improved timestep changing for interactive on multiplot 2006-08-17 dprice * read_data_sro.f90: option to reset centre of mass 2006-08-17 dprice * plotstep.f90: outputs centre of mass 2006-08-17 dprice * calc_quantities.f90: error catches for floating exceptions in some cases 2006-08-17 dprice * interactive.f90: bug fixes with interactive on multiplot 2006-08-17 dprice * interactive.f90: improved panel finding 2006-08-16 dprice * exact.f90: ishk saved for mhd shock solution 2006-08-16 dprice * interactive.f90: better panel determination on multiplot-interactive mode 2006-08-16 dprice * exact.f90, exact_mhdshock.f90: minor bug fixes with mhd shock selection 2006-08-15 dprice * exact.f90, plotstep.f90: bug fixes with residual plots 2006-08-15 dprice * exact.f90, plotstep.f90: residual plots fixed for tiled panels 2006-08-15 dprice * options_data.f90: only clauses 2006-08-14 dprice * Makefile, danpgutils.f90, supersphplot.f90: danpgutils obsolete 2006-08-14 dprice * options_page.f90, particleplot.f90, plotstep.f90: bug fix with character height changing between devices; danpgsch now obsolete anyway 2006-08-14 dprice * allocate.f90: more informative error message 2006-08-14 dprice * read_data_dansph.f90: better error catching 2006-08-11 dprice * interactive.f90, plotstep.f90: bad regressions : seg faults if no rendering 2006-08-11 dprice * calc_quantities.f90: bug fix with labels if vector quantity 2006-08-11 dprice * plotstep.f90: bad bug fix with seg fault if ih/irho=0 2006-08-11 dprice * get_data.f90: error check on irho,ipmass,ih after data read 2006-08-10 dprice * supersphplot.f90: version 1.6 2006-08-10 dprice * plotstep.f90: bug fix with log10(1.0) giving blank pixels 2006-08-10 dprice * Makefile: bug fix with 0s instead of Os 2006-08-10 dprice * transform.f90: uses errval for errors instead of zero, can be input by calling routine - default is still zero 2006-08-10 dprice * transform.f90: v.minor 2006-08-10 dprice * Makefile: only -O4 on ukaff1a 2006-08-10 dprice * interpolate3D_projection_P.f90: no preprocessing 2006-08-10 dprice * INSTALL, INSTALL.macosx, Makefile: new Makefile with preset options for various compilers; corresponding changes to install instructions 2006-08-10 dprice * Makefile: new Makefile with preset options for various compilers; corresponding changes to install instructions 2006-08-10 dprice * Makefile, danpgsch.f, danpgtile.f, danpgutils.f90, danpgwedg.f, particleplot.f90, plotstep.f90, render.f90: .f routines now obsolete; code now f90 only; colour bar routine now draws the colour bar itself 2006-08-10 dprice * options_page.f90: minor changes to output text 2006-08-10 dprice * geometry.f90: some changes; need test for this routine 2006-08-09 dprice * options_render.f90: default number of pixels now 200 2006-08-09 dprice * interpolate3D_projection.f90, interpolate3D_projection_P.f90: message about accelerated rendering included 2006-08-09 dprice * get_data.f90: log messages improved for changed ncolumns 2006-08-09 dprice * scripts/fixpgplotnames.bash: first filename fixed 2006-08-09 dprice * interactive.f90, plotstep.f90: implemented vastly improved interactive mode on multiple-plots-per-page; seems to work 2006-08-09 dprice * setpage.f90: new setpage seems to work 2006-08-09 dprice * options_render.f90, render.f90: bug fixes with colour bar positioning 2006-08-09 dprice * defaults.f90, docs/supersphplot.tex, get_data.f90, options_page.f90, titles.f90: improved multiple-timestep-per-page legend labels/docs 2006-08-09 dprice * timestepping.f90, transform.f90: v. minor changes (public/private) 2006-08-01 dprice * danpgtile.f: bug fix causing seg fault on tiled plot zooming 2006-08-01 dprice * get_data.f90: minor bug fix with warning about ncolumns change 2006-07-31 dprice * interpolate3D_projection_P.f90: updated parallel version 2006-07-27 dprice * read_data_sphNG.f90: closes file on error condition 2006-07-26 dprice * interpolate3D_projection.f90, interpolate3D_xsec.f90: highly optimised (at least for my mac), factors of >3 speedup in interpolation 2006-07-25 dprice * scripts/fixgifs.bash, scripts/fixpgplotnames.bash, scripts/fixpngs.bash: new script for fixing pgplot filenames (more general - handles both png and gif and can offset file numbers also) 2006-07-25 dprice * read_data_sro.f90: bug fix/regression with error catch 2006-07-24 dprice * setpage.f90: bug fix with NOPGBOX 2006-07-24 dprice * calc_quantities.f90: minor changes; particle volume added but commented out 2006-07-24 dprice * read_data_ascii.f90: v. minor changes to output warnings 2006-07-24 dprice * menu.f90: better help message 2006-07-24 dprice * read_data_rsph.f90: general clean-up 2006-07-24 dprice * INSTALL, INSTALL.macosx, README: minor changes 2006-07-24 dprice * read_data_sro.f90: error catches for npart=0 2006-07-21 dprice * INSTALL.macosx: detailed instructions for mac os/x 2006-07-21 dprice * read_data_rsph.f90: bug fix with plot labels 2006-07-20 dprice * read_data_rsph.f90: revised rsph format; includes plot labels 2006-07-20 dprice * menu.f90: gwaves not there by default 2006-07-20 dprice * get_data.f90: warning if ih,ipmass,irho not present 2006-07-20 dprice * read_data_rsph.f90: updated rsph read 2006-07-20 dprice * options_page.f90, options_particleplots.f90, options_render.f90, options_vecplot.f90: toggles removed 2006-07-20 dprice * options_limits.f90, transform.f90: integer overflow bug fix with transform_label 2006-07-20 dprice * Makefile, read_data_rsph.f90: rsph data read 2006-07-18 dprice * setpage.f90: unified setpage routine added 2006-07-18 dprice * colours.f90: four new colour schemes added; bug fix with rainbow II=rainbowIII 2006-07-13 dprice * menu.f90, plotstep.f90: quick hack for plotting gravitational waves 2006-07-06 dprice * supersphplot.f90: version 1.5.4 2006-07-06 dprice * docs/supersphplot.tex: docs for multiple types added 2006-07-06 dprice * read_data_sphNG.f90: bug fix with nghost 2006-07-06 dprice * plotstep.f90: comment removed 2006-07-06 dprice * defaults.f90: defaults for UseTypeInRendering 2006-07-06 dprice * globaldata.f90, options_particleplots.f90, plotstep.f90, read_data_VINE.f90, read_data_ascii.f90, read_data_dansph.f90, read_data_dansph_old.f90, read_data_gadget.f90, read_data_gadget_jsb.f90, read_data_jjm.f90, read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90, read_data_scw.f90, read_data_sphNG.f90, read_data_spyros.f90, read_data_sro.f90: UseTypeInRendering now set in set_labels routine, not as an option 2006-07-06 dprice * particleplot.f90: bug fix in case of npartoftype=0 for some intermediate type 2006-07-06 dprice * options_particleplots.f90: minor bug fix with plotonrenderings settings 2006-07-06 dprice * options_particleplots.f90, plotstep.f90: other particle types can now contribute to renderings (if turned on by menu option) 2006-07-06 dprice * interpolate1D.f90: uses dimensionless weights; comments updated; carries on (just skips particle) if h <= 0 or weight <= 0 2006-07-06 dprice * interpolate2D.f90: comments updated; carries on (just skips particle) if h <= 0 or weight <= 0 2006-07-06 dprice * plotstep.f90: floating exception if h or rho=0 in weights fixed 2006-07-06 dprice * plotstep.f90, setpage.f90: axes re-drawn on top of particle plots/renderings - tick marks now show up etc 2006-07-03 dprice * Makefile: exact_torus in Makefile 2006-07-03 dprice * exact_torus.f90: exact solution for pap-pringle torus 2006-07-03 dprice * read_data_sphNG.f90: bug fix with end-of-file errors 2006-06-27 dprice * supersphplot.f90: v1.5.3 2006-06-27 dprice * options_render.f90: accelerated rendering off by default 2006-06-27 dprice * exact.f90, plotstep.f90: units sent into exact solution routine - used on exact_fromfile only at present 2006-06-26 dprice * menu.f90, plotstep.f90: bug fixes/ improvements in multiplot prompting, x-sections in multiplots 2006-06-23 dprice * read_data_sro.f90: more error tolerant 2006-06-20 dprice * danpgtile.f, plotstep.f90, render.f90: colour bar spans all rows on tiled plots 2006-06-20 dprice * danpgtile.f: bug fix/regression with margins 2006-06-20 dprice * danpgtile.f, plotstep.f90, setpage.f90: bug fix with colour bar on tiled plots; also with page setup with axis ratios < 1.0 and plot tiling with colour bars 2006-06-20 dprice * danpgtile.f: bug fix with axis ratios < 1.0 (now plots top to bottom not bottom to top) 2006-06-19 dprice * plotstep.f90: bug fix/regression with legend plotting (must be done after rendering) 2006-06-19 dprice * interactive.f90: no auto change of justification 2006-06-06 dprice * plotstep.f90: bug fix with titles; a bit of cleanup also 2006-06-06 dprice * plotstep.f90: no log on label for iaxis=10,20,30 2006-06-06 dprice * read_data_ascii.f90: bug fix with reallocate if ncolumns changes 2006-06-05 dprice * options_page.f90: log labelling allowed on x and y axes 2006-06-01 dprice * scripts/getav.pl: uses argv; can do multiple files 2006-06-01 dprice * scripts/getav.pl: script for getting average of L2 errors 2006-06-01 dprice * read_data_dansph.f90: columns labelled correctly 2006-05-24 dprice * plotstep.f90: regression/bug fix with 2D mem allocation/deallocation 2006-05-24 dprice * menu.f90: continue statement removed; also dies gracefully if reaches end of stdin (ie. when scripted) 2006-05-24 dprice * limits.f90: only prints eof warning when important 2006-05-22 dprice * exact_shock.f90: improved isothermal solution 2006-05-19 dprice * legends.f90: bug fix with vecmax=0 in vector plot legend 2006-05-16 dprice * interpolate3D_projection.f90: further optimisation (less work for particles which do not contribute) 2006-05-16 dprice * interpolate3D_projection.f90: integer overflow fixed for counter on > 20m particles 2006-05-16 dprice * read_data_sphNG.f90: bug fix with accreted particle removal; time units added 2006-05-16 dprice * timestepping.f90: time formatting fixed (handles large t) 2006-05-16 dprice * legends.f90: bug fix/improved time label formatting (handles large, -ve t) 2006-05-12 dprice * interpolate3D_projection.f90, options_render.f90, plotstep.f90, tests/test_interpolate3D.f90: accelerated rendering implemented (3D projections >2x faster) 2006-05-11 dprice * supersphplot.f90: v1.5.2 2006-05-11 dprice * interactive.f90, plotstep.f90: no unnecessary re-rendering (MUCH faster limits changing etcfor large datasets); also bug fix with a) on render plots 2006-05-09 dprice * docs/supersphplot.bbl: updated bibliography 2006-05-09 dprice * colours.f90: demo plot can be to any device 2006-05-09 dprice * docs/supersphplot.tex, menu.f90, supersphplot.f90: (S) option which saves both defaults and plot limits; docs for this 2006-05-09 dprice * read_data_sphNG.f90: formatting only (I think) 2006-04-26 dprice * docs/figs/colourschemes.ps, supersphplot.f90: v1.5.1 2006-04-26 dprice * docs/supersphplot.tex: docs updated for version 1.5 2006-04-26 dprice * read_data_gadget.f90: memory allocated for exact number of particles only (unless reallocated) 2006-04-26 dprice * allocate.f90, globaldata.f90, interactive.f90, options_particleplots.f90, particleplot.f90: maximum of 100 circles of interaction can be saved (to save memory) - now allocated statically also 2006-04-21 dprice * plotstep.f90: bug fix (kind of): uses ghosts in interpolation even if not plotting them 2006-03-22 dprice * read_data_gadget.f90: v. minor bug fix (uninitialised variable) 2006-03-22 dprice * interpolate3D_opacity.f90: minor bug fix (z now must be < zobserver) 2006-03-21 dprice * legends.f90: further vector legend fiddling 2006-03-21 dprice * legends.f90: small refinements to vector legend 2006-03-20 dprice * interactive.f90, legends.f90, options_page.f90, plotstep.f90: justification of time legend adjustable 2006-03-17 dprice * legends.f90, options_vecplot.f90: bug fixes with vector legend settings 2006-03-17 dprice * supersphplot.f90: version 1.5 beta 2006-03-17 dprice * supersphplot.f90: version 1.5 2006-03-16 dprice * tests/test_interpolate3D.f90: more tests added 2006-03-16 dprice * interpolate3D_opacity.f90: bug fix with opacity rendering (no new colours generated) 2006-03-16 dprice * legends.f90, options_vecplot.f90, plotstep.f90, render.f90: better vector legend : bug fix with arrow outside of viewport + units added 2006-03-16 dprice * globaldata.f90: bigger maxplot 2006-02-21 dprice * read_data_sphNG.f90: bug fix with dead particle/sink reshuffling 2006-02-15 dprice * scripts/ppm2gif.bash: script to convert ppms to gifs 2006-02-15 dprice * read_data_sphNG.f90: mem allocated better for dead particles 2006-02-15 dprice * options_xsecrotate.f90: options triggered appropriately for surface rendering 2006-02-15 dprice * plotstep.f90: better prompt for surface rendering 2006-02-14 dprice * read_data_sphNG.f90: (should) handle sink/dead particles 2006-02-13 dprice * get_data.f90: bug fix: now handles ncolumn changes during data read (gives warnings) 2006-02-13 dprice * options_particleplots.f90, plotstep.f90: bug fix: limits only changed when different coord system is selected 2006-02-13 dprice * menu.f90: vecprompt bigger 2006-02-13 dprice * calc_quantities.f90: automatic calculation of vector magnitudes 2006-01-23 dprice * interactive.f90: Z) option for accelerated zoom/timestepping 2006-01-23 dprice * plotstep.f90: new interfaces 2006-01-17 dprice * get_data.f90, globaldata.f90, interactive.f90, options_data.f90, timestepping.f90: complete rewrite of timestepping -- now error correcting (cuts out files with nstepsinfile = 0) 2006-01-17 dprice * options_limits.f90: minor bug fix wth set_limits call, also new stepping variables 2006-01-12 dprice * plotstep.f90: bug fix with 3D perspective if iadvance=0 2006-01-12 dprice * plotstep.f90: bug fix with unset log variable 2006-01-12 dprice * interpolate3D_projection.f90: bug fix (NaN in kernel table) 2006-01-12 dprice * plotstep.f90: bug fix (3D perspective non-zero after it has been turned off) 2006-01-12 dprice * docs/supersphplot.tex: docs for 3D perspective added 2006-01-05 dprice * get_data.f90: bug fix in unit labelling (after coord change) 2006-01-05 dprice * get_data.f90: bug fix in unit labelling (after coord change) 2006-01-05 dprice * read_data_sro.f90: bug fix in particle mass setting: now handles unequal mass particle minidumps 2006-01-05 dprice * interpolate3D_opacity.f90, interpolate3D_projection.f90, plotstep.f90: speed enhancements (> factor of 2 faster) (sqrt eliminated) 2006-01-04 dprice * interpolate3D_projection.f90, interpolate3D_xsec.f90, plotstep.f90, tests/test_interpolate3D.f90: projections work with large numbers (uses dimensionless weights) 2006-01-04 dprice * options_data.f90: more on calculated quantity units 2006-01-04 dprice * get_data.f90, options_data.f90: more on calculated quantity units 2006-01-04 dprice * calc_quantities.f90, options_data.f90: units labels set for calculated quantities where possible 2006-01-04 dprice * options_data.f90: oops 2006-01-04 dprice * options_data.f90: improved units menu interface 2006-01-04 dprice * get_data.f90, options_data.f90: improved units menu interface 2006-01-04 dprice * options_data.f90: improved units menu interface 2006-01-03 dprice * tests/test_interpolate3D.f90: minor additions, works with new interfaces 2005-12-21 dprice * options_page.f90: minor bug fix 2005-12-21 dprice * get_data.f90, globaldata.f90, legends.f90, options_data.f90, plotstep.f90, read_data_sro.f90: time rescaling implemented 2005-12-21 dprice * interpolate2D.f90, interpolate3D_xsec.f90, options_render.f90, plotstep.f90: normalisation implemented as an option 2005-12-21 dprice * render.f90: minor improvements 2005-12-21 dprice * options_page.f90: option to change line width added 2005-12-21 dprice * colours.f90: bug fix with red colour table 2005-12-21 dprice * read_data_sro.f90: first attempt at corotating frame vels 2005-12-21 dprice * read_data_sro.f90: units added 2005-12-21 dprice * interpolate2D.f90, interpolate3D_xsec.f90, plotstep.f90: normalised interpolations (2D and 3D xsec) 2005-12-21 dprice * supersphplot.f90: new version label 2005-12-21 dprice * interactive.f90, interpolate3D_opacity.f90, options_xsecrotate.f90, plotstep.f90: cross section of opacity rendering implemented 2005-12-21 dprice * interpolate1D.f90, interpolate2D.f90: bugs fixed (from other interpolation routines) 2005-12-20 dprice * calc_quantities.f90: Bmag calculated 2005-12-20 dprice * colours.f90: gamma no fade fades has some blue shading at bottom 2005-12-20 dprice * get_data.f90, options_data.f90, read_data_mbate.f90, read_data_sphNG.f90: bug fixes with units on calculated quantities 2005-12-16 dprice * colours.f90: gamma with no black added 2005-12-15 dprice * interpolate3D_opacity.f90, plotstep.f90: further bug fixes with opacity rendering 2005-12-15 dprice * options_xsecrotate.f90: comments about rotation added 2005-12-15 dprice * rotate.f90: less confusing rotation angles (z first, then y, then x) 2005-12-15 dprice * colours.f90, options_render.f90: demo plot restored; minor bug fix in red map 2005-12-15 dprice * Makefile, interpolate3D_opacity.f90, options_xsecrotate.f90, plotstep.f90: opacity rendering implemented as an option with sensible defaults 2005-12-15 dprice * docs/supersphplot.tex: docs improved for projections 2005-12-15 dprice * defaults.f90: error if cannot write defaults file 2005-12-15 dprice * read_data_sro.f90: minor change to warnings 2005-12-15 dprice * read_data_dansph.f90, read_data_dansph_old.f90: new format (handles my r-z code) 2005-12-15 dprice * danpgtile.f: aspect ratio adjusted if > 1.0 also 2005-12-15 dprice * colours.f90: lots of new, decent colour tables 2005-12-13 dprice * calc_quantities.f90: bug fix with calculation of MHD quantities if no pressure 2005-12-12 dprice * interpolate3D_projection.f90, interpolate3D_xsec.f90, tests/test_interpolate3D.f90: unit test for 3D interpolations written; minor bugs fixed in these routines 2005-12-06 dprice * interpolate3D_projection.f90, plotstep.f90: ppm files written with numbers 2005-12-06 dprice * plotstep.f90: bug fix: rotation does not use 3D perspective if not set 2005-12-06 dprice * interpolate3D_projection.f90: uses function to interpolate from table 2005-12-06 dprice * colours.f90, interactive.f90, options_render.f90, plotstep.f90, render.f90: ability to invert colour table added (although not currently working for greyscale) 2005-12-06 dprice * colours.f90: minor cleanup 2005-12-06 dprice * plotstep.f90: interface to opacity rendering 2005-12-06 dprice * interpolate3D_projection.f90: intermediate version of opacity rendering (writes ppm) (+BUG fix in kernel, not yet fixed in other routines) 2005-12-02 dprice * read_data_sro.f90: bug fix -- array bounds if iutherm=0 2005-12-02 dprice * menu.f90: no vector prompt if no vectors in data 2005-12-02 dprice * interpolate3D_projection.f90, plotstep.f90: more on opacity rendering 2005-12-01 dprice * colours.f90, interpolate3D_projection.f90, plotstep.f90, supersphplot.f90: intermediate version (no opacity renderings but with 3D perspective) 2005-11-30 dprice * options_page.f90: default is off for plot titles 2005-11-30 dprice * interactive.f90, plotstep.f90, timestepping.f90: annoying issues with timestepping resolved: MUCH better behaviour. Non-interactive devices automatically go through all timesteps, no unnecessary extra plotting 2005-11-30 dprice * legends.f90: bug fix with box size on vector plot legend 2005-11-30 dprice * read_data_sro.f90: labels + read to column 27 2005-11-24 dprice * colours.f90, interactive.f90, interpolate3D_projection.f90, options_xsecrotate.f90, plotstep.f90, rotate.f90: preliminary implementations of 3D plotting using perspective, opacities 2005-10-27 dprice * plotstep.f90: BUG FIX if ipmass,irho,ih=ndataplots 2005-10-25 dprice * interactive.f90: non-interactive devices same as non-interactive mode 2005-10-24 dprice * scripts/fixgifs.bash, scripts/fixpngs.bash: scripts for fixing weird pgplot output names for gifs/pngs 2005-10-20 dprice * read_data_nina.f90: obsolete 2005-10-20 dprice * docs/supersphplot.tex: minor update 2005-10-20 dprice * INSTALL, docs/supersphplot.tex, exact_shock.f90: install instructions updated; things work on pgf90; docs updated 2005-10-13 dprice * interactive.f90, legends.f90, options_vecplot.f90, plotstep.f90, render.f90: vector plot legend; arrow size can be adjusted interactively 2005-10-10 dprice * exact.f90: exact_fromfile checks if file exists at menu prompt 2005-09-29 dprice * read_data_ascii.f90: comments removed 2005-09-28 dprice * supersphplot.f90: version 1.0.5 2005-09-28 dprice * read_data_ascii.f90: better header skipping, makes intelligent guesses about time, also columns automatically set rho, h positions if labels are set 2005-09-27 dprice * plotstep.f90, read_data_mbate.f90: bug fixes 2005-09-27 dprice * read_data_mbate.f90: units added, single/double precision detection 2005-09-27 dprice * get_data.f90, globaldata.f90, menu.f90, options_data.f90: rescale data can be turned on/off independently of units=1 (means you can set units in the read_data routine) 2005-09-27 dprice * exact.f90: bug fix 2005-09-27 dprice * plotstep.f90: interface to exact solution 2005-09-27 dprice * options_render.f90: colour scheme prompt altered slightly 2005-09-27 dprice * docs/figs/colourschemes.ps, docs/supersphplot.tex: colour scheme plot, error norms described 2005-09-27 dprice * exact_densityprofiles.f90: minor changes 2005-09-27 dprice * exact.f90: error plots use particle markers 2005-09-16 dprice * read_data_mbate_mhd.f90: step allocation is 1 2005-09-16 dprice * read_data_sphNG.f90: units 2005-09-16 dprice * plotstep.f90: labels integral of rho as column density 2005-09-16 dprice * menu.f90: unitslabel used properly on vectors/co-ordinates 2005-09-13 dprice * colours.f90: better colour demo 2005-09-13 dprice * exact.f90, exact_densityprofiles.f90, plotstep.f90: exact solution error calculation, residual plotting + potential/force solutions for exact_densityprofiles 2005-09-09 dprice * colours.f90: more/better colour schemes 2005-09-05 dprice * geometry.f90: minor changes (spherical limits, labels) 2005-09-05 dprice * Makefile, exact.f90, exact_densityprofiles.f90: exact density profiles added 2005-09-01 dprice * geometry.f90: spherical vector transforms implemented (not tested) 2005-09-01 dprice * rotate.f90: warping implemented 2005-09-01 dprice * defaults.f90, get_data.f90, legends.f90, options_page.f90, titles.f90: legend for multiple steps per page 2005-09-01 dprice * plotstep.f90: hopefully the last bug with page changing!! 2005-09-01 dprice * timestepping.f90: bug fix 2005-08-25 dprice * options_limits.f90: iadapt set properly when manually setting limits 2005-08-25 dprice * exact.f90, exact_mhdshock.f90: Bx solution added to MHD shocks 2005-08-25 dprice * setpage.f90: bug fix with title offset 2005-08-17 dprice * supersphplot.f90: header v1.0.4 2005-08-17 dprice * docs/supersphplot.tex: updated for v1.0.4 2005-08-17 dprice * supersphplot.f90: version 1.0.4 2005-08-17 dprice * options_page.f90, options_particleplots.f90, timestepping.f90: marker style changing 2005-08-11 dprice * globaldata.f90: more files allowed 2005-08-11 dprice * read_data_sphNG.f90: mem allocation fixed 2005-08-03 dprice * options_limits.f90: zoom not saved 2005-08-03 dprice * defaults.f90, exact.f90, menu.f90, options_limits.f90, options_particleplots.f90, options_xsecrotate.f90, read_data_ascii.f90: unused module variables 2005-08-03 dprice * exact_polytrope.f90: minor changes 2005-07-29 dprice * Makefile, read_data_sphNG.f90: read for new sphNG format 2005-07-29 dprice * interactive.f90: bug fix with a) on y limits 2005-07-28 dprice * supersphplot.f90: intermediate version 2005-07-28 dprice * geometry.f90: minor clean up 2005-07-15 dprice * colours.f90, interactive.f90, plotstep.f90: interactive colour map changing; also added heat colour map 2005-07-15 dprice * colours.f90: two new colour schemes 2005-07-05 dprice * supersphplot.f90: version number on splash screen 2005-07-05 dprice * supersphplot.f90: comments for v1.0.3 2005-07-05 dprice * read_data_sro.f90: minor changes 2005-07-05 dprice * interactive.f90: improved zooming + cursor position saved 2005-07-05 dprice * exact.f90, exact_toystar2D.f90: more work on toystar exact solution in 2D 2005-07-05 dprice * docs/supersphplot.tex: new format; small amendments 2005-06-24 dprice * exact.f90, exact_fromfile.f90: bug fix: exact solution from file now working properly 2005-06-23 dprice * get_data.f90, interpolate3D_projection.f90, limits.f90, supersphplot.f90: print statements formatted slightly better 2005-06-23 dprice * interpolate3D_projection_P.f90: openMP statements compile 2005-06-23 dprice * read_data_sro.f90: bug fix with single precision read 2005-06-23 dprice * docs/supersphplot.tex: some info about specific compilers 2005-06-22 dprice * read_data_sro.f90: double precision detection (full dumps + hydro minidumps) 2005-06-22 dprice * read_data_sro.f90: double precision detection (minidump only so far) 2005-06-22 dprice * interpolate3D_projection_P.f90: upper case + no output 2005-06-22 dprice * interpolate3D_projection_P.f90: updated parallel version 2005-06-21 dprice * interactive.f90, plotstep.f90: interactive setting of particle tracking 2005-06-21 dprice * menu.f90: better formatting (esp. on crap intel compiler) 2005-06-21 dprice * Makefile: whoops 2005-06-21 dprice * Makefile, exact_shock.f90, exact_shock.f95: .f95 reverted to .f90: problems on the ifort compiler fixed 2005-06-17 dprice * exact_toystar2D.f90: A-C plane in 2D (not working) 2005-06-17 dprice * calc_quantities.f90: delta rho for toy star 2005-06-17 dprice * limits.f90: bug catch if col>maxcol 2005-06-16 dprice * plotstep.f90: bug fix with titles on top of rendered plots 2005-06-13 dprice * get_data.f90, globaldata.f90, options_data.f90: rescale data option 2005-06-13 dprice * plotstep.f90: no title on power spectrum 2005-06-13 dprice * defaults.f90: minor changes 2005-06-06 dprice * menu.f90: cleverer nacross/ndown guess 2005-06-06 dprice * options_particleplots.f90: bug fix with plot-on-renderings prompt 2005-06-06 dprice * options_powerspec.f90, plotstep.f90, read_data_ascii.f90, timestepping.f90: minor changes/bug fixes 2005-06-06 dprice * menu.f90: bug fix with tiling decisions if nextra in multiplot 2005-06-06 dprice * setpage.f90: improved label spaces depending on options 2005-06-06 dprice * setpage.f90: page setup takes account of whether space for title is needed 2005-06-06 dprice * options_page.f90, plotstep.f90: titles/legends can be turned on/off 2005-06-06 dprice * options_powerspec.f90, plotstep.f90: improved power spectrum settings 2005-06-06 dprice * calc_quantities.f90: bug fix if ndim=0 (no radius calculated) 2005-06-06 dprice * options_data.f90: calc quantities is off by default 2005-06-06 dprice * menu.f90: comments 2005-06-06 dprice * options_data.f90: default ndim=0 2005-06-02 dprice * calc_quantities.f90: no longer sets numplot 2005-06-01 dprice * get_data.f90, plotstep.f90: bug fix with unbuffered data + power spectrums 2005-06-01 dprice * docs/supersphplot.tex: latex2html falls over on \date: removed 2005-06-01 dprice * Makefile, docs/supersphplot.tex, supersphplot.f90: version 1.0.2 2005-06-01 dprice * Makefile, exact_toystar2D.f90, plotstep.f90, rotate.f90, setpage.f90: compiler warnings fixed 2005-06-01 dprice * Makefile, exact_shock.f90, exact_shock.f95: needs to be f95 to compile properly on some compilers 2005-06-01 dprice * get_data.f90, globaldata.f90, options_data.f90, timestepping.f90: calculate quantities can be turned on/off; also bug fix with buffered/unbuffered data switching 2005-06-01 dprice * limits.f90: bug fix: limits reset only for columns that are set 2005-05-26 dprice * options_powerspec.f90, plotstep.f90, powerspectrums.f90, supersphplot.f90: much improved power spectrum plots for 1D and ascii (e.g. time evolution) data (zoom works properly) 2005-05-26 dprice * Makefile: added make docs option to compile documentation 2005-05-26 dprice * plotstep.f90: bug fix with adaptive limits if only plotting line 2005-05-24 dprice * docs/supersphplot.tex, options_particleplots.f90, particleplot.f90, plotstep.f90, read_data_ascii.f90, timestepping.f90: better line-plotting (useful for ascii data) 2005-05-24 dprice * : no longer kept in repository; done at build time 2005-05-24 dprice * docs/supersphplot.tex: updated sink particle plotting in docs 2005-05-24 dprice * options_particleplots.f90, particleplot.f90, plotstep.f90: sink/star particles can be plotted on top of renderings 2005-05-24 dprice * plot_kernel_gr.f90: obsolete 2005-05-24 dprice * options_powerspec.f90, plotstep.f90: handles ndim=0 and ih, irho, ipmass = 0; also improved power spectrum plotting 2005-05-24 dprice * read_data_VINE.f90, read_data_gadget.f90, read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90, read_data_nina.f90, read_data_spyros.f90, read_data_sro.f90: better error output 2005-05-24 dprice * read_data_gadget_jsb.f90: jamies modified gadget read 2005-05-24 dprice * geometry.f90: bug fix for ndim=1 2005-05-24 dprice * menu.f90: handles ndim=0 2005-05-24 dprice * danpgwedg.f, render.f90: compiler warnings fixed 2005-05-24 dprice * read_data_ascii.f90: vastly improved ascii read (reads columns file, handles files with non-real columns, uses ndim=0) 2005-05-17 dprice * Makefile, supersphplot.f90: standard Makefile 2005-05-17 dprice * docs/supersphplot.tex: updated docs -- uses version number and version updates 2005-05-12 dprice * docs/supersphplot.tex: version number updated 2005-05-10 dprice * Makefile, calc_quantities.f90, danpgtile.f, get_data.f90, plotstep.f90, read_data_mbate.f90, read_data_nina.f90, render.f90, supersphplot.f90: read_data_nina.f90 2005-05-10 dprice * Makefile, defaults.f90, legends.f90, options_page.f90, read_data_mbate.f90: namelist issues sorted 2005-05-10 dprice * plotstep.f90, setpage.f90: bug fix with page setup 2005-05-04 dprice * legends.f90, options_page.f90: legend text no longer contains equals sign (NAG compiler screws this up in namelist read) 2005-05-04 dprice * options_render.f90, plotstep.f90, render.f90, setpage.f90: page setup now leaves correct amount of space for colour bar 2005-05-04 dprice * danpgwedg.f, render.f90: bug fix with colour bar widths on multiplots 2005-05-04 dprice * particleplot.f90: particle plots faster (buffered) 2005-05-04 dprice * interactive.f90: character height reset properly 2005-05-04 dprice * read_data_dansph.f90: better log 2005-04-25 dprice * Makefile: NAG-mbate Makefile 2005-04-21 dprice * Makefile, supersphplot.f90: version 1.0 ? 2005-04-21 dprice * read_data_gadget.f90, read_data_mbate.f90: gadget serial code data read (not tested) 2005-04-21 dprice * menu.f90: bug fix with array out of bounds 2005-04-21 dprice * colours.f90: new red-blue-green colour scheme 2005-04-21 dprice * INSTALL: updated install instructions 2005-04-19 dprice * INSTALL: comments 2005-04-19 dprice * INSTALL, Makefile, read_data_ascii.f90, read_data_mbate.f90: ascii data read 2005-04-19 dprice * menu.f90: conditions on when you can render 2005-04-14 dprice * Makefile, read_data_dansph.f90, supersphplot.f90, system_f2003.f90, system_unix.f90, system_unix_NAG.f90: f2003 system calls 2005-04-12 dprice * Makefile, titles_read.f90: renamed 2005-04-12 dprice * Makefile, read_data_mbate_mhd.f90, titles.f90: titles module 2005-04-12 dprice * plotstep.f90: bug fix with spurious powerspectrum prompt 2005-04-12 dprice * options_page.f90: saves foreground/background colours 2005-04-11 dprice * read_data_spyros.f90: no compile warnings 2005-04-11 dprice * docs/supersphplot.tex: updated docs 2005-04-10 dprice * INSTALL, docs/supersphplot.tex, options_data.f90, options_xsecrotate.f90, supersphplot.f90: better documentation 2005-04-10 dprice * Makefile, read_data_dansph.f90, read_data_spyros.f90: spyros format 2005-04-09 dprice * Makefile, calc_quantities.f90, get_data.f90, menu.f90, particleplot.f90, plotstep.f90, supersphplot.f90, timestepping.f90: everything finally in modules 2005-04-09 dprice * read_data_dansph.f90: automatic reading of single/double precision 2005-04-08 dprice * interactive.f90: interactive application of log axes 2005-04-08 dprice * fieldlines.f90: comments 2005-04-08 dprice * docs/supersphplot.tex, render.f90: minor changes 2005-04-08 dprice * setpage.f90: pagechanging on multiplots bug fix 2005-04-07 dprice * read_data_VINE.f90: cleaned up comments etc 2005-04-07 dprice * legends.f90, options_page.f90: changeable legend text 2005-04-07 dprice * Makefile, legends.f90, read_data_dansph.f90, read_data_mbate.f90: crap 2005-04-07 dprice * read_data_VINE.f90: read format for VINE code 2005-04-01 dprice * plotstep.f90, render.f90: better colour bar behaviour on multiple plots per page 2005-03-24 dprice * particleplot.f90: bug fix with colours applying to axes by mistake 2005-03-24 dprice * calc_quantities.f90: calculates valfven 2005-03-24 dprice * interactive.f90: a)dapt option applies to renderings 2005-03-24 dprice * plotstep.f90: iadaptcoords implemented properly - adaptive plot limits now do less strange things 2005-03-24 dprice * menu.f90: no render option if transformations applied 2005-03-23 dprice * interactive.f90, plotstep.f90: bug fix with string on intel compiler 2005-03-23 dprice * limits.f90, plotstep.f90: improved setting of log limits, uses huge/tiny instead of fixed values 2005-03-23 dprice * interactive.f90: interactive changing of log/unlog on render plots 2005-03-23 dprice * interpolate3D_projection.f90: ticker on for large npix 2005-03-22 dprice * calc_quantities.f90: bug fix with plasma beta (now uses tiny) 2005-03-22 dprice * read_data_sro.f90: full dump reading 2005-03-22 dprice * interactive.f90, plotstep.f90: bug fix with interactive xsec moving + colourpart render limit adjusting 2005-03-22 dprice * options_page.f90: opens null device before colour settings 2005-03-22 dprice * danpgwedg.f, options_render.f90, render.f90: colour bar issues resolved 2005-03-22 dprice * interactive.f90: cross section position set interactively 2005-03-22 dprice * Makefile, interpolate1D.f90, interpolate2D.f90, interpolate2D_xsec.f90, interpolate3D.f90, interpolate3D_fastxsec.f90, interpolate3D_projection.f90, interpolate3D_xsec.f90, interpolate3D_xsec_vec.f90, plotstep.f90: interpolations in modules + vector interpolations use kernel 2005-03-21 dprice * menu.f90, options_limits.f90: help text 2005-03-21 dprice * interactive.f90: changes adaptive to fixed limits 2005-03-18 dprice * get_data.f90, limits.f90, options_limits.f90: bug fixes with limits file reading 2005-03-18 dprice * read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90: better error output 2005-03-18 dprice * exact_wave.f90: amplitude is percentage of mean 2005-03-18 dprice * menu.f90: rendering disallowed unless icoords=icoordsnew 2005-03-17 dprice * options_page.f90, plotstep.f90, timestepping.f90: ipagechange local variable only 2005-03-17 dprice * plotstep.f90: bug fix with floating exception caused by xplot,yplot>ntot 2005-03-17 dprice * interactive.f90: minor changes 2005-03-17 dprice * plotstep.f90: adaptive rendering limits behave correctly with interactive mode 2005-03-17 dprice * supersphplot.f90: unused module removed 2005-03-17 dprice * read_data_mbate.f90, read_data_mbate_hydro.f90: dgrav printed, also t_ff output in mbate version 2005-03-15 dprice * calc_quantities.f90: some clutter removed 2005-03-15 dprice * Makefile, docs/supersphplot.tex, globaldata.f90, integratedkernel.f90, interpolate3D_proj_vec.f90, interpolate3D_projection.f90, plotstep.f90, supersphplot.f90: interpolate3D_projection in self-contained module 2005-03-15 dprice * get_data.f90, menu.f90, supersphplot.f90: neater log output 2005-03-15 dprice * defaults.f90, limits.f90: prompts for limits file 2005-03-15 dprice * calc_quantities.f90, get_data.f90, options_particleplots.f90: bug fix: icoordsnew default set 2005-03-15 dprice * defaults.f90: unused vars removed 2005-03-11 dprice * Makefile, colours.f90, defaults.f90, exact.f90, exact_toystar1D.f90, exact_wave.f90, globaldata.f90, limits.f90, menu.f90, options_data.f90, options_limits.f90, options_page.f90, options_particleplots.f90, options_powerspec.f90, options_render.f90, options_vecplot.f90, options_xsecrotate.f90, plotstep.f90: submenus in modules which include their settings 2005-03-10 dprice * Makefile, legends.f90, plotstep.f90, render.f90, render_vec.f90: render module, only statements tightened, colour bar plotting and bug fix in particle colourings 2005-03-10 dprice * docs/supersphplot.tex: pdf version so appears when exported 2005-03-10 dprice * docs/supersphplot.bbl: bibliography file 2005-03-10 dprice * supersphplot.f90: new blurb 2005-03-08 dprice * plotstep.f90, rotate.f90: rotated axes use origin 2005-03-08 dprice * options_xsecrotate.f90, read_data_gadget.f90: bug fixes 2005-03-08 dprice * read_data_gadget.f90: jamies data read new version 2005-03-08 dprice * defaults.f90, globaldata.f90, options_render.f90, options_xsecrotate.f90, plotstep.f90, render.f90, rotate.f90: colour bar adjustable, rotated box has own limits, and zero values set to min in datpix if logged 2005-03-08 dprice * read_data_dansph.f90: bug fix 2005-03-08 dprice * supersphplot.f90: splash screen does legal bit 2005-03-08 dprice * INSTALL, LICENSE, README, docs/supersphplot.tex: docs added 2005-03-08 dprice * Makefile, allocate.f90, calc_quantities.f90, globaldata.f90, limits.f90, options_particleplots.f90, read_data_dansph.f90, read_data_gadget.f90, read_data_jjm.f90, read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90, read_data_scw.f90, read_data_sro.f90: iam and ntot removed 2005-03-04 dprice * Makefile, defaults.f90, geometry.f90, globaldata.f90, options_limits.f90, plotstep.f90: iadaptcoords added, but not yet used/implemented 2005-03-04 dprice * read_data_mbate.f90, read_data_mbate_hydro.f90, read_data_mbate_mhd.f90: read datas renamed+mbate version added 2005-03-03 dprice * particleplot.f90: bug fix in xerrb 2005-03-02 dprice * exact.f90, exact_toystar2D.f90, get_data.f90, timestepping.f90: 2D toystar exact solution (linear) looks like it works 2005-03-02 dprice * interactive.f90: bug fix if non-interactive device 2005-03-02 dprice * plotstep.f90: bug fix (no istepprev or irenderprev any more as these should never be necessary) 2005-03-02 dprice * timestepping.f90: print statements removed 2005-03-02 dprice * read_data_dansph.f90: gradh read 2005-03-02 dprice * exact.f90: right names for exact parameter files 2005-03-02 dprice * calc_quantities.f90: dh/drho added 2005-03-01 dprice * Makefile, defaults.f90, get_data.f90, menu.f90, options_data.f90, supersphplot.f90, timestepping.f90: bug fix: does not set limits on unbuffered data unless on first data read 2005-03-01 dprice * timestepping.f90: bug fixes with timestepping 2005-03-01 dprice * exact.f90, exact_polytrope.f90, exact_toystar.f90, exact_toystar1D.f90: renamings 2005-03-01 dprice * exact.f90: exact solution from file plotted untransformed 2005-03-01 dprice * Makefile, exact.f90, exact_mhdshock.f90: exact_mhdshock brought into the fold 2005-03-01 dprice * Makefile, print_header.f90, supersphplot.f90: print header moved into supersphplot.f90 as internal routine 2005-03-01 dprice * exact_polytrope.f, exact_toystar_ACplane.f, toystar2D_utils.f90: files cleaned up from exact solution revamp 2005-03-01 dprice * Makefile, defaults.f90, exact.f90, exact_fromfile.f90, exact_rhoh.f90, exact_sedov.f90, exact_shock.f90, exact_toystar2D.f90, exact_wave.f90, globaldata.f90, options_particleplots.f90, plotstep.f90: exact solutions completely revamped to use transformations (coord transforms not done yet) 2005-03-01 dprice * danpgtile.f: y label moved 2005-03-01 dprice * timestepping.f90: there are bugs in here 2005-03-01 dprice * transform.f90: zerolog parameter 2005-02-25 dprice * read_data_mbate_hydro.f90: uses units on density 2005-02-23 dprice * defaults.f90, globaldata.f90, options_page.f90, plotstep.f90: foreground/background colour changing within program 2005-02-23 dprice * colours.f90, defaults.f90, globaldata.f90, interactive.f90, options_data.f90, options_limits.f90, options_page.f90, plotstep.f90, timestepping.f90: plots selected timesteps + multiple steps per page (also some bug fixes with interactive setting of plot limits) 2005-02-23 dprice * transform.f90: log label instead of log10 2005-02-23 dprice * read_data_mbate_hydro.f90: uses free fall time 2005-02-23 dprice * read_data_mbate_hydro.f90: bug fixes 2005-02-21 dprice * docs/supersphplot.tex: polytrope exact solution notes updated 2005-02-18 dprice * timestepping.f90: more on timestepping across multiple files 2005-02-18 dprice * timestepping.f90: bug fix with multiple files, now goes forwards and backwards properly 2005-02-18 dprice * read_data_mbate_hydro.f90: doub prec 2005-02-17 dprice * timestepping.f90: crap 2005-02-16 dprice * interactive.f90, plotstep.f90, rotate.f90: various bug fixes 2005-02-16 dprice * Makefile, interactive.f90, plotstep.f90: bug fixes in iplotz 2005-02-16 dprice * read_data_mbate.f90, read_data_mbate_hydro.f90: added read format for hydro mbate+bug fixes 2005-02-11 dprice * interactive.f90: better log output 2005-02-11 dprice * plotstep.f90: bug fix if iplotx=iploty 2005-02-11 dprice * geometry.f90: better handling of r=0 in vec transform 2005-02-10 dprice * get_data.f90, globaldata.f90, timestepping.f90: bug fix in timestepping, gets first step properly when not buffered, also freezes on last step in interactive mode 2005-02-07 dprice * Makefile, globaldata.f90, mainloop.f90, menu.f90, plotstep.f90, timestepping.f90: mainloop split into separate parts, timestepping separate to plotstep, more local variables, although some streamlining could still be done 2005-02-04 dprice * options_render.f90: more on particle colouring 2005-02-03 dprice * Makefile, colourparts.f90, colours.f90, globaldata.f90, mainloop.f90, options_render.f90: preliminary implementation of particle colouring 2005-01-31 dprice * calc_quantities.f90, defaults.f90, exact_rhoh.f90, get_data.f90, globaldata.f90, limits.f90, mainloop.f90, options_page.f90, particleplot.f90, read_data_dansph.f90: animate removed, better(less) log output to screen 2005-01-31 dprice * exact_rhoh.f90: better for variable masses, bug fix if xmin < 0 2005-01-27 dprice * menu.f90: bug fix in coord sys change 2005-01-27 dprice * mainloop.f90, transform.f90: transform2 uses size of array (smaller interface) 2005-01-27 dprice * defaults.f90, geometry.f90: reshape initialisation so that labelcoord is a parameter 2005-01-27 dprice * get_data.f90, menu.f90: bug fix in labelling for different coord sys 2005-01-26 dprice * toystar2D_utils.f90: bug fix in functions 2005-01-26 dprice * globaldata.f90: icoordsnew saved 2005-01-26 dprice * Makefile, toystar2D_utils.f90: toy star functions appear to work 2005-01-26 dprice * mainloop.f90: bug catch if ndimV>ndim and coord transforms 2005-01-25 dprice * Makefile, defaults.f90, geometry.f90, globaldata.f90, menu.f90, options_particleplots.f90, read_data_dansph.f90, read_data_gadget.f90, read_data_jjm.f90, read_data_mbate.f90, read_data_scw.f90, read_data_sro.f90: geometry module contains coord system labels + maxcoordsys 2005-01-25 dprice * interactive.f90, rotate.f90: experimenting with projections 2005-01-25 dprice * exact.f90, exact_toystar2D.f90, toystar2D_utils.f90: working on exact 2D toystars 2005-01-25 dprice * mainloop.f90: out of bounds bug fix 2005-01-24 dprice * globaldata.f90, mainloop.f90: ixsec bug fix 2005-01-24 dprice * mainloop.f90: bug fix with turning interactive mode off 2005-01-24 dprice * geometry.f90, mainloop.f90: coord transform applied to fixed limits 2005-01-21 dprice * allocate.f90: better output 2005-01-21 dprice * read_data_dansph.f90: less reallocation of memory 2005-01-21 dprice * mainloop.f90: bug fix with totmass 2005-01-21 dprice * exact_toystar2D.f90, mainloop.f90: bug fix with totmass 2005-01-20 dprice * Makefile, exact.f90: saves polyk 2005-01-20 dprice * globaldata.f90, read_data_dansph.f90: uses iformat 2005-01-20 dprice * Makefile, mainloop.f90: out-of-bounds bug fix 2005-01-19 dprice * interpolate3D_projection.f90: cpu timings added 2005-01-19 dprice * geometry.f90, mainloop.f90: vector transforms implemented + tested (cyl only) 2005-01-19 dprice * Makefile, interactive.f90, interactive_part.f90: interactive_part renamed interactive 2005-01-19 dprice * Makefile, defaults.f90, defaults_read.f90, defaults_set.f90, defaults_write.f90, menu.f90, read_data_dansph.f90, supersphplot.f90: defaults module 2005-01-19 dprice * rotate_axes.f90: obsolete 2005-01-19 dprice * menu.f90: bug fix in string length 2005-01-18 dprice * allocate.f90, particleplot.f90, read_data_dansph.f90, read_data_mbate.f90: bug fixes in memory allocation/reallocation 2005-01-18 dprice * read_data_mbate.f90: trying to catch memory bugs 2005-01-18 dprice * geometry.f90: bug fix in coord transform for x=0 2005-01-18 dprice * mainloop.f90: reverted to vector plots 2005-01-17 dprice * read_data_dansph.f90: new header format 2005-01-17 dprice * interactive_part.f90: bug fix with save circles 2005-01-15 dprice * interactive_part.f90: interactive resets angle if > 360 degrees 2005-01-15 dprice * mainloop.f90, options_xsecrotate.f90, rotate.f90: rotated 3D axes implemented 2005-01-13 dprice * allocate.f90, supersphplot.f90: deallocation of remaining memory 2004-12-23 dprice * Makefile, interpolate3D_proj_vec.f90: projection for vec plots (not tested) 2004-12-23 dprice * interactive_part.f90: comments 2004-12-23 dprice * interactive_part.f90, mainloop.f90: interactive selection in cross section slices 2004-12-23 dprice * Makefile, interactive_part.f90, mainloop.f90, particleplot.f90: plotting of selected particles only, general zrange interface to particleplot 2004-12-23 dprice * interpolate3D_projection.f90, mainloop.f90: mainloop split further into internal subroutines 2004-12-22 dprice * defaults_set.f90, globaldata.f90, options_xsecrotate.f90, rotate.f90: options for rotated axes (not yet implemented) 2004-12-21 dprice * Makefile, fieldlines.f90, mainloop.f90, render_vec.f90: preliminary field line plotting routine (2D only) 2004-12-21 dprice * allocate.f90, defaults_set.f90, globaldata.f90, interactive_part.f90, mainloop.f90, options_particleplots.f90: interactive setting of circles of interaction/allocatable 2004-12-20 dprice * legends.f90, render_vec.f90: more playing around 2004-12-20 dprice * interactive_part.f90: interactive setting of x-sec position 2004-12-20 dprice * mainloop.f90: interactive_step only on multiplots 2004-12-20 dprice * mainloop.f90: bug fix in timestepping 2004-12-20 dprice * read_data_mbate.f90: uses free fall time 2004-12-20 dprice * interactive_part.f90: better render limits changing 2004-12-17 dprice * options_vecplot.f90: comment moved 2004-12-17 dprice * mainloop.f90: bug fix in initialising colour schemes for multiplot 2004-12-17 dprice * menu.f90: bug fix in multiplot settings 2004-12-17 dprice * defaults_set.f90, interactive_part.f90, legends.f90, mainloop.f90, render.f90, render_vec.f90: mostly crap 2004-12-16 dprice * interactive_part.f90, mainloop.f90, transform.f90: inverse transforms for setting plot limits adaptively 2004-12-16 dprice * defaults_set.f90, legends.f90, render_vec.f90: working on vector plot legend 2004-12-16 dprice * Makefile, globaldata.f90, legend.f, legends.f90, mainloop.f90, options_vecplot.f90: legend module + preliminaries for vecplot legend 2004-12-16 dprice * read_data_mbate.f90: bug fix with incomplete data 2004-12-16 dprice * mainloop.f90, menu.f90: prompt for iplotpartvec 2004-12-15 dprice * Makefile, interactive_part.f90, mainloop.f90: better gradient plotting, better saving from interactive mode 2004-12-15 dprice * read_data_mbate.f90: single precision 2004-12-15 dprice * interactive_part.f90, mainloop.f90: interactive mode sets render limits, moves legend and title 2004-12-15 dprice * transform.f90: bug fix with multiple labels 2004-12-14 dprice * allocate.f90, particleplot.f90: bug fix with ntot.ne.sumoftypes, npartoftype=0 in allocate now 2004-12-14 dprice * mainloop.f90: bug fix with interactive iadapt changing 2004-12-14 dprice * Makefile, calc_quantities.f90, read_data_jjm.f90: read data for joes format 2004-12-12 dprice * interactive_part.f90, mainloop.f90: interactive zooms on powerspec plots 2004-12-10 dprice * mainloop.f90, transform.f90: transforms improved 2004-12-10 dprice * mainloop.f90: transforms on powerspec plots 2004-12-10 dprice * Makefile, mainloop.f90, powerspectrum_fourier1D.f90, powerspectrum_lomb1D.f90, powerspectrums.f90: powerspectrums in module 2004-12-10 dprice * Makefile, exact.f90, int_from_string.f90, interactive_part.f90, menu.f90, read_data_gadget.f90: int_from_string removed, found better way 2004-12-09 dprice * mainloop.f90, plot_powerspectrum.f90, powerspectrum_lomb1D.f90: power spectrum plots better integrated 2004-12-09 dprice * interactive_part.f90: cut down version for extra plots 2004-12-09 dprice * read_data_dansph.f90: bug fixes with new formats 2004-12-07 dprice * Makefile, calc_quantities.f90, coord_transform.f90, geometry.f90, mainloop.f90, plot_kernel_gr.f90, read_data_dansph.f90, vector_transform.f90: basic cylindrical interpolation works (ie density calculation) + dumps/plotting works 2004-12-07 dprice * interpolate3D_projection_P.f90: openMP version (NOT TESTED) 2004-12-07 dprice * Makefile, limits.f90, options_limits.f90, vector_transform.f90: various tweaks/additions, nothing big 2004-12-06 dprice * Makefile, allocate.f90, calc_quantities.f90, read_data_dansph.f90, read_data_gadget.f90, read_data_mbate.f90, read_data_scw.f90, read_data_sro.f90, transform.f90: allocate in module 2004-12-06 dprice * options_limits.f90: better prompts 2004-12-03 dprice * Makefile, exact_toystar2D.f90, interactive_part.f90, mainloop.f90: circles of interaction in interactive mode, more on 2D toy stars 2004-12-02 dprice * Makefile, defaults_set.f90, docs/supersphplot.tex, exact.f90, exact_toystar2D.f90, mainloop.f90: working on toy star exact solution in 2D 2004-12-02 dprice * read_data_dansph.f90: for new format 2004-12-01 dprice * read_data_dansph.f90: reads div v also 2004-11-23 dprice * Makefile, read_data_sro.f90: read data for Stephans code (minidumps only at present) 2004-11-23 dprice * mainloop.f90: playing around with 1D interpolation 2004-11-20 dprice * Makefile, docs/supersphplot.tex, mainloop.f90, rotate.f90: rotation module added 2004-11-19 dprice * interactive_part.f90: checks for cursor 2004-11-19 dprice * Makefile, defaults_set.f90, globaldata.f90, mainloop.f90, options_particleplots.f90, plot_average.f: removed plot_average and associated options (was crap anyway) 2004-11-19 dprice * Makefile, exact.f90, get_data.f90, globaldata.f90, limits.f90, limits_read.f90, limits_save.f90, limits_set.f90, mainloop.f90, options_limits.f90, options_xsecrotate.f90: limits module enveloping limits_read, limits_set and limits_save : used appropriately 2004-11-19 dprice * options_render.f90: crap 2004-11-19 dprice * colours.f90: minor crap in colours 2004-11-19 dprice * colours.f90: minor crap in colours 2004-11-19 dprice * colours.f90, defaults_set.f90, globaldata.f90, mainloop.f90, options_render.f90: bug fixes with colours module, better colour scheme setting in menu 2004-11-19 dprice * Makefile, colour_demo.f, colour_set.f90, colours.f90: colour schemes in module 2004-11-18 dprice * particleplot.f90, supersphplot.f90: bug catches for incomplete data 2004-11-18 dprice * get_data.f90, particleplot.f90: crap 2004-11-18 dprice * get_data.f90, globaldata.f90, mainloop.f90, menu.f90, options_data.f90, read_data_dansph.f90, read_data_gadget.f90, read_data_mbate.f90, read_data_scw.f90, supersphplot.f90: ivegotdata only in get_data + ihavereadfilename obsolete + get_nextstep in mainloop 2004-11-18 dprice * allocate.f90, globaldata.f90, interactive_part.f90, mainloop.f90, particleplot.f90: particle marking implemented (and works) 2004-11-17 dprice * Makefile: playing around with superfast cleaning 2004-11-17 dprice * get_data.f90: bug fix with single step reads and limits settings 2004-11-17 dprice * read_data_mbate.f90: catches header errors 2004-11-17 dprice * calc_quantities.f90: calculates ke 2004-11-17 dprice * Makefile, exact_toystar2D.f90, mainloop.f90: exact solution is plotted before call to interactive, call to pgsls in toy star version required 2004-11-17 dprice * particleplot.f90: colours of circles of interation changed + line width 2004-11-15 dprice * transform.f90: auto label lengths 2004-11-15 dprice * Makefile, calc_quantities.f90, interactive_part.f90: bug fixes with uninitialized vars 2004-11-15 dprice * read_data_mbate.f90, read_data_scw.f90: bug fixstat rhozero, RK2 declared real 2004-11-12 dprice * read_data_mbate.f90: crap 2004-11-11 dprice * Makefile: sys file moved 2004-11-11 dprice * Makefile, defaults_read.f90, defaults_set.f90, defaults_write.f90, exact.f90, get_data.f90, globaldata.f90, limits_read.f90, limits_save.f90, mainloop.f90, menu.f90, options_data.f90, options_limits.f90, options_page.f90, options_particleplots.f90, options_powerspec.f90, options_render.f90, options_vecplot.f90, options_xsecrotate.f90, particleplot.f90, read_data_dansph.f90, read_data_gadget.f90, read_data_mbate.f90, read_data_scw.f90, supersphplot.f90: settings module split into sub-modules 2004-11-11 dprice * calc_quantities.f90: clean up of unnecessary global vars 2004-11-09 dprice * mainloop.f90: some junk removed 2004-11-09 dprice * exact.f90, exact_toystar2D.f90: bug fixes in exact solution for static 2D toy star 2004-11-08 dprice * defaults_set.f90, globaldata.f90, mainloop.f90, options_particleplots.f90, particleplot.f90: circles of interaction cleaned up, no plotcircall, only on selected 2004-11-05 dprice * rotate.f90: mucking around 2004-11-05 dprice * defaults_set.f90, globaldata.f90, interactive_part.f90, mainloop.f90, options_xsecrotate.f90, rotate.f90: rotation works in 3D (although x appears to be y and vice versa??), better log in main loop 2004-11-04 dprice * Makefile, coord_transform.f90: uses ATAN2 -> much better! 2004-11-04 dprice * calc_quantities.f90, read_data_dansph.f90: bug fix with labelling 2004-11-04 dprice * Makefile, coord_transform.f90: quadrants on theta (not tested) 2004-11-03 dprice * coord_transform.f90, mainloop.f90: meddling with rotation 2004-11-03 dprice * Makefile, calc_quantities.f90, get_data.f90: calc quantities bugs fixed, more robust now 2004-11-03 dprice * read_data_mbate.f90: better memory allocation 2004-11-03 dprice * Makefile, docs/supersphplot.tex, read_data_mbate.f90: various crap 2004-11-03 dprice * options_render.f90: plot contours changes if icolours = 0 or set 2004-11-03 dprice * mainloop.f90: trying rotation on rendered plots 2004-11-03 dprice * coord_transform.f90, rotate.f90: tried to fix spherical transform and hence rotation simpler 2004-11-02 dprice * docs/supersphplot.tex: various additions 2004-11-02 dprice * Makefile, system_unix.f90, system_unix_NAG.f90: different system files 2004-11-02 dprice * defaults_write.f90: ierr removed 2004-11-02 dprice * Makefile, defaults_read.f90, defaults_write.f90, exact.f90, system_unix.f90: exact module and defaults neatened up 2004-10-27 dprice * mainloop.f90: file skipping in non-buffered read 2004-10-27 dprice * Makefile, defaults_set.f90, docs/supersphplot.tex, interactive_part.f90, mainloop.f90, read_data_dansph.f90, supersphplot.f90: keys for mouse functions 2004-10-27 dprice * interpolate3D_projection.f90, render.f90: exactly fits in plot window, progress bar revised 2004-10-27 dprice * read_data_dansph.f90, read_data_gadget.f90, read_data_mbate.f90, read_data_scw.f90: bug catches in set_labels 2004-10-20 dprice * Makefile, system_unix.f90: compiles and everything works on NAG compiler 2004-10-20 dprice * Makefile, allocate.f90, defaults_set.f90, docs/supersphplot.tex, get_data.f90, interpolate3D_projection.f90, limits_set.f90, mainloop.f90, menu.f90, options_limits.f90, read_data_scw.f90, supersphplot.f90, system_unix.f90, titles_read.f90: bug fixes with uninitialised variables 2004-10-19 dprice * Makefile, allocate.f90, get_data.f90, read_data_dansph.f90, read_data_gadget.f90, read_data_mbate.f90, read_data_scw.f90, system_unix.f90: scw data read works + various crap 2004-10-19 dprice * prompting.f90: bug fix with present(min) 2004-10-19 dprice * Makefile, exact.f90, exact_mhdshock.f90, exact_shock.f90, exact_toystar.f90, exact_toystar2D.f90, exact_toystar_ACplane.f, globaldata.f90, interpolate1D.f90, interpolate2D.f90, interpolate3D.f90, interpolate3D_fastxsec.f90, interpolate3D_projection.f90, interpolate3D_xsec_vec.f90, mainloop.f90, menu.f90, options_limits.f90, options_page.f90, particleplot.f90, plot_powerspectrum.f90, powerspectrum_lomb1D.f90, read_data_dansph.f90, render.f90, render_vec.f90, supersphplot.f90, transform.f90: unused variables removed 2004-10-19 dprice * read_data_scw.f90: not working, playing around with recl= 2004-10-19 dprice * Makefile, read_data_scw.f90: data read for Stuarts data 2004-10-19 dprice * calc_quantities.f90, colour_demo.f, colour_set.f90, exact_polytrope.f, exact_toystar.f90, exact_toystar2D.f90, exact_toystar_ACplane.f, interactive_part.f90, interpolate1D.f90, interpolate2D.f90, interpolate2D_xsec.f90, interpolate3D.f90, interpolate3D_fastxsec.f90, interpolate3D_projection.f90, interpolate3D_xsec_vec.f90, interpolate_vec.f90, legend.f, menu.f90, options_limits.f90, options_page.f90, options_particleplots.f90, options_render.f90, options_xsecrotate.f90, plot_average.f, plot_powerspectrum.f90, powerspectrum_lomb1D.f90, render.f90, render_vec.f90, setpage.f90: tabs removed 2004-10-19 dprice * Makefile, globaldata.f90, modules.f90: modules.f90 renamed globaldata.f90 2004-10-19 dprice * read_data_dansph_ascii.f90: obsolete, no longer updated 2004-10-19 dprice * allocate.f90, limits_set.f90, mainloop.f90, modules.f90, read_data_dansph.f90, read_data_dansph_ascii.f90, read_data_gadget.f90, read_data_mbate.f90: npart, nghost removed altogether (not tested) 2004-10-18 dprice * read_data_dansph.f90: better error catches on incomplete data 2004-10-18 dprice * coord_transform.f90: tabs removed 2004-10-13 dprice * transform.f90: tabs removed 2004-10-13 dprice * transform.f90: floor now 10-12 if log(0) 2004-10-13 dprice * get_data.f90, read_data_dansph.f90, read_data_gadget.f90, read_data_mbate.f90: more robust data read -> returns nstepsread 2004-10-13 dprice * Makefile: added system.f90 2004-10-13 dprice * int_from_string.f90: tabs removed 2004-10-13 dprice * defaults_read.f90, defaults_set.f90, defaults_write.f90: defaults save rootnames, tabs removed, gotos removed 2004-10-13 dprice * supersphplot.f90, system_unix.f90: interface for system commands 2004-10-13 dprice * options_data.f90: tabs removed, ians=0 2004-10-13 dprice * docs/supersphplot.tex: small changes in docs 2004-10-13 dprice * danpgtile.f: tabs removed 2004-10-11 dprice * read_data_mbate.f90: tabs removed, reads sinks (but must reorder data to plot them) 2004-10-11 dprice * options_vecplot.f90: ians=0, tabs removed 2004-10-11 dprice * menu.f90: goto removed 2004-10-11 dprice * mainloop.f90: bug fix with adaptive plot limits 2004-10-11 dprice * exact.f90, exact_shock.f90: isothermal riemann solver 2004-10-11 dprice * exact.f90: bug fix in prompt for shock solution 2004-10-07 dprice * options_render.f90: ians =0 2004-10-07 dprice * get_data.f90: bug fix in get_data with call to set_limits 2004-10-05 dprice * allocate.f90: formatted print statements 2004-10-05 dprice * particleplot.f90: comments formatted 2004-10-05 dprice * Makefile, get_data.f90, options_limits.f90, read_data_dansph.f90: various bug catches to do with data read 2004-10-05 dprice * Makefile, main.f90, mainloop.f90, menu.f90, print_header.f90, supersphplot.f90: main renamed mainloop, trying to get getarg to work 2004-10-04 dprice * Makefile, read_data_mbate.f90: various compilation problems fixed 2004-10-04 dprice * docs/bibstyle.bst, docs/figs/hyperbolic.ps, docs/figs/xsec2D.eps, docs/figs/xsec2D.fig, docs/figs/xsec3D.eps, docs/figs/xsec3D.fig, docs/supersphplot.tex: docs in CVS properly 2004-10-04 dprice * Makefile: updated make for ifc, no copyscripts any more 2004-10-04 dprice * Makefile: auto changing of Makefiles 2004-09-16 dprice * get_data.f90, main.f90: bug fixes if buffering 2004-09-14 dprice * Makefile, defaults_set.f90, get_data.f90, main.f90, menu.f90, modules.f90, options_data.f90, read_data_dansph.f90, read_data_dansph_ascii.f90, read_data_gadget.f90, read_data_mbate.f90, supersphplot.f90: working on buffering in data read (getting there...) 2004-09-14 dprice * read_data_mbate.f90, read_data_mbate_dump.f90, supersphplot.f90: formatted read from mbate obsolete : now only unformatted 2004-09-14 dprice * options_exact.f90, read_exactparams.f90: module interface for exact solution calling : removed old files 2004-09-14 dprice * Makefile, defaults_read.f90, defaults_set.f90, defaults_write.f90, exact.f90, exact_fromfile.f90, get_data.f90, main.f90, modules.f90, options_particleplots.f90, read_data_dansph.f90, read_data_mbate_dump.f90: module interface for exact solution calling 2004-09-14 dprice * read_data_dansph.f90, read_data_gadget.f90, read_data_mbate_dump.f90: set labels in separate subs 2004-09-13 dprice * menu.f90, supersphplot.f90: menu self-contained 2004-09-13 dprice * Makefile, calc_quantities.f90, get_data.f90, modules.f90, read_data_mbate_dump.f90: working on mbate data read 2004-09-13 dprice * main.f90: bug fix if ivectorplot=0 2004-09-13 dprice * allocate.f90: bug fix in reallocation 2004-08-30 dprice * menu.f90, supersphplot.f90: preliminary recursive menu 2004-08-27 dprice * read_data_gadget.f90: smoothing length x 0.5 2004-08-25 dprice * read_data_mbate_dump.f90: part types, vectors 2004-08-25 dprice * menu.f90: vector prompting 2004-08-25 dprice * defaults_set.f90, docs/supersphplot.tex, main.f90, menu.f90, modules.f90, options_xsecrotate.f90, read_data_gadget.f90: preliminary subscripting for vector quantities 2004-08-24 dprice * options_xsecrotate.f90: menu cleaned up a bit 2004-08-23 dprice * Makefile, main.f90, rotate_axes.f90: preliminary rotated axes/box 2004-08-23 dprice * read_data_dansph.f90: some changes for npartoftype 2004-08-20 dprice * Makefile, allocate.f90, defaults_set.f90, limits_set.f90, main.f90, modules.f90, options_particleplots.f90, particleplot.f90, read_data_gadget.f90: particle plotting in new sub, allows up to 6 particle types, removed refs to sinks, ghosts, works on gadget data 2004-08-20 dprice * interactive_part.f90, main.f90, rotate.f90: rotation about x seems to work, also interactive rotation 2004-08-20 dprice * Makefile, interpolate_vec.f90, main.f90, supersphplot.f90, vectorplot.f90: vectorplot superseded by interpolate_vec, has been checked 2004-08-20 dprice * exact_rhoh.f90: does nothing if hfact not set 2004-08-20 dprice * interactive_part.f90: prints on exit 2004-08-20 dprice * get_data.f90, limits_set.f90: bug fix with numplot if no calc_quantities 2004-08-20 dprice * read_data_dansph.f90, read_data_dansph_ascii.f90, read_data_mbate.f90, read_data_mbate_dump.f90: dat array references fixed 2004-08-19 dprice * allocate.f90, calc_quantities.f90, limits_set.f90, main.f90, read_data_gadget.f90: changed ordering of indices on dat array for optimal performance (NOT YET FOR AALL FORMATS) 2004-08-19 dprice * Makefile, exact_shock.f90, riemannsolver.f90: riemannsolver moved inside exact_shock.f90 2004-08-19 dprice * limits_set.f90, main.f90, modules.f90, options_limits.f90: can reset limits, limits_set cleaned up 2004-08-19 dprice * interactive_part.f90, main.f90: limits changing not permanent in interactive 2004-08-19 dprice * Makefile, coord_transform.f90: coord transform moved from src, cylindrical transformations fixed 2004-08-19 dprice * defaults_set.f90, interpolate3D_fastxsec.f90, main.f90, modules.f90, options_xsecrotate.f90, rotate.f90: azimuthal rotation works 2004-08-19 dprice * read_data_gadget.f90: bug fix for ifile=0 2004-08-19 dprice * docs/supersphplot.tex: updated docs 2004-08-19 dprice * get_data.f90, read_data_gadget.f90: gadget data read working 2004-08-19 dprice * interpolate3D_projection.f90: progress counter added 2004-08-17 dprice * get_data.f90: THESIS SUBMITTED, so working code (haha) 2004-08-16 dprice * docs/supersphplot.tex: docs moved to plot dir 2004-08-05 dprice * Makefile, main.f90, modules.f90, options_xsecrotate.f90, rotate.f90: rotation added: at the moment around origin and only for particle plots 2004-08-04 dprice * interpolate2D_xsec.f90, main.f90: BIG BUG FIX in interpolate2D_xsec : now works 2004-08-03 dprice * main.f90, setpage.f90: more bug fixes in page changingstat I think this should always work properly now 2004-08-03 dprice * Makefile: improved Makefile - modules separate 2004-08-03 dprice * Makefile, get_data.f90, modules.f90, read_data_dansph.f90, read_data_dansph_ascii.f90, read_data_gadget.f90, read_data_mbate.f90, read_data_mbate_dump.f90: handles long filenames 2004-08-03 dprice * main.f90, menu.f90, options_limits.f90, transform.f90: transform is a module 2004-08-03 dprice * transform.f90: bug fix in transform limits for abs 2004-08-03 dprice * read_data_dansph.f90: bug fix with multiple files and nstep_max 2004-08-02 dprice * modules.f90: saves interactive setting 2004-08-02 dprice * menu.f90: adjustl 2004-07-29 dprice * main.f90: paper change only if set 2004-07-29 dprice * calc_quantities.f90: perp/parallel labels 2004-07-28 dprice * main.f90: bug fix with page changing - much more robust now 2004-07-28 dprice * defaults_set.f90, main.f90, modules.f90, options_exact.f90: bug fix in linear wave exact solution (iwaveplotx,y now) 2004-07-28 dprice * main.f90, setpage.f90: bug fix with page changing for 1 plot per page and ipagechange off 2004-07-28 dprice * Makefile, defaults_set.f90, interpolate2D_xsec.f90, main.f90, menu.f90, modules.f90, options_particleplots.f90, options_render.f90, options_xsecrotate.f90, setpage.f90, supersphplot.f90: 2D cross sections work, options_xsecrotate added 2004-07-27 dprice * Makefile, interpolate2D_xsec.f90, main.f90: interpolate2D_xsec bug fix: removed pixwidth<0 error catch 2004-07-27 dprice * read_data_dansph.f90: better error catches 2004-07-27 dprice * defaults_set.f90, get_data.f90: crap 2004-07-26 dprice * read_data_mbate_dump.f90: bug fix in setting npart etc 2004-07-26 dprice * main.f90: vector cross sections working in 3D 2004-07-26 dprice * Makefile: sending to ukaff 2004-07-24 dprice * Makefile, get_data.f90, read_data_mbate_dump.f90: reads mbate data direct from dump (needs improvement though) 2004-07-24 dprice * Makefile, interpolate3D_xsec_vec.f90, main.f90, render_vec.f90: vector cross sections (NOT YET TESTED) 2004-07-23 dprice * interactive_part.f90, main.f90: interactive zoom 2004-07-23 dprice * read_data_dansph.f90: labels fixed 2004-07-23 dprice * interpolate2D.f90, render.f90: playing around with renderings 2004-07-23 dprice * get_data.f90, read_data_dansph.f90, read_data_dansph_ascii.f90: reads binary dumps from my code 2004-07-23 dprice * colour_demo.f, colour_set.f90, supersphplot.f90: ice colour scheme improved 2004-07-16 dprice * Makefile, defaults_read.f90, main.f90, modules.f90, read_data_gadget.f90: reads gadget data 2004-07-14 dprice * Makefile, defaults_read.f90, defaults_set.f90, defaults_write.f90, main.f90, menu.f90, modules.f90, options_data.f90, options_render.f90, options_vecplot.f90, render.f90, supersphplot.f90: render options majorly restructured + vector options 2004-07-13 dprice * Makefile, danpgsch.f, defaults_set.f90, main.f90, modules.f90, options_page.f90, supersphplot.f90: title positions, danpgsch added for character height 2004-07-13 dprice * Makefile, main.f90, supersphplot.f90, titles_read.f90: reads plot titles from file 2004-07-13 dprice * read_data_dansph.f90: bug fix with reading multiple files 2004-07-13 dprice * interactive_part.f90: advance by n steps 2004-07-13 dprice * read_data_dansph.f90: more sensible reallocation of memory 2004-07-12 dprice * defaults_set.f90, legend.f, main.f90, modules.f90, options_page.f90: adjustable legend position 2004-06-24 dprice * plot_powerspectrum.f90, setpage.f90: crap 2004-06-23 dprice * danpgtile.f: bug fix : iplot now unchanged on output 2004-06-19 dprice * defaults_set.f90, main.f90, menu.f90, modules.f90, options_particleplots.f90, read_data_dansph.f90, read_data_mbate.f90, supersphplot.f90: particle coords -> new coord systems (not for vectors yet) 2004-06-19 dprice * exact_sedov.f90: crap 2004-06-16 dprice * exact_shock.f90: bug fix for t=0 2004-06-11 dprice * Makefile, defaults_set.f90, exact_polytrope.f, exact_shock.f, exact_shock.f90, get_data.f90, main.f90, modules.f90, options_exact.f90, read_exactparams.f90, riemannsolver.f90, supersphplot.f90: exact solution for 1D shock tubes 2004-06-11 dprice * exact_fromfile.f90: exact solution from a file 2004-06-10 dprice * legend.f: crap 2004-06-09 dprice * danpgtile.f: more frigging around with labels/margins 2004-06-09 dprice * main.f90: particle cross section initialisation works 2004-06-03 dprice * danpgtile.f: margins adjust with character height 2004-06-02 dprice * isosurface.f90: beginnings of isosurface routine (NOT WORKING) 2004-06-02 dprice * interactive_part.f90, main.f90, supersphplot.f90: interactive does forward/backward stepping, replotting 2004-06-01 dprice * Makefile, get_data.f90, int_from_string.f90, menu.f90, modules.f90, options.f90, print_menu.f90, supersphplot.f90: redesigned main menu - options use characters, compact form 2004-06-01 dprice * options_limits.f90: re-read limits file 2004-06-01 dprice * options_page.f90: animate moved to here 2004-06-01 dprice * print_menu.f90: last revision before killed 2004-06-01 dprice * Makefile, limits_read.f90, limits_save.f90, limits_set.f90, main.f90, modules.f90, options.f90, options_limits.f90, supersphplot.f90: saves/reads plot limits to/from files 2004-06-01 dprice * limits.f90, limits_set.f90: renamed limits_set 2004-06-01 dprice * read_data_dansph.f90: labels for alpha u etc 2004-06-01 dprice * defaults_read.f90: better error catching 2004-06-01 dprice * main.f90: uses setgrid1D, also particle tracking for non-coord plots 2004-05-31 dprice * Makefile, main.f90, options_limits.f90, supersphplot.f90: particle tracking limits work 2004-05-28 dprice * defaults_set.f90, interpolate3D_xsec_vec.f90, main.f90, modules.f90, options_limits.f90: particle tracking (exeter) NOT YET WORKING 2004-05-27 dprice * exact_rhoh.f90, read_data_dansph.f90, read_data_mbate.f90: bug fixes in input, rhoh plot no text 2004-05-26 dprice * Makefile, allocate.f90, colour_demo.f, exact_sedov.f90, int_from_string.f90, main.f90, options.f90, read_data_mbate.f, read_data_mbate.f90, supersphplot.f90: works on Matthews code, several compiler bugs fixed 2004-05-20 dprice * Makefile, defaults_set.f90, exact_swave.f, exact_wave.f90, main.f90, modules.f90, options_exact.f90: exact_swave -> general sine wave plot 2004-05-18 dprice * danpgtile.f: y axis label position 2004-05-18 dprice * options_page.f90: more paper options 2004-05-18 dprice * options_page.f90: bug fix in paper size menu 2004-05-18 dprice * allocate.f90, read_data_dansph.f90: bug fix in mem allocation for multiple files 2004-05-18 dprice * calc_quantities.f90: cross helicity 2004-05-17 dprice * Makefile, danpgtile.f, defaults_set.f90, legend.f, main.f90, modules.f90, options_page.f90, setpage.f90, supersphplot.f90: plot tiling, axes options 2004-05-17 dprice * Makefile, main.f90, modules.f90, options.f90, read_data_dansph.f90, supersphplot.f90: reads from multiple files off command line 2004-05-17 dprice * legend.f: various crap 2004-05-17 dprice * print_menu.f90: no defaults on y prompt 2004-05-17 dprice * interpolate1D.f90, interpolate2D.f90, interpolate2D_xsec.f90, interpolate3D.f90, interpolate3D_fastxsec.f90, interpolate3D_projection.f90: error catches 2004-05-17 dprice * danpgtile.f: bug fix in just=0 2004-05-13 dprice * calc_quantities.f90: calculates magnitude of current 2004-05-13 dprice * exact_sedov.f90: attempted to make it work for <3D 2004-05-13 dprice * read_data_dansph.f90: alpha B 2004-05-13 dprice * exact_mhdshock.f90: added extra solution 2004-05-10 dprice * exact_rhoh.f90, main.f90: works for different particle masses 2004-05-06 dprice * plot_powerspectrum.f90, powerspectrum_lomb1D.f90: error catches if variance=0 2004-04-26 dprice * main.f90: bug fix in titles 2004-04-21 dprice * options.f90, options_exact.f90, options_page.f90, options_particleplots.f90, options_render.f90, print_menu.f90, supersphplot.f90: menu cleaned up some more 2004-04-21 dprice * int_from_string.f90: izero : more robust 2004-04-21 dprice * exact_shock_old.f, render_smooth_pgxtal.f: obsolete subroutines removed 2004-04-21 dprice * legend.f: fiddling 2004-04-21 dprice * smooth_pixels.f: obsolete 2004-04-21 dprice * supersphplot.f90: comments added 2004-04-21 dprice * Makefile, danpgtile.f, main.f90, setpage.f90: utilities for tiling on page/ page setup 2004-04-21 dprice * options.f90: minor change to prompt 2004-04-21 dprice * options_page.f90: new paper sizes 2004-04-13 dprice * Makefile, options.f90, options_page.f90, print_menu.f90, supersphplot.f90: page options 2004-04-13 dprice * options.f90: bug fix in multiplot options 2004-04-13 dprice * supersphplot.f90: comments 2004-04-13 dprice * render.f90: crap 2004-04-13 dprice * read_data_dansph.f90: new labels 2004-04-13 dprice * main.f90: icoords crap 2004-04-13 dprice * modules.f90: maxplot increased 2004-04-13 dprice * plot_kernel_gr.f90: print outs 2004-04-01 dprice * interactive_part.f90: line plotting 2004-03-26 dprice * options_limits.f90: prompting on limits 2004-03-26 dprice * Makefile, defaults_set.f90, main.f90, modules.f90, options.f90, options_limits.f90, options_particleplots.f90, print_menu.f90, supersphplot.f90: options split into submenus 2004-03-26 dprice * read_data_dansph.f90: labels 2004-03-16 dprice * defaults_set.f90, interactive_part.f90, main.f90, modules.f90, options.f90, print_menu.f90: interactive mode in menu, animate removed 2004-03-15 dprice * Makefile, defaults_set.f90, interactive_part.f90, main.f90, modules.f90: preliminary interactive mode 2004-03-15 dprice * exact_toystar.f90: comments added 2004-03-09 dprice * main.f90, read_data_dansph.f90: bug fix in transformed limits, reallocation more sensible 2004-03-08 dprice * defaults_set.f90, interpolate1D.f90, main.f90, modules.f90, options_powerspec.f90, plot_powerspectrum.f90, powerspectrum_fourier1D.f90, powerspectrum_lomb1D.f90: working power spectrums (not sure about fourier) 2004-03-08 dprice * read_data_dansph.f90: bug fix with reallocate 2004-03-05 dprice * Makefile, defaults_set.f90, exact_sedov.f, exact_sedov.f90, main.f90, modules.f90, options_exact.f90: sedov blast wave solution working 2004-03-05 dprice * Makefile, allocate.f90, calc_quantities.f90, defaults_read.f90, defaults_set.f90, limits.f90, modules.f90, options.f90, read_data_dansph.f, read_data_dansph.f90, supersphplot.f90: allocatable arrays 2004-03-04 dprice * Makefile, exact_toystar2D.f90, read_data_mbate.f: IoA makefiles, some printouts removed 2004-02-27 dprice * exact_toystar2D.f90: toy star 2D stuff 2004-02-26 dprice * Makefile, defaults_set.f90, exact_toystar2D.f90, main.f90: 2D toy star exact solutions (preliminary), also A,C sensible defaults 2004-02-26 dprice * main.f90: xminrender removed 2004-02-26 dprice * Makefile, main.f90, modules.f90, render_coarse.f, vectorplot.f90: improved vector plots, npix,npixy etc 2004-02-25 dprice * Makefile, exact_toystar.f, exact_toystar.f90: exact_toystar -> f90 2004-02-23 dprice * modules.f90, options.f90, read_data_dansph.f: more initialisation bugs 2004-02-23 dprice * read_data_dansph.f: crap removed 2004-02-23 dprice * defaults_set.f90: more compiler-found bugs 2004-02-23 dprice * Makefile, defaults_set.f90, modules.f90, options.f90, print_menu.f, print_menu.f90: print menu -> f90, magfield option removed 2004-02-23 dprice * Makefile, calc_quantities.f90, defaults_set.f90, interpolate2D.f90, main.f90, modules.f90, options.f, options.f90, options_render.f90, print_menu.f, read_data_dansph.f, read_data_mbate.f, supersphplot.f90, transform.f, transform.f90: bugs from monash compiler: uninitialised variables fixed, also prompts for irender in menu 2004-02-23 dprice * main.f90, transform.f90: f90, limits transformed 2004-02-20 dprice * main.f90, modules.f90: compiler bugs fixed 2004-02-20 dprice * calc_quantities.f90, exact_mhdshock.f90, interpolate1D.f, interpolate1D.f90, interpolate2D.f, interpolate2D.f90, interpolate2D_xsec.f, interpolate2D_xsec.f90, interpolate3D.f, interpolate3D.f90, interpolate3D_fastxsec.f, interpolate3D_fastxsec.f90, interpolate3D_projection.f, interpolate3D_projection.f90, main.f90, modules.f90, supersphplot.f90: f90 2004-02-20 dprice * read_data_dansph.f: crap 2004-02-20 dprice * Makefile: f90 crap 2004-02-20 dprice * Makefile, read_data_dansph.f: bugs found by swinburne compiler fixed 2004-02-18 dprice * Makefile, defaults_set.f90, main.f90, modules.f90, options.f, plot_kernel_gr.f90: gr kernel plots, icircpart now array 2004-02-17 dprice * Makefile, colour_demo.f, colour_set.f, colour_set.f90: .f90 2004-02-17 dprice * menu_actions_old.f, supersphplot_old.f: removed 2004-02-16 dprice * defaults_set.f90, interpolate2D_xsec.f, main.f90: 2D xsections 2004-02-16 dprice * Makefile, legend.f, modules.f90: random crap 2004-02-16 dprice * main.f90: toy star exact for r 2004-02-06 dprice * Makefile, colour_demo.f, colour_set.f, defaults_read.f90, defaults_set.f90, defaults_write.f90, main.f90, menu_actions.f, options.f, read_defaults.f90, set_defaults.f, setcolours.f, supersphplot.f90, write_defaults.f90: name changes 2004-02-06 dprice * render_smooth.f: obsolete 2004-02-06 dprice * Makefile, exact_toystar_ACplane.f, interpolate3D_projection.f, menu_actions.f, modules.f90, powerspectrum_lomb1D.f90, supersphplot.f90: bugs picked up by monash compiler fixed 2004-01-14 dprice * set_defaults.f: better defaults for renderings 2004-01-14 dprice * colour_demo.f, setcolours.f: uses max available colours on device (up to 256) 2004-01-14 dprice * danpgwedg.f: more pixels in wedge 2004-01-13 dprice * read_data_dansph.f: minor clean up 2004-01-13 dprice * powerspectrum_fourier1D.f90: crap at the moment 2004-01-13 dprice * options_powerspec.f90: power spec options 2004-01-13 dprice * interpolate1D.f: 1D interpolation 2004-01-12 dprice * main.f90: a,b,c,d plot labelling 2003-12-30 dprice * calc_quantities.f90: uses ntotal instead of npart 2003-12-30 dprice * main.f90: axes crap cont... 2003-12-30 dprice * main.f90: axes sets to 0.02 and 0.98 not 0.0 and 1.0 2003-12-29 dprice * main.f90, menu_actions.f, modules.f90, print_menu.f, set_defaults.f: axes on/off 2003-12-29 dprice * render.f90: uses pgcons 2003-12-23 dprice * exact_rhoh.f90, read_data_dansph.f: read data sets mhd according to no of columns 2003-12-22 dprice * calc_quantities.f90, main.f90, modules.f90, read_data_dansph.f, supersphplot.f90: vperp etc calculated in calc_quantities, no longer in data file 2003-12-19 dprice * supersphplot.f90: goto removed 2003-12-19 dprice * Makefile, main.f90, set_defaults.f, supersphplot.f90: main.f90 added 2003-12-19 dprice * calc_quantities.f90: sets labels 2003-12-19 dprice * supersphplot.f90: from .f format 2003-12-19 dprice * supersphplot.f: to .f90 format 2003-12-18 dprice * Makefile, menu_actions.f, modules.f90, plot_powerspectrum.f90, powerspectrum_lomb1D.f90, set_defaults.f, supersphplot.f: power spectrum plotting/options etc 2003-12-18 dprice * options_exact.f90: moved out of menu_actions into separate file 2003-12-18 dprice * options_render.f90: renamed get_render_options, converted to .f90 2003-12-18 dprice * get_render_options.f: renamed options_render 2003-12-18 dprice * lomb_powerspectrum1D.f90: renamed powerspectrum_lomb1D 2003-12-18 dprice * supersphplot.f: labels on particle cross sections 2003-12-18 dprice * modules.f90: update to namelists 2003-12-16 dprice * modules.f90: more defaults saved 2003-12-16 dprice * Makefile, supersphplot.f: bug fixes, main prog cleaned up substantially 2003-12-16 dprice * interpolate3D_fastxsec.f: bug fix z < 2h 2003-12-15 dprice * interpolate3D.f: some bug fixes/minor modifications 2003-12-15 dprice * render.f90: .f90 2003-12-15 dprice * render.f: to .f90 2003-12-15 dprice * render.f: uses ymin 2003-12-15 dprice * supersphplot.f: xsec limits bug fixed, but not completely 2003-12-15 dprice * supersphplot.f: bug fix for cross sectioning 2003-12-15 dprice * read_data_dansph.f: bug fix: sets nghost 2003-12-15 dprice * supersphplot.f: lower case 2003-12-15 dprice * supersphplot.f: lower case 2003-12-15 dprice * Makefile, supersphplot.f, write_defaults.f: namelists, .f90 source 2003-12-15 dprice * modules.f90: namelists, .f90 2003-12-15 dprice * plot_powerspectrum.f90: histogram 2003-12-15 dprice * read_defaults.f90, write_defaults.f90: namelist 2003-12-15 dprice * read_defaults.f: to .f90 2003-12-15 dprice * modules.f: freeform source -> to .f90 2003-12-15 dprice * modules.f: lower case 2003-12-09 dprice * Makefile, lomb_powerspectrum1D.f90, modules.f, plot_powerspectrum.f90, set_defaults.f, supersphplot.f: power spectrum of 1D data (some bugs still) 2003-12-08 dprice * modules.f: minor changes for spherical blast wave 2003-11-24 dprice * supersphplot.f: update 2003-11-24 dprice * Makefile, calc_quantities.f90, exact_rhoh.f90, menu_actions.f, plot_rhoh.f, supersphplot.f: calc_quantities added, rhoh moved 2003-10-30 dprice * supersphplot.f: fix bug when no data 2003-10-22 dprice * Initial revision splash/docs/000755 000770 000000 00000000000 12612006627 013702 5ustar00dpricewheel000000 000000 splash/giza/000755 000770 000000 00000000000 12612006632 013700 5ustar00dpricewheel000000 000000 splash/INSTALL000644 000770 000000 00000013422 11672030063 014001 0ustar00dpricewheel000000 000000 To compile SPLASH v2.x you will need simply: - A Fortran 90/95/2003 compiler (e.g. gfortran) - X-Windows - cairo (As SPLASH is command-line driven, it is also assumed you have a basic knowledge of unix). The basic steps for installation are: 1) make sure you have a Fortran 90/95 compiler (such as gfortran). 2) make sure you have cairo on your system 3) compile SPLASH/giza and link with cairo. 4) if desired/necessary write a read_data subroutine so that SPLASH can read your data format. 5) make pretty pictures. As a first attempt, with gfortran as your Fortran compiler, just try "make SYSTEM=gfortran" and this may "just work". If not, read on... For troubleshooting of some common installation problems, have a look at the online FAQ. 1) ---------------- Fortran 9x/2003 compilers --------------------------- By now, many Fortran 90/95 compilers exist. In terms of free ones, both Intel and Sun have non-commercial versions available for Linux. Gfortran is the free GNU compiler, as of version 4.3.0, can be used to compile SPLASH. The latest version can be downloaded from: http://gcc.gnu.org/wiki/GFortran I strongly recommend downloading a more recent version of gfortran rather than relying on any pre-installed version (use gfortran -v to check the version number). In particular versions 4.2.0 and lower *do not* compile SPLASH2. Later versions also have openMP, so you can compile and run SPLASH in parallel ("make PARALLEL=yes") 2) ----------------- The Cairo Graphics Library -------------------- Cairo is a low-level system library used in many applications. Thus it is highly likely that you already have a copy on your system and already in your library path. Look for the header file cairo.h, e.g. using "locate cairo.h" or have a look in the usual places (e.g. /usr/include/cairo, /usr/X11/include). If not, you can usually use your inbuilt package manager to install cairo as follows: Debian/Ubuntu: sudo apt-get install libcairo2-dev Fedora/Red Hat/CentOS: sudo yum install cairo-devel OpenSUSE: zypper install cairo-devel MacPorts: sudo port install cairo Alternatively, use the script provided in the root-level splash directory: ./install-cairo.sh which downloads and installs both pixman and cairo into the giza/ subdirectory. Unlike the methods above, this does not require any admin/superuser permissions. 3) ----------------- Compiling SPLASH with the GIZA backend ---------------- Type: "make SYSTEM=xxx" Where xxx corresponds to a SYSTEM setting in build/Makefile. These are presets for most of the common Fortran compilers, the most useful of which are: gfortran -- settings for the gfortran/gcc compilers g95 -- settings for the g95/gcc compilers nagf95 -- settings for the NAG f95 compiler sunf95 -- settings for the Sun f95 compiler ifort -- settings for the Intel Fortran/C Compilers pgf90 -- settings for the Portland Group Fortran 90 compiler 4) -------------- reading your data format ------------------- The default binaries installed are as follows: splash : alias for asplash asplash : reads ascii formatted data files gsplash : reads data files from GADGET code (http://www.mpa-garching.mpg.de/galform/gadget/) dsplash : reads data files from DRAGON code nsplash : reads data files from NDSPMHD code (http://users.monash.edu.au/~dprice/ndspmhd/) tsplash : reads TIPSY files (ascii and binary) as used in GASOLINE rsplash : reads data files from MAGMA code ssplash : reads data files from sphNG code srsplash : reads data files from SEREN code vsplash : reads data files from VINE code Other formats implemented but not compiled by default include: h5splash : reads h5part formatted files bsplash : old Matthew Bate/Benz code format (see the userguide for a full list) The basic "splash" binary is quite general and will read any ascii or csv data file where columns correspond to different quantities and rows correspond to each particle (actually I use splash to plot graphs for nearly all data in this form, whether SPH or not) -- it will also sensibly skip header lines which do not have the same number of columns. However, it is ultimately desirable to use SPLASH to directly visualise the (binary) output of your code. If your format is not amongst those distributed, then BEFORE you start writing your own routine, please consider whether or not a routine to read your format would be of more general use (e.g. to other users of your code). If so, PLEASE email me to request a new read_data routine for your format, by sending an email attaching: a) an example dump and b) the source code from the routine which wrote the dump file. Then I can write a read for your format that can be added to the SPLASH repository and distributed in all future versions. Whilst I aim never to change the interface to the read_data routines, it is not impossible that some changes may occur somewhere down the line (or enhanced functionality -- for example the more advanced data reads are able to read only the required columns for a given plot from the file, rather than the whole file). If you *really* want to hack one yourself it is best to look at some of the other examples and change the necessary parts to suit your data files. Note that reading directly from unformatted data files is *much* faster than reading from formatted (ascii) data. If you do end up writing your own, again, please email me the end result so I can add it to the officially supported data reads. This also makes it much easier for you to upgrade to newer versions as you do not require a locally customised version. 5) ----- running splash/ making pretty pictures For detailed help on how to use SPLASH, refer to the (quite extensive) userguide on the splash web page. Have fun! And remember, if you get stuck you can always email me... (it doesn't hurt). Daniel Price daniel.price@monash.edu splash/install-cairo.sh000755 000770 000000 00000010754 12516110273 016055 0ustar00dpricewheel000000 000000 #!/bin/bash # # Script for splash 2.x that retrieves and installs # both cairo and pixman # # (these are the only dependencies for the giza backend, # are often already present as system libraries but # may need to be installed by the user if not) # # An alternative is to use your inbuilt package manager to install cairo # e.g. # Debian/Ubuntu: # sudo apt-get install libcairo2-dev # Fedora/Red Hat/CentOS: # sudo yum install cairo-devel # OpenSUSE: # zypper install cairo-devel # MacPorts: # sudo port install cairo # cairodist=cairo-1.12.18.tar.xz; pixmandist=pixman-0.32.6.tar.gz; xzdist=xz-5.2.1.tar.gz; installprefix=$PWD/giza; url="http://cairographics.org/releases"; xzurl="http://tukaani.org/xz/"; # #--Check that the giza directory is present. # This is not strictly necessary, but it means we install cairo and # pixman to the same location as the giza libraries and linking of # giza with cairo will work automatically. # if [ ! -d $installprefix ]; then echo; echo " ERROR: directory $installprefix does not exist "; echo; echo " $0 should be run from the root-level splash directory"; echo " with giza already downloaded as a subdirectory of splash"; echo; exit 1; fi # #--if not already downloaded, retrieve the pixman and cairo tarballs using wget # if [ ! -f $cairodist ] || [ ! -f $pixmandist ]; then echo "cairo and/or pixman not downloaded"; if !(type -p wget); then echo "ERROR: $0 requires the \"wget\" command, which is not present on"; echo "your system. Instead, you will need to download the following files by hand:"; echo echo "$url/$cairodist"; echo "$url/$pixmandist"; echo; echo "To proceed, download these files, place them in the current directory and try again" exit; else wget $url/$pixmandist; wget $url/$cairodist; fi fi # #--proceed with installation # if [ ! -f $cairodist ] || [ ! -f $pixmandist ]; then echo; echo "ERROR: cairo and/or pixman download failed. Please try again"; echo; else echo "$pixmandist and $cairodist found in current dir"; # #--unpack the distribution files # echo "unpacking pixman..."; tar xfz $pixmandist; echo "unpacking cairo..."; tar -Jxf $cairodist; pixmandir=${pixmandist/.tar.gz/}; cairodir=${cairodist/.tar.xz/}; if [ ! -d $pixmandir ]; then echo; echo "ERROR: pixman failed to unpack (no directory $pixmandir)"; echo; exit $?; fi if [ ! -d $cairodir ]; then echo; echo "ERROR: cairo failed to unpack (no directory $cairodir)"; echo; # #--install xzutils if tar -Jxf fails... # echo "Attempting to download xzutils in order to unpack cairo..." wget $xzurl/$xzdist; tar xfz $xzdist; xzdir=${xzdist/.tar.gz/}; cd $xzdir; xzinstalldir=/tmp/xz-tmp/; ./configure --prefix=$xzinstalldir; make || ( echo; echo "ERROR during xzutils build"; echo; exit $? ); make install || ( echo; echo "ERROR installing xzutils into $xzinstalldir"; echo; exit $? ); cd ..; # #--now unpack cairo using xz utils # ${xzinstalldir}/bin/unxz $cairodist; tar xf ${cairodist/.xz/}; if [ ! -d $cairodir ]; then echo; echo "ERROR: cairo failed to unpack even with xz downloaded (no directory $cairodir)"; echo; exit $?; fi fi # #--install pixman # cd $pixmandir; ./configure --prefix=$installprefix || ( echo; echo "ERROR during pixman config"; echo; exit $? ); make || ( echo; echo "ERROR during pixman build"; echo; exit $? ); make install || ( echo; echo "ERROR installing pixman into $installdir"; echo; exit $? ); cd ..; # #--install cairo # export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$installprefix; export PKG_CONFIG_PATH=$installprefix/lib/pkgconfig; cd $cairodir; ./configure --prefix=$installprefix || ( echo; echo "ERROR during cairo config"; echo; exit $? ); make || ( echo; echo "ERROR during cairo build"; echo; exit $? ); make install || ( echo; echo "ERROR installing cairo into $installdir"; echo; exit $? ); cd ..; #--cleanup #rm -rf $pixmandir; #rm -rf $cairodir; # #--finish # echo; echo "cairo and pixman installation successful"; echo "type \"make\" to compile SPLASH"; echo; echo "You should also add the following line to your .bashrc or equivalent:"; echo; if [[ `uname` =~ Darwin ]]; then echo "export DYLD_LIBRARY_PATH=\$DYLD_LIBRARY_PATH:$installprefix"; else echo "export LD_LIBRARY_PATH=\$LD_LIBRARY_PATH:$installprefix"; fi echo fi splash/INSTALL.macosx000644 000770 000000 00000006052 11626675703 015312 0ustar00dpricewheel000000 000000 On OS/X, the last stable version of SPLASH is available as a MacPorts package. Get MacPorts from: http://www.macports.org/ Then SPLASH can be installed using: sudo port install splash For troubleshooting of some common installation problems, have a look at the online FAQ. To install splash manually (recommended if you plan on modifying the source code) refer to the general INSTALL instructions. -------------- reading your data format ------------------- The basic "splash" binary is quite general and will read any data where columns correspond to different quantities and rows correspond to each particle (actually I use splash to plot graphs for nearly all data in this form, whether SPH or not) -- it will also sensibly skip header lines which do not have the same number of columns. However, it is ultimately desirable to use SPLASH to directly visualise the (binary) output of your code. If you are using a widely used SPH code (e.g. GADGET, GASOLINE, VINE, DRAGON), it is reasonably likely that I have already written a read data subroutine which will read your dumps. If your format is not amongst those distributed, then BEFORE you start writing your own routine, please consider whether or not a routine to read your format would be of more general use (e.g. to other users of your code). If so, PLEASE email me to request a new read_data routine for your format, by sending an email attaching: a) an example dump and b) the source code from the routine which wrote the dump file. Then I can write a read for your format that can be added to the SPLASH repository and distributed in all future versions. Whilst I aim never to change the interface to the read_data routines, it is not impossible that some changes may occur somewhere down the line (or enhanced functionality -- for example the more advanced data reads are able to read only the required columns for a given plot from the file, rather than the whole file). If you *really* want to hack one yourself it is best to look at some of the other examples and change the necessary parts to suit your data files. Note that reading directly from unformatted data files is *much* faster than reading from formatted (ascii) output. Just to get started you can use the read_data_ascii.f90 which reads from ascii files, but this will not enable the full rendering capabilities until you specify the location of the density, h and particle mass in the arrays (via the parameters ih, irho and ipmass in the set_labels subroutine which is part of the read_data file). If you do end up writing your own, again, please email me the end result so I can add it to the officially supported data reads. This also makes it much easier for you to upgrade to newer versions as you do not require a locally customised version. 5) ----- running splash/ making pretty pictures ----- For detailed help on how to use SPLASH, refer to the (quite extensive) userguide in the /docs directory or on the splash web page. Have fun! And remember, if you get stuck you can always email me... (it doesn't hurt). Daniel Price daniel.price@monash.edu splash/INSTALLv1.x000644 000770 000000 00000035030 11626675703 014534 0ustar00dpricewheel000000 000000 To compile SPLASH with the PGPLOT backend (the default in SPLASH v1.x.x, but still an option with SPLASH 2.x) you will need the following on your system, both of which are freely available: - The PGPLOT graphics subroutine library - A Fortran 95 compiler The basic steps for installation are: 1) make sure you have a Fortran 90/95 compiler (such as g95 or gfortran). 2) make sure you have the PGPLOT libraries installed. 3) compile SPLASH and link with PGPLOT. 4) if desired/necessary write a read_data subroutine so that SPLASH can read your data format. 5) make pretty pictures. For troubleshooting of some common installation problems, have a look at the online FAQ. 1) ---------------- Fortran 95 compilers --------------------------- By now, many Fortran 90/95 compilers exist. In terms of free ones, both Intel and Sun have non-commercial versions available for Linux and the g95 compiler, downloadable from: http://www.g95.org successfully compiles SPLASH and if necessary the PGPLOT libraries. Gfortran is also free and, as of version 4.2.0, works. The latest version can be downloaded from: http://gcc.gnu.org/wiki/GFortran I strongly recommend downloading a more recent version of gfortran rather than relying on any pre-installed version (use gfortran -v to check the version number). In particular versions 4.1.0 and lower *do not* compile splash. Later versions also have openMP, so you can compile and run SPLASH in parallel. 2) ------------------- PGPLOT ----------------------------------------- The PGPLOT graphics subroutine library is freely downloadable from http://www.astro.caltech.edu/~tjp/pgplot/ or by ftp from ftp://ftp.astro.caltech.edu/pub/pgplot/pgplot5.2.tar.gz however check to see if it is already installed on your system (if so, the libraries are usually located in /usr/local/pgplot). If PGPLOT is already installed, make sure that the environment variable PGPLOT_DIR is set to the location of the PGPLOT installation directory (e.g. /usr/local/pgplot). Check this by typing "echo $PGPLOT_DIR". If instead you are following the steps below, set the PGPLOT_DIR environment variable to the directory to which you will install PGPLOT (e.g. export PGPLOT_DIR=$HOME/pgplot). It is a good idea to add the setting of PGPLOT_DIR into your .profile/.bashrc or .tcshrc file along with a setting for PGPLOT_DEV (e.g. to "/xw" which sets the default device to be the X-windows device). --- installing PGPLOT yourself --- Whilst detailed installation instructions are given in the PGPLOT distribution, the general procedure for installing your own version (if necessary) is given below (otherwise skip to part 3). Note: to compile PGPLOT with the png and X-windows drivers may require some packages to be installed from your linux distribution. In Ubuntu these are "libpng-dev" and "libX11-dev" which can be installed with "sudo apt-get libpng-dev" and "sudo apt-get libX11-dev". Otherwise you will encounter errors regarding missing header files -- e.g. "cannot find png.h" and a whole bunch of errors. a) untar the pgplot5.2.tar.gz file (e.g. in your home space): "tar xvfz pgplot5.2.tar.gz" b) rename the directory pgplot to something else (e.g. "mv pgplot pgplotsrc"). c) make a directory called pgplot and enter it: "mkdir pgplot; cd pgplot" d) copy the drivers.list file from the pgplotsrc directory "cp ../pgplotsrc/drivers.list ." e) edit the drivers.list file and uncomment the following drivers: /NULL /XW /VPS /CPS /VCPS /PS and either /PNG /TPNG or /GIF /VGIF. Optionally also /PPM /VPPM. f) make a makefile using the makemake utility: "../pgplotsrc/makemake ../pgplotsrc linux g77_gcc" (I generally always use "linux" and "g77_gcc" regardless of the actual operating system). You should now have a file called "makefile" in your directory. g) edit the makefile, replacing the compiler "g77" with "gfortran" or "g95" (or any other compiler) as appropriate. For some compilers, you may need to change the FFLAGC= to just -O2. h) type "make": this should compile through all the .f files and may or may not compile the GIF drivers (if not, go back to step d and remove the /GIF drivers from the list), but will definitely die for the png driver with an error like: make: *** No rule to make target `png.h', needed by `pndriv.o'. Stop. i) edit the makefile and initially try just commenting out the line: pndriv.o : ./png.h ./pngconf.h ./zlib.h ./zconf.h by adding a preceding hash as follows: #pndriv.o : ./png.h ./pngconf.h ./zlib.h ./zconf.h If this does not work, try giving the correct paths for these files (use "locate png.h" to find where they are) -- usually this will be the following: pndriv.o : /usr/include/png.h /usr/include/pngconf.h /usr/include/zlib.h /usr/include/zconf.h Also add the above include path to the CFLAGC= variable, by amending the line "CFLAGC= xxx" to "CFLAGC= xxx -I/usr/include/" (e.g. on a mac you may need -I/sw/include/ or -I/opt/include/). Also, for the time being, comment out the line SHARED_LIB= (stuff) and replace it with a blank setting: SHARED_LIB= so that only the static library (libpgplot.a) is built. If you succeed with this you can try going back and uncommenting this line and typing "make" again to build the dynamic library. You may further need to add the path for the png library (libpng.a) to the LIBS= flag (e.g. LIBS=stuff -L/sw/lib/). j) now type "make" again, and you should obtain a successful build. Check that your installation is OK by running the demo programs pgdemo1, pgdemo2 etc. 3) ------------------- Compiling the code -------------------------------- Once you have a copy of PGPLOT installed, you can proceed with the SPLASH installation. Prior to doing so you should make sure that the PGPLOT_DIR environment variable is set (check using "echo $PGPLOT_DIR"). If not, add the following lines to your ~/.bashrc file (or the tcsh equivalent): export PGPLOT_DIR=/me/whereeveriputit/pgplot export PGPLOT_DEV=/xw (this sets the default PGPLOT device). export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$PGPLOT_DIR Now, having untarred the SPLASH bundle: "tar xvfz splash-x.x.x.tar.gz", you should have a directory called splash/. Enter this directory: "cd splash" and have a look in the Makefile. Preset options for the most common Fortran compilers are given in the Makefile provided the variable SYSTEM is set appropriately (either on the command line or as an environment variable). On the command line, type "make SYSTEM=xxx BACKEND=pgplot" Where the SYSTEM corresponds to one of those listed in the Makefile, some of the most commonly used of which are: gfortran -- settings for the gfortran compiler g95 -- settings for the g95 compiler nagf95 -- settings for the NAG f95 compiler sunf95 -- settings for the Sun f95 compiler ifort -- settings for the Intel Fortran Compiler pgf90 -- settings for the Portland Group Fortran 90 compiler Options which compile and also link PGPLOT on specific machines are: mymac -- settings for a Mac using g95 with PGPLOT installed via fink ukaff1a -- settings for the ukaff1a supercomputer If you have the PGPLOT_DIR environment variable set then linking with PGPLOT and associated libraries (libpng, libX11) *might just work* and you should find a whole bunch of splash binaries (asplash, gsplash, ssplash etc.) have been created. If so, then you are done with compilation and can skip directly to step 4 or 5. If not, read on. ---- porting to a new SYSTEM ------ If none of the SYSTEM variables corresponds to your local Fortran compiler, it should be reasonably straightforward to add your own. For example you will need to set the Fortran compiler and flags to your local version, e.g.. F90C = g95 F90FLAGS = -O and importantly, on some compilers you will need to make sure that backslashes (\) are treated as normal characters. For example on the following compilers you should use: intel fortran compiler: F90C = ifc/ifort F90FLAGS = -O -nbs portland group fortran: F90C = pgf90 F90FLAGS = -O -Mbackslash Secondly, you will need to modify the system-dependent routines for your compiler. These are specified via the settings: SYSTEMFILE = system_f2003.f90 which uses Fortran 2003 standard calls (supported by almost all recent compilers). Alternatively the file system_unix.f90 should also work for older (and newer) unix-based compilers. A file system_unix_NAG is included for the NAG f95 compiler. The whole idea of SPLASH is that filenames should be read off the command line, though sometimes there can be library clashes (e.g. two libraries defining the same function) which make these calls not work. In this case there are some slightly convoluted workarounds given in the online FAQ. If you have ported to a new compiler, please send me an email with your new SYSTEM variable and I will add it to the SPLASH Makefile, both for you and for others (then you can just update directly). Remember it is always likely that someone else in the same department may download SPLASH one day... ------------------- linking with PGPLOT libraries --------------------- Secondly the compiler must be able to link to the PGPLOT and X11 libraries on your system. The settings for these are given at the top of the Makefile by the settings: X11LIBS= -lX11 PGPLOTLIBS= -lpgplot If that works at a first attempt, take a moment to think several happy thoughts about your system administrator. If these libraries are not found, you will need to enter the library paths by hand. On most systems this is something like: X11LIBS= -L/usr/X11R6/lib -lX11 PGPLOTLIBS= -L/usr/local/pgplot -lpgplot (assuming the PGPLOT libraries are in the /usr/local/pgplot directory and the X11 libraries are in /usr/X11R6/lib). If this does not work, try using the "locate" command to find the libraries on your system: user> locate libpgplot user> locate libX11 If, having found the PGPLOT and X11 libraries, the program still won't compile, it is usually because the PGPLOT on your system has been compiled with a different compiler to the one you are using, and the libraries from that compiler must also be linked. For g77-compiled PGPLOT (very common) the relevant library is g2c, so use: PGPLOTLIBS = -L/usr/local/pgplot -lpgplot -lg2c similarly for gfortran-compiled PGPLOT the appropriate library is libgfortran, so use -lgfortran, and for g95-compiled PGPLOT, libg95, so use -lg95 (where again you may need the -L flag to specify the location of the libxxx.a or libxxx.so file). If the PNG drivers are incorporated into the PGPLOT installation, the -lpng libraries must also be added. *** A good, failsafe way of working out exactly what flags are required to link to PGPLOT on your system is to look in the PGPLOT makefile itself, at exactly which flags were used to compile the pgdemo programs (pgdemo1, pgdemo2 -- you should also run these to check that PGPLOT has been installed correctly). For example in the PGPLOT makefile on my Mac (located in /sw/lib/pgplot), the flags are LIBS=-L/usr/X11R6/lib -lX11 -L/sw/lib -laquaterm -Wl,-framework -Wl,Foundation so these are the flags needed to link to PGPLOT, PLUS fink had used g77 to compile pgplot, so I also need to add the -lg2c flag (see above). Obviously a way round having to work out which compiler libraries to add is to simply make sure that PGPLOT has been compiled with the same compiler you are using to compile SPLASH. It is worth remembering also, that if you work in an Astronomy department, it is almost certain that there will be someone in your department who uses PGPLOT on your system and knows how to link to it, so it is worth asking around. *** Another last-resort option for linking to PGPLOT is to compile with the static libraries explictly on the command line. To do this simply set the variable STATICLIBS, e.g. STATICLIBS=/usr/local/libpgplot.a then no -lpgplot is needed and the library is treated like a normal .o file at compile time. Have a look at the online FAQ for some tips on common problems with linking to PGPLOT (e.g. font problems on 64-bit machines). 4) -------------- reading your data format ------------------- The basic "splash" binary is quite general and will read any data where columns correspond to different quantities and rows correspond to each particle (actually I use splash to plot graphs for nearly all data in this form, whether SPH or not) -- it will also sensibly skip header lines which do not have the same number of columns. However, it is ultimately desirable to use SPLASH to directly visualise the (binary) output of your code. If you are using a widely used SPH code (e.g. GADGET, GASOLINE, VINE, DRAGON), it is reasonably likely that I have already written a read data subroutine which will read your dumps. If your format is not amongst those distributed, then BEFORE you start writing your own routine, please consider whether or not a routine to read your format would be of more general use (e.g. to other users of your code). If so, PLEASE email me to request a new read_data routine for your format, by sending an email attaching: a) an example dump and b) the source code from the routine which wrote the dump file. Then I can write a read for your format that can be added to the SPLASH repository and distributed in all future versions. Whilst I aim never to change the interface to the read_data routines, it is not impossible that some changes may occur somewhere down the line (or enhanced functionality -- for example the more advanced data reads are able to read only the required columns for a given plot from the file, rather than the whole file). If you *really* want to hack one yourself it is best to look at some of the other examples and change the necessary parts to suit your data files. Note that reading directly from unformatted data files is *much* faster than reading from formatted (ascii) output. Just to get started you can use the read_data_ascii.f90 which reads from ascii files, but this will not enable the full rendering capabilities until you specify the location of the density, h and particle mass in the arrays (via the parameters ih, irho and ipmass in the set_labels subroutine which is part of the read_data file). If you do end up writing your own, again, please email me the end result so I can add it to the officially supported data reads. This also makes it much easier for you to upgrade to newer versions as you do not require a locally customised version. 5) ----- running splash/ making pretty pictures ----- For detailed help on how to use SPLASH, refer to the (quite extensive) userguide in the /docs directory or on the splash web page. Have fun! And remember, if you get stuck you can always email me... (it doesn't hurt). Daniel Price daniel.price@monash.edu splash/LICENCE000644 000770 000000 00000035445 12156620632 013753 0ustar00dpricewheel000000 000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS splash/Makefile000644 000770 000000 00000001070 12240556123 014406 0ustar00dpricewheel000000 000000 #---------------------------------------------------------------- # Parent Makefile for SPLASH # This file is just a wrapper for the sub-make in the build # directory. Refer to build/Makefile for more details. # # (c) 2007-2013 Daniel Price # #---------------------------------------------------------------- .PHONY: splash install docs tests src bin splash: @cd build; ${MAKE} ${MAKECMDGOALS} %:: @cd build; ${MAKE} ${MAKECMDGOALS} install: @cd build; ${MAKE} ${MAKECMDGOALS} docs: @cd build; ${MAKE} ${MAKECMDGOALS} clean: @cd build; ${MAKE} clean splash/README000644 000770 000000 00000002064 11632332677 013644 0ustar00dpricewheel000000 000000 SPLASH - an interactive visualisation tool for SPH data Copyright (C) 2005-2011 Daniel Price daniel.price@monash.edu For installation instructions see the INSTALL file. For detailed descriptions of menu options and algorithms, refer to the userguide in the /docs directory or online. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA See the LICENSE file for details. splash/scripts/000755 000770 000000 00000000000 12612006625 014437 5ustar00dpricewheel000000 000000 splash/src/000755 000770 000000 00000000000 12612006626 013540 5ustar00dpricewheel000000 000000 splash/tests/000755 000770 000000 00000000000 12612006625 014112 5ustar00dpricewheel000000 000000 splash/utils/000755 000770 000000 00000000000 12612006625 014110 5ustar00dpricewheel000000 000000 splash/VERSION000644 000770 000000 00000000076 12612006632 014021 0ustar00dpricewheel000000 000000 splash, version 2.6.0, built on Thu 22 Oct 2015 09:11:38 AEDT splash/utils/grid2pdf.f90000644 000770 000000 00000005571 11527373735 016156 0ustar00dpricewheel000000 000000 program grid2pdf use system_commands, only:get_number_arguments,get_argument use readwrite_griddata, only:open_gridfile_r,read_gridcolumn use pdfs, only:pdf_calc,pdf_write,mean_variance implicit none logical, parameter :: usefixedbins = .true. integer, parameter :: nbins = 270 integer, parameter :: iunit = 13 integer, dimension(3) :: nxgrid integer :: ierr,ncolumns,itransx,ifile,nargs integer :: ntot,i real :: time,rhologmin,rhologmax,pdfmin,pdfmax,smean,svar,rhomean,rhovar real, dimension(nbins) :: xbin,pdf character(len=120) :: filename,tagline character(len=20) :: informat logical :: volweighted real, dimension(:), allocatable :: rhogrid tagline = 'grid2pdf: a SPLASH utility (c) 2010 Daniel Price' call get_number_arguments(nargs) if (nargs.le.0) then print "(a)",trim(tagline) print "(/,a,/)",'Usage: grid2pdf gridfile(s)' stop endif do ifile=1,nargs ! !--get the filename off the command line ! call get_argument(ifile,filename) ! !--open the grid data file and read the header information ! informat = 'gridbinary' call open_gridfile_r(iunit,filename,informat,nxgrid(:),ncolumns,time,ierr) ! !--allocate memory for the grid data ! ntot = product(nxgrid) if (.not.allocated(rhogrid) .or. ntot.ne.size(rhogrid)) then if (allocated(rhogrid)) deallocate(rhogrid) allocate(rhogrid(ntot)) endif ! !--read one particular column (in this case, the density) ! call read_gridcolumn(iunit,rhogrid,ntot,ierr) ! !--close the file ! close(iunit) ! !--calculate the mean and variance in rho ! call mean_variance(rhogrid,ntot,rhomean,rhovar) ! !--set the parameters for calculating the PDF ! [in this case, we want the PDF of ln (rho)] ! rhologmin = -15. rhologmax = 12. where (rhogrid.gt.0.) rhogrid = log(rhogrid) end where !itransx = 6 ! !--calculate the PDF ! call pdf_calc(ntot,rhogrid,rhologmin,rhologmax,nbins,xbin,& pdf,pdfmin,pdfmax,usefixedbins,volweighted,ierr) ! !--calculate the mean and variance in ln(rho) ! call mean_variance(rhogrid,ntot,smean,svar) print*,' rho mean,var = ',rhomean,rhovar print*,'ln(rho) mean,var = ',smean,svar print*,' svar,rhovar = ',-2.*smean,exp(svar) - 1. ! !--check the routine ! svar = 0. do i=1,ntot svar = svar + (rhogrid(i) - smean)**2 enddo svar = svar/real(ntot-1) print*,'svar = ',svar ! !--write the PDF to file ! if (ierr.eq.0) then call pdf_write(nbins,xbin,pdf,'lnrhogrid',volweighted,trim(filename),trim(tagline)) endif enddo ! !--clean up/deallocate memory ! if (allocated(rhogrid)) deallocate(rhogrid) end program grid2pdf splash/tests/test_fieldlines.f90000644 000770 000000 00000016575 11230074637 017630 0ustar00dpricewheel000000 000000 ! !--unit test for field line plotting routine ! program test_fieldlines use fieldlines, only:streamlines use render, only:render_pix implicit none integer, parameter :: ipixx = 1000, ipixy = 1000, nc = 100 integer :: npixx, npixy,i,j real, parameter :: errtol = 1.e-7 real, dimension(ipixx,ipixy) :: datpix,vecpixx,vecpixy,datpix1,datpix2,vecpixx1,vecpixy1 real :: xmin,xmax,ymin,ymax,zmin,zmax,dxpix real :: xi,yi,datmin,datmax,err,dcont real, parameter :: pi=3.1415926536 real, dimension(6) :: trans real, dimension(nc) :: levels xmin = -0.5 xmax = 0.5 ymin = -0.5 ymax = 0.5 call pgopen('/xw') print "(70('-'))" print*,'ORSZAG-TANG TEST' npixx = 400 npixy = 400 dxpix = (xmax-xmin)/real(npixx) do j = 1,npixy yi = ymin + (j-0.5)*dxpix if (j.le.10) print*,'y = ',yi do i = 1,npixx xi = xmin + (i-0.5)*dxpix vecpixx(i,j) = func_vecx(xi,yi) vecpixy(i,j) = func_vecy(xi,yi) datpix1(i,j) = func_stream(xi,yi) enddo enddo call streamlines(vecpixx(1:npixx,1:npixy),vecpixy(1:npixx,1:npixy), & datpix(1:npixx,1:npixy),npixx,npixy,dxpix) do j = 1,npixy,2 yi = ymin + (j-0.5)*2.*dxpix do i = 1,npixx,2 xi = xmin + (i-0.5)*2.*dxpix vecpixx1((i+1)/2,(j+1)/2) = func_vecx(xi,yi) !vecpixx(i,j) vecpixy1((i+1)/2,(j+1)/2) = func_vecy(xi,yi) !vecpixy(i,j) enddo enddo npixx = npixx/2 npixy = npixy/2 dxpix = (xmax-xmin)/real(npixx) call streamlines(vecpixx1(1:npixx,1:npixy),vecpixy1(1:npixx,1:npixy), & datpix2(1:npixx,1:npixy),npixx,npixy,dxpix) npixx = npixx*2 npixy = npixy*2 dxpix = (xmax-xmin)/real(npixx) !do j=1,npixy,2 ! do i=1,npixx,2 ! datpix(i,j) = (4.*datpix(i,j) - datpix2((i+1)/2,(j+1)/2))/3. ! enddo !enddo call pgenv(xmin,xmax,ymin,ymax,1,0) trans = 0. trans(1) = xmin - 0.5*dxpix trans(2) = dxpix trans(4) = ymin - 0.5*dxpix trans(6) = dxpix datmax = maxval(datpix(1:npixx,1:npixy)) datmin = minval(datpix(1:npixx,1:npixy)) print*,'min,max datpix = ',datmin,datmax datpix(1:npixx,1:npixy) = datpix(1:npixx,1:npixy) - 0.5*(datmax + datmin) datmax = maxval(datpix(1:npixx,1:npixy)) datmin = minval(datpix(1:npixx,1:npixy)) print*,'min,max datpix = ',datmin,datmax print*,'plotting integrated array...' ! call render_pix(datpix(1:npixx,1:npixy),datmin,datmax,'crap',npixx,npixy, & ! xmin,ymin,dxpix,0,.true.,.false.,30,.false.) call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,datmin,datmax,trans) ! !--set contour levels ! dcont = (datmax-datmin)/real(nc+1) ! even contour levels do i=1,nc levels(i) = datmin + real(i)*dcont enddo ! !--plot contours (use pgcont if pgcons causes trouble) ! call pgcons(datpix(1:npixx,1:npixy),npixx,npixy,1,npixx,1,npixy,levels(1:nc),nc,trans) ! call pgenv(xmin,xmax,ymin,ymax,1,0) datmax = maxval(datpix1(1:npixx,1:npixy)) datmin = minval(datpix1(1:npixx,1:npixy)) print*,'min,max datpix1 = ',datmin,datmax !print*,' plotting exact solution ...' ! call pgimag(datpix1,ipixx,ipixy,1,npixx,1,npixy,datmin,datmax,trans) !call pgcons(datpix1(1:npixx,1:npixy),npixx,npixy,1,npixx,1,npixy,levels(1:nc),nc,trans) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,datpix1(1:npixx,1:npixy),err) print*,'average error in stream line calculation = ',err if (npixx.eq.400 .and. npixy.eq.400) then if (err < 0.00019) then print*,'PASSED: error within limits' else print*,'FAILED: error too large!' endif else print*,'setup different to usual one' endif !--------------------- ! dipole field test !---------------------- print "(70('-'))" print*,'DIPOLE TEST' npixx = 400 npixy = 400 dxpix = (xmax-xmin)/real(npixx) do j = 1,npixy yi = ymin + (j-0.5)*dxpix do i = 1,npixx xi = xmin + (i-0.5)*dxpix vecpixx(i,j) = func_vecx_dipole(xi,yi) vecpixy(i,j) = func_vecy_dipole(xi,yi) datpix1(i,j) = func_stream_dipole(xi,yi) enddo enddo call streamlines(vecpixx(1:npixx,1:npixy),vecpixy(1:npixx,1:npixy), & datpix(1:npixx,1:npixy),npixx,npixy,dxpix) call pgenv(xmin,xmax,ymin,ymax,1,0) trans = 0. trans(1) = xmin - 0.5*dxpix trans(2) = dxpix trans(4) = ymin - 0.5*dxpix trans(6) = dxpix datmax = maxval(datpix(1:npixx,1:npixy)) datmin = minval(datpix(1:npixx,1:npixy)) print*,'min,max datpix = ',datmin,datmax datpix(1:npixx,1:npixy) = datpix(1:npixx,1:npixy) - 0.5*(datmax + datmin) datmax = maxval(datpix(1:npixx,1:npixy)) datmin = minval(datpix(1:npixx,1:npixy)) print*,'min,max datpix = ',datmin,datmax ! call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,datmin,datmax,trans) ! !--set contour levels ! dcont = (datmax-datmin)/real(nc+1) ! even contour levels do i=1,nc levels(i) = datmin + real(i)*dcont enddo ! !--plot contours (use pgcont if pgcons causes trouble) ! call pgcons(datpix(1:npixx,1:npixy),npixx,npixy,1,npixx,1,npixy,levels(1:nc),nc,trans) ! call pgenv(xmin,xmax,ymin,ymax,1,0) datmax = maxval(datpix1(1:npixx,1:npixy)) datmin = minval(datpix1(1:npixx,1:npixy)) print*,'min,max datpix1 = ',datmin,datmax ! call pgimag(datpix1,ipixx,ipixy,1,npixx,1,npixy,datmin,datmax,trans) ! call pgcons(datpix1(1:npixx,1:npixy),npixx,npixy,1,npixx,1,npixy,levels(1:nc),nc,trans) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,datpix1(1:npixx,1:npixy),err) print*,'average error in stream line calculation = ',err if (npixx.eq.400 .and. npixy.eq.400) then if (err < 0.00019) then print*,'PASSED: error within limits' else print*,'FAILED: error too large!' endif else print*,'setup different to usual one' endif call pgend print "(70('-'))" contains real function func_vecx(xi,yi) implicit none real :: xi,yi func_vecx = -sin(2.*pi*yi) end function func_vecx real function func_vecy(xi,yi) implicit none real :: xi,yi func_vecy = sin(4.*pi*xi) end function func_vecy real function func_stream(xi,yi) implicit none real :: xi,yi func_stream = 0.5/pi*(cos(2.*pi*yi) + 0.5*cos(4.*pi*xi)) end function func_stream !---------------- ! dipole !---------------- real function func_vecx_dipole(xi,yi) implicit none real :: xi,yi real, parameter :: Bdipole = 1.0, Rdipole = 0.3, eps=0.3 func_vecx_dipole = 3.*Bdipole*Rdipole**3*(Rdipole + xi)*yi/ & sqrt((Rdipole + xi)**2 + yi**2 + (eps*Rdipole)**2)**5 end function func_vecx_dipole real function func_vecy_dipole(xi,yi) implicit none real :: xi,yi real, parameter :: Bdipole = 1.0, Rdipole = 0.3, eps=0.3 func_vecy_dipole = Bdipole*Rdipole**3/ & sqrt((Rdipole + xi)**2 + yi**2 + (eps*Rdipole)**2)**3 end function func_vecy_dipole real function func_stream_dipole(xi,yi) implicit none real :: xi,yi real, parameter :: Bdipole = 1.0, Rdipole = 0.3, eps=0.3 func_stream_dipole = -Bdipole*Rdipole**3*(Rdipole + xi)/ & sqrt((Rdipole + xi)**2 + yi**2 + (eps*Rdipole)**2)**3 end function func_stream_dipole subroutine geterr(datpix,npixx,npixy,datexact,err) implicit none integer, intent(in) :: npixx,npixy real, dimension(:,:), intent(in) :: datpix real, dimension(:,:), intent(in) :: datexact real, intent(out) :: err integer :: icalc,j,i real :: errij err = 0. icalc = 0 do j=1,npixy do i=1,npixx icalc = icalc + 1 errij = abs(datpix(i,j)-datexact(i,j)) err = err + errij enddo enddo if (icalc.le.0) then print*,'cannot calculate error => npix too small' err = -1.0 else err = err/(icalc*maxval(datexact)) endif end subroutine geterr end program test_fieldlines splash/tests/test_interpolate3D.f90000755 000770 000000 00000026634 11423747565 020242 0ustar00dpricewheel000000 000000 ! !--unit test for interpolation routines ! program test_interpolation use projections3D use xsections3D implicit none integer, parameter :: idimx = 100 integer, parameter :: idim = idimx**3 integer, parameter :: ipixx = 1000, ipixy = 1000 integer :: npart,npartx,nparty,npartz integer :: npixx, npixy,i real, parameter :: errtol = 1.e-7 real, dimension(idim) :: x,y,z,pmass,h,rho real, dimension(idim) :: dat,weight integer, dimension(idim) :: itype real, dimension(ipixx,ipixy) :: datpix real, dimension(0:maxcoltable) :: q,w real :: xmin,xmax,ymin,ymax,zmin,zmax real :: columndens,dxpix,err,dens,datmax real :: trans(6) logical :: ifastrender,normalise xmin = -0.5 xmax = 0.5 ymin = -0.5 ymax = 0.5 zmin = -0.5 zmax = 0.5 itype = 0 ifastrender = .true. print*,'accelerated rendering = ',ifastrender call pgopen('?') ! call pgenv(xmin,xmax,ymin,ymax,0,0) ! call pglabel('x','y',' ') ! call pgpt(npart,x,y,1) ! call pgenv(xmin,xmax,ymin,ymax,0,0) ! call pglabel('y','z',' ') ! call pgpt(npart,y,z,1) ! call pgenv(xmin,xmax,ymin,ymax,0,0) ! call pglabel('x','z',' ') ! call pgpt(npart,x,z,1) ! !--setup integrated kernel table ! call setup_integratedkernel ! !--check value of the integration at q=zero (can do this analytically) ! if (abs(coltable(0)-1.5/3.1415926536).lt.errtol) then print*,'CENTRAL KERNEL TABLE OK' else print*,'coltable(0) = ',coltable(0),' should be ',2.*0.75/3.1415926536 print*,'error = ',abs(coltable(0)-1.5/3.1415926536) print*,'ERROR: CENTRAL INTEGRATED KERNEL VALUE WRONG' endif ! !--plot integrated kernel ! call pgenv(0.,2.,0.,coltable(0)*1.1,0,0) call pglabel('r','int W',' ') print*,'radkernel = ',radkernel do i=0,50 q(i) = i*radkernel/50. !print*,q(i) w(i) = wfromtable(q(i)*q(i)) enddo call pgsci(3) call pgline(50,q,w) ! do i=1,maxcoltable ! q(i) = sqrt((i-1)*radkernel*radkernel*dmaxcoltable) ! enddo ! call pgsci(2) ! call pgline(maxcoltable,q,coltable) call pgsci(1) !call pgpage ! !--setup one particle ! print*,'SINGLE PARTICLE TEST' npart = 1 npixx = 10 npixy = 10 x(1) = 0.5*(xmin + xmax) y(1) = 0.5*(ymin + ymax) z(1) = 0.5*(zmin + zmax) rho(1) = 1.0 pmass(1) = 2.0 h(1) = 0.35*xmax weight(1) = 1./1.5**3 dat(1) = rho(1) dxpix = (xmax-xmin)/real(npixx) normalise = .false. datpix = 0. call interpolate3D_projection(x(1:npart),y(1:npart),z(1:npart),h(1:npart), & weight(1:npart),dat(1:npart),itype(1:npart),npart,xmin,ymin, & datpix(1:npixx,1:npixy),npixx,npixy,dxpix,dxpix,normalise,0.,0.,.false.) call pgenv(xmin,xmax,ymin,ymax,1,0) trans = 0. trans(1) = xmin - 0.5*dxpix trans(2) = dxpix trans(4) = ymin - 0.5*dxpix trans(6) = dxpix datmax = maxval(datpix(1:npixx,1:npixy)) print*,'max datpix = ',datmax,maxloc(datpix(1:npixx,1:npixy)) if (abs(datmax-0.035367373).gt.errtol) then print*,'FAILED: central maximum wrong, error = ',abs(datmax-0.035367373) else print*,'OK: central maximum seems fine' endif call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,0.0,datmax,trans) print*,'TEST WITH ACCELERATION' call interpolate3D_projection(x(1:npart),y(1:npart),z(1:npart),h(1:npart), & weight(1:npart),dat(1:npart),itype(1:npart),npart,xmin,ymin, & datpix(1:npixx,1:npixy),npixx,npixy,dxpix,dxpix,normalise,0.,0.,.true.) call pgenv(xmin,xmax,ymin,ymax,1,0) trans = 0. trans(1) = xmin - 0.5*dxpix trans(2) = dxpix trans(4) = ymin - 0.5*dxpix trans(6) = dxpix datmax = maxval(datpix(1:npixx,1:npixy)) print*,'max datpix = ',datmax,maxloc(datpix(1:npixx,1:npixy)) if (abs(datmax-0.035367373).gt.errtol) then print*,'FAILED: central maximum wrong, error = ',abs(datmax-0.035367373) else print*,'OK: central maximum seems fine' endif call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,0.0,datmax,trans) ! !--setup two overlapping particles ! print*,'TWO PARTICLE TEST' npart = 2 npixx = 1000 npixy = 1000 x(1) = -0.25 x(2) = 0.25 y(2) = 0.5*(ymin + ymax) z(2) = 0.5*(zmin + zmax) rho(2) = 1.0 pmass(2) = 2.0 h(1:2) = 0.5*xmax weight(2) = 1./1.5**3 dat(2) = rho(2) dxpix = (xmax-xmin)/real(npixx) call interpolate3D_projection(x(1:npart),y(1:npart),z(1:npart),h(1:npart), & weight(1:npart),dat(1:npart),itype(1:npart),npart,xmin,ymin, & datpix(1:npixx,1:npixy),npixx,npixy,dxpix,dxpix,normalise,0.,0.,ifastrender) call pgenv(xmin,xmax,ymin,ymax,1,0) trans = 0. trans(1) = xmin - 0.5*dxpix trans(2) = dxpix trans(4) = ymin - 0.5*dxpix trans(6) = dxpix datmax = maxval(datpix(1:npixx,1:npixy)) print*,'max datpix = ',datmax,maxloc(datpix(1:npixx,1:npixy)) !!print*,'datpix = ',datpix(1:npixx,1:npixy) call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,0.0,datmax,trans) ! !--set up a cubic lattice of particles ! print*,'NORMAL LATTICE TEST' npartx = 50 nparty = 50 npartz = 50 npart = npartx*nparty*npartz npixx = 500 npixy = 500 dxpix = (xmax-xmin)/real(npixx) call setgrid(npartx,nparty,npartz,x,y,z,pmass,rho,h,weight,xmin,xmax,ymin,ymax,zmin,zmax) ! !--now call interpolation routine to pixels ! call interpolate3D_projection(x(1:npart),y(1:npart),z(1:npart),h(1:npart), & weight(1:npart),dat(1:npart),itype(1:npart),npart,xmin,ymin, & datpix(1:npixx,1:npixy),npixx,npixy,dxpix,dxpix,normalise,0.,0.,ifastrender) ! !--check output ! dens = rho(1) columndens = dens*(zmax-zmin) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,columndens,err) print "(70('-'))" print*,'average error in column density interpolation = ',err if (err.gt.0.05) then print*,'FAILED: average error > usual' else print*,'OK: average error same as usual' endif call pgenv(xmin,xmax,ymin,ymax,0,0) ! call pgpixl(datpix,ipixx,ipixy,1,npixx,1,npixy,xmin,xmax,ymin,ymax) trans = 0. trans(1) = xmin - 0.5*dxpix trans(2) = dxpix trans(4) = ymin - 0.5*dxpix trans(6) = dxpix call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,0.0,1.0,trans) ! !--NORMALISED VERSION OF ABOVE ! normalise = .true. call interpolate3D_projection(x(1:npart),y(1:npart),z(1:npart),h(1:npart), & weight(1:npart),dat(1:npart),itype(1:npart),npart,xmin,ymin, & datpix(1:npixx,1:npixy),npixx,npixy,dxpix,dxpix,normalise,0.,0.,ifastrender) ! !--check output ! dens = rho(1) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,dens,err) print "(70('-'))" print*,'average error in interpolation = ',err print*,' dens = ',dens,' datpix = ',datpix(1:10,1:10) if (err.gt.0.05) then print*,'FAILED: average error > usual' else print*,'OK: average error same as usual' endif call pgenv(xmin,xmax,ymin,ymax,0,0) ! call pgpixl(datpix,ipixx,ipixy,1,npixx,1,npixy,xmin,xmax,ymin,ymax) trans = 0. trans(1) = xmin - 0.5*dxpix trans(2) = dxpix trans(4) = ymin - 0.5*dxpix trans(6) = dxpix call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,0.0,1.0,trans) ! !--take cross section at midplane and check density ! print "(70('-'))" call interpolate3D_fastxsec(x(1:npart),y(1:npart),z(1:npart), & h(1:npart),weight(1:npart),dat(1:npart),itype(1:npart),npart,& xmin,ymin,0.0,datpix(1:npixx,1:npixy),npixx,npixy,dxpix,.false.) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,dens,err) print*,'average error in non-normalised xsec interpolation = ',err print "(70('-'))" call pgenv(xmin,xmax,ymin,ymax,0,0) ! call pgpixl(datpix,ipixx,ipixy,1,npixx,1,npixy,xmin,xmax,ymin,ymax) ! trans = 0. ! trans(1) = xmin - 0.5*dxpix ! trans(2) = dxpix ! trans(4) = ymin - 0.5*dxpix ! trans(6) = dxpix call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,0.0,1.0,trans) ! call pgend ! !--take normalised cross section at midplane and check density ! call interpolate3D_fastxsec(x(1:npart),y(1:npart),z(1:npart), & h(1:npart),weight(1:npart),dat(1:npart),itype(1:npart),npart,& xmin,ymin,0.0,datpix(1:npixx,1:npixy),npixx,npixy,dxpix,.true.) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,dens,err) print*,'average error in normalised xsec interpolation = ',err call pgenv(xmin,xmax,ymin,ymax,0,0) call pgimag(datpix,ipixx,ipixy,1,npixx,1,npixy,0.0,1.0,trans) print*,'closing PGPLOT' call pgend print "(70('-'))" print*,'SPEED CHECKS...' normalise = .true. npixx = 1 npixy = 1 npartx = idimx nparty = idimx npartz = idimx npart = npartx*nparty*npartz call setgrid(npartx,nparty,npartz,x,y,z,pmass,rho,h,weight,xmin,xmax,ymin,ymax,zmin,zmax) dxpix = (xmax-xmin)/real(npixx) call interpolate3D_projection(x(1:npart),y(1:npart),z(1:npart),h(1:npart), & weight(1:npart),dat(1:npart),itype(1:npart),npart,xmin,ymin, & datpix(1:npixx,1:npixy),npixx,npixy,dxpix,dxpix,normalise,0.,0.,ifastrender) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,columndens,err) print*,'average error in projection = ',err npixx = 1000 npixy = 1000 npartx = 2 nparty = 2 npartz = 2 npart = npartx*nparty*npartz call setgrid(npartx,nparty,npartz,x,y,z,pmass,rho,h,weight,xmin,xmax,ymin,ymax,zmin,zmax) dxpix = (xmax-xmin)/real(npixx) call interpolate3D_projection(x(1:npart),y(1:npart),z(1:npart),h(1:npart), & weight(1:npart),dat(1:npart),itype(1:npart),npart,xmin,ymin, & datpix(1:npixx,1:npixy),npixx,npixy,dxpix,dxpix,normalise,0.,0.,ifastrender) call geterr(datpix(1:npixx,1:npixy),npixx,npixy,columndens,err) print*,'average error in projection = ',err contains subroutine setgrid(npartx,nparty,npartz,x,y,z,pmass,rho,h,weight,xmin,xmax,ymin,ymax,zmin,zmax) implicit none integer , intent(in) :: npartx,nparty,npartz real, dimension(:), intent(out) :: x,y,z,pmass,rho,h,weight real, intent(in) :: xmin,xmax,ymin,ymax,zmin,zmax integer :: ipart,k,j,i real :: dx,dy,dz,ypos,zpos real :: totmass,massp,vol,dens,h0 dz = (zmax-zmin)/real(npartz - 1) dy = (ymax-ymin)/real(nparty - 1) dx = (xmax-xmin)/real(npartx - 1) ipart = 0 do k=1,npartz zpos = zmin + (k-1)*dz do j=1,nparty ypos = ymin + (j-1)*dy do i=1,npartx ipart = ipart + 1 x(ipart) = xmin + (i-1)*dx y(ipart) = ypos z(ipart) = zpos ! print*,ipart,'x,y,z=',x(ipart),y(ipart),z(ipart) enddo enddo enddo npart = npartx*nparty*npartz ! !--set other properties ! totmass = 3.1415926536 massp = totmass/real(npart) vol = (xmax-xmin)*(ymax-ymin)*(zmax-zmin) dens = totmass/vol h0 = 1.5*(massp/dens)**(1./3) print*,' testing ',npart,' particles in a cube configuration' print*,' dx = ',dx,' dy = ',dy,' dz = ',dz print*,' mass = ',massp,' dens = ',dens,' h = ',h0 print*,' approx density = ',massp/(dx*dy*dz) do i = 1,npart pmass(i) = massp rho(i) = dens h(i) = h0 dat(i) = rho(i) weight(i) = pmass(i)/(rho(i)*h(i)**3) enddo end subroutine setgrid subroutine geterr(datpix,npixx,npixy,datexact,err) implicit none integer, intent(in) :: npixx,npixy real, dimension(:,:), intent(in) :: datpix real, intent(in) :: datexact real, intent(out) :: err integer :: icalc,j,i real :: erri err = 0. icalc = 0 do j=2,npixy-1 do i=2,npixx-1 icalc = icalc + 1 erri = abs(datpix(i,j)-datexact)/datexact err = err + erri !if (erri.gt.0.05) print*,i,j,' xsec dens = ',datpix(i,j),' should be ',dens enddo enddo if (icalc.le.0) then print*,'cannot calculate error => npix too small' err = -1.0 else err = err/real(icalc) endif end subroutine geterr end program test_interpolation splash/src/adjust_data.f90000644 000770 000000 00000024473 12307565255 016366 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module adjustdata implicit none contains !---------------------------------------------------- ! ! amend data after the data read based on ! various environment variable settings ! ! must be called AFTER the data has been read ! but BEFORE rescaling to physical units is applied ! !---------------------------------------------------- subroutine adjust_data_codeunits use system_utils, only:renvironment,envlist,ienvironment,lenvironment use labels, only:ih,ix,ivx,label,get_sink_type,ipmass use settings_data, only:ncolumns,ndimV,icoords,ndim,debugmode,ntypes,iverbose use particle_data, only:dat,npartoftype,iamtype use geometry, only:labelcoord use filenames, only:ifileopen,nstepsinfile use part_utils, only:locate_first_two_of_type,locate_nth_particle_of_type,get_binary implicit none real :: hmin,dphi real, dimension(3) :: vsink,xyzsink,x0,v0 character(len=20), dimension(3) :: list integer :: i,j,nlist,nerr,ierr,isink,isinkpos,itype integer :: isink1,isink2,ntot logical :: centreonsink ! !--environment variable setting to enforce a minimum h ! if (ih.gt.0 .and. ih.le.ncolumns) then hmin = renvironment('SPLASH_HMIN_CODEUNITS',errval=-1.) if (hmin.gt.0.) then if (.not.allocated(dat)) then print*,' INTERNAL ERROR: dat not allocated in adjust_data_codeunits' return endif print "(/,a,es10.3)",' >> SETTING MINIMUM H TO ',hmin where (dat(:,ih,:) < hmin .and. dat(:,ih,:).gt.0.) dat(:,ih,:) = hmin end where endif endif ! !--environment variable setting to subtract a mean velocity ! if (ivx.gt.0 .and. ivx+ndimV-1.le.ncolumns) then call envlist('SPLASH_VZERO_CODEUNITS',nlist,list) nerr = 0 if (nlist.gt.0 .and. nlist.lt.ndimV) then print "(/,2(a,i1))",' >> ERROR in SPLASH_VZERO_CODEUNITS setting: number of components = ',nlist,', needs to be ',ndimV nerr = 1 elseif (nlist.gt.0) then if (nlist.gt.ndimV) print "(a,i1,a,i1)",' >> WARNING! SPLASH_VZERO_CODEUNITS setting has ',nlist, & ' components: using only first ',ndimV nerr = 0 do i=1,ndimV read(list(i),*,iostat=ierr) v0(i) if (ierr.ne.0) then print "(a)",' >> ERROR reading v'//trim(labelcoord(i,icoords))//& ' component from SPLASH_VZERO_CODEUNITS setting' nerr = ierr endif enddo if (nerr.eq.0) then print "(a)",' >> SUBTRACTING MEAN VELOCITY (from SPLASH_VZERO_CODEUNITS setting):' if (.not.allocated(dat) .or. size(dat(1,:,1)).lt.ivx+ndimV-1) then print*,' INTERNAL ERROR: dat not allocated in adjust_data_codeunits' return endif do i=1,ndimV print "(4x,a,es10.3)",trim(label(ivx+i-1))//' = '//trim(label(ivx+i-1))//' - ',v0(i) dat(:,ivx+i-1,:) = dat(:,ivx+i-1,:) - v0(i) enddo endif endif if (nerr.ne.0) then print "(4x,a)",'SPLASH_VZERO_CODEUNITS setting not used' endif endif if (ndim.gt.0) then ! !--environment variable to corotate with first two sink particles ! if (lenvironment('SPLASH_COROTATE')) then itype = get_sink_type(ntypes) if (itype.gt.0) then if (all(npartoftype(itype,:).lt.2)) then print "(a)",' ERROR: SPLASH_COROTATE set but less than 2 sink particles' else if (iverbose.ge.1) print* print "(a,i3,a)",' :: COROTATING FRAME WITH FIRST 2 SINKS from SPLASH_COROTATE setting' do j=1,nstepsinfile(ifileopen) ! find first two sink particles in the data call locate_first_two_of_type(isink1,isink2,itype,iamtype(:,j),npartoftype(:,j),ntot) ! get properties of the binary call get_binary(isink1,isink2,dat(:,:,j),x0,v0,dphi,ndim,ndimV,ncolumns,ix,ivx,ipmass,iverbose,ierr) ! rotate all the particles into this frame if (ierr.eq.0) call rotate_particles(dat(:,:,j),ntot,dphi,x0(1:ndim),ndim,ndimV,v0) enddo endif else print "(a,/,a)",' ERROR: SPLASH_COROTATE set but could not determine type ', & ' corresponding to sink particles' endif endif ! !--environment variable setting to centre plots on a selected sink particle ! !--can specify either just "true" for sink #1, or specify a number for a particular sink centreonsink = lenvironment('SPLASH_CENTRE_ON_SINK') .or. lenvironment('SPLASH_CENTER_ON_SINK') isink = max(ienvironment('SPLASH_CENTRE_ON_SINK'),ienvironment('SPLASH_CENTER_ON_SINK')) if (isink.gt.0 .or. centreonsink) then if (isink.eq.0) isink = 1 itype = get_sink_type(ntypes) if (itype.gt.0) then if (all(npartoftype(itype,:).lt.isink)) then print "(a,i10,a)",' ERROR: SPLASH_CENTRE_ON_SINK = ',isink,' but not enough sink particles' else if (iverbose.ge.1) print* if (isink.lt.10) then print "(a,i1,a)",' :: CENTREING ON SINK ',isink,' from SPLASH_CENTRE_ON_SINK setting' else print "(a,i3,a)",' :: CENTREING ON SINK ',isink,' from SPLASH_CENTRE_ON_SINK setting' endif do j=1,nstepsinfile(ifileopen) call locate_nth_particle_of_type(isink,isinkpos,itype,iamtype(:,j),npartoftype(:,j),ntot) if (isinkpos.eq.0) then print "(a)",' ERROR: could not locate sink particle in dat array' else if (debugmode) print*,' SINK POSITION = ',isinkpos,npartoftype(1:itype,j) !--make positions relative to sink particle xyzsink(1:ndim) = dat(isinkpos,ix(1:ndim),j) if (iverbose.ge.1) print "(a,3(1x,es10.3))",' :: sink position =',xyzsink(1:ndim) !--make velocities relative to sink particle if (ivx.gt.0 .and. ivx+ndimV-1.le.ncolumns) then vsink(1:ndimV) = dat(isinkpos,ivx:ivx+ndimV-1,j) if (iverbose.ge.1) print "(a,3(1x,es10.3))",' :: sink velocity =',vsink(1:ndimV) else vsink = 0. endif call shift_particles(dat(:,:,j),ntot,ndim,ndimV,ncolumns,xyzsink,vsink) endif enddo endif else print "(a,/,a)",' ERROR: SPLASH_CENTRE_ON_SINK set but could not determine type ', & ' corresponding to sink particles' endif endif endif end subroutine adjust_data_codeunits !----------------------------------------------------------------- ! routine to rotate particles with a given cylindrical angle dphi !----------------------------------------------------------------- pure subroutine rotate_particles(dat,np,dphi,x0,ndim,ndimV,v0) use labels, only:ix,ivx integer, intent(in) :: np,ndim,ndimV real, intent(in) :: dphi real, dimension(:,:), intent(inout) :: dat real, dimension(ndim), intent(in) :: x0 real, dimension(ndimV), intent(in) :: v0 real, dimension(ndim) :: xi real, dimension(ndimV) :: vi real :: r,phi,xnew,ynew,cosp,sinp,vr,vphi integer :: i !--rotate positions do i=1,np xi = dat(i,ix(1:ndim)) - x0(1:ndim) r = sqrt(xi(1)**2 + xi(2)**2) phi = atan2(xi(2),xi(1)) phi = phi + dphi cosp = cos(phi) sinp = sin(phi) xnew = r*cosp ynew = r*sinp dat(i,ix(1)) = xnew dat(i,ix(2)) = ynew !--rotate velocities, if present if (ivx > 0) then vi = dat(i,ivx:ivx+ndimV-1) - v0 vr = vi(1)*xi(1)/r + vi(2)*xi(2)/r vphi = vi(1)*(-xi(2)/r) + vi(2)*xi(1)/r dat(i,ivx) = vr*cosp - vphi*sinp dat(i,ivx+1) = vr*sinp + vphi*cosp endif enddo end subroutine rotate_particles !------------------------------------------------------ ! routine to shift particle positions and velocities ! to new location !------------------------------------------------------ pure subroutine shift_particles(dat,np,ndim,ndimV,ncol,x0,v0) integer, intent(in) :: np,ndim,ndimV,ncol real, dimension(:,:), intent(inout) :: dat real, dimension(ndim), intent(in) :: x0 real, dimension(ndimV), intent(in) :: v0 call shift_positions(dat,np,ndim,x0) call shift_velocities(dat,np,ndimV,ncol,v0) end subroutine shift_particles !------------------------------------------------------ ! routine to shift particle positions to new location !------------------------------------------------------ pure subroutine shift_positions(dat,np,ndim,x0) use labels, only:ix integer, intent(in) :: np,ndim real, dimension(:,:), intent(inout) :: dat real, dimension(ndim), intent(in) :: x0 integer :: icol !--shift positions do icol=1,ndim dat(1:np,ix(icol)) = dat(1:np,ix(icol)) - x0(icol) enddo end subroutine shift_positions !------------------------------------------------------ ! routine to shift particle velocities by constant !------------------------------------------------------ pure subroutine shift_velocities(dat,np,ndimV,ncol,v0) use labels, only:ivx integer, intent(in) :: np,ndimV,ncol real, dimension(:,:), intent(inout) :: dat real, dimension(ndimV), intent(in) :: v0 integer :: icol !--make velocities relative to sink particle if (ivx > 0 .and. ivx+ndimV-1 <= ncol) then do icol=1,ndimV dat(1:np,ivx+icol-1) = dat(1:np,ivx+icol-1) - v0(icol) enddo endif end subroutine shift_velocities end module adjustdata splash/src/allocate.f90000644 000770 000000 00000022041 12312026643 015641 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module mem_allocation implicit none contains !---------------------------------------------------------------------------- ! ! memory allocation/reallocation for main data arrays ! ! the global parameters maxpart, maxstep and maxcol are set to ! the dimensions allocated ! !---------------------------------------------------------------------------- subroutine alloc(npartin,nstep,ncolumnsin,mixedtypes) use particle_data implicit none integer, intent(in) :: npartin,nstep,ncolumnsin logical, intent(in), optional :: mixedtypes integer :: maxpartold,maxstepold,maxcolold integer :: ierr,ncolumns logical :: reallocate,reallocate_part,reallocate_step,reallocate_itype integer, dimension(:), allocatable :: icolourmetemp integer(kind=int1), dimension(:,:), allocatable :: iamtypetemp integer, dimension(:,:), allocatable :: npartoftypetemp real, dimension(:,:), allocatable :: masstypetemp real, dimension(:), allocatable :: timetemp, gammatemp real, dimension(:,:,:), allocatable :: dattemp ! !--check for errors in input ! if (npartin.le.0) then print*,'allocate: error in input, npartin = ',npartin return endif if (nstep.le.0) then print*,'allocate: error in input, nstep = ',nstep return endif if (ncolumnsin.lt.0) then print*,'allocate: error in input, ncolumns = ',ncolumnsin return elseif (ncolumnsin.eq.0) then print*,'WARNING: allocate: ncolumns = 0 in input' endif !--do nothing if array sizes are the same if (npartin.eq.maxpart .and. ncolumnsin.eq.maxcol .and. nstep.eq.maxstep) then return endif ! !--save array sizes ! if (npartin.lt.maxpart) print "(a)",' WARNING: # particles < previous in allocate' if (nstep.lt.maxstep) print "(a)",' WARNING: # steps < previous in allocate' !--at the moment ncolumns cannot be decreased (due to calc_quantities) if (ncolumnsin.lt.maxcol) then ncolumns = maxcol !!print "(a)",' WARNING: # columns < previous in allocate' else ncolumns = ncolumnsin endif maxpartold = min(maxpart,npartin) maxstepold = min(maxstep,nstep) maxcolold = min(maxcol,ncolumns) reallocate = .false. reallocate_part = .false. reallocate_step = .false. reallocate_itype = .false. ! !--if re-allocating, copy arrays to temporary versions ! ierr = 0 if (allocated(dat)) then reallocate = .true. if (maxpart.ne.npartin) reallocate_part = .true. if (maxstep.ne.nstep) reallocate_step = .true. print 10,'> reallocating memory:',npartin,nstep,ncolumns 10 format (a,' parts = ',i10,' steps = ',i6,' cols = ',i4) allocate(dattemp(maxpartold,maxcolold,maxstepold), stat=ierr) if (ierr /= 0) stop 'error allocating memory (dattemp)' if (reallocate_part) then allocate(icolourmetemp(maxpartold),stat=ierr) if (ierr /= 0) stop 'error allocating memory (icolourmetemp)' icolourmetemp(1:maxpartold) = icolourme(1:maxpartold) deallocate(icolourme) endif dattemp = dat deallocate(dat) if (allocated(iamtype)) then ! should always be true !--if iamtype has meaningful contents and reallocation is necessary reallocate_itype = (reallocate_part .or. reallocate_step) .and. (size(iamtype(:,1)).eq.maxpartold) if (reallocate_itype) then allocate(iamtypetemp(maxpartold,maxstepold), stat=ierr) if (ierr /= 0) stop 'error allocating memory (iamtypetemp)' iamtypetemp(1:maxpartold,1:maxstepold) = iamtype(1:maxpartold,1:maxstepold) deallocate(iamtype) elseif (present(mixedtypes)) then !--if iamtype has size 1 or 0 but should be allocated here, ! deallocate so we can give it correct size if (mixedtypes .and. size(iamtype(:,1)).lt.maxpart) deallocate(iamtype) endif endif if (reallocate_step) then allocate(npartoftypetemp(maxparttypes,maxstep),stat=ierr) if (ierr /= 0) stop 'error allocating memory (npartoftypetemp)' npartoftypetemp = npartoftype deallocate(npartoftype) allocate(masstypetemp(maxparttypes,maxstep),stat=ierr) if (ierr /= 0) stop 'error allocating memory (npartoftypetemp)' masstypetemp = masstype deallocate(masstype) allocate(timetemp(maxstep),gammatemp(maxstep),stat=ierr) if (ierr /= 0) stop 'error allocating memory (timetemp,gammatemp)' timetemp = time gammatemp = gamma deallocate(time,gamma) endif else print 10,'> allocating memory:',npartin,nstep,ncolumns maxpart = npartin maxstep = nstep maxcol = ncolumns endif maxpart = npartin maxstep = nstep maxcol = ncolumns ! !--main data array ! allocate(dat(maxpart,maxcol,maxstep), stat=ierr) if (ierr /= 0) then print*,' parts = ',maxpart,' columns = ',maxcol,' steps = ',maxstep stop 'error allocating memory for dat array' endif if (reallocate) then dat(1:maxpartold,1:maxcolold,1:maxstepold) = dattemp(1:maxpartold,1:maxcolold,1:maxstepold) deallocate(dattemp) else dat = 0. endif ! !--type array if necessary ! if (present(mixedtypes)) then if (mixedtypes .and. .not.allocated(iamtype)) then allocate(iamtype(maxpart,maxstep), stat=ierr) if (ierr /= 0) stop 'error allocating memory for type array' iamtype = 1 !--copy contents if reallocating if (reallocate_itype) then iamtype(1:maxpartold,1:maxstepold) = iamtypetemp(1:maxpartold,1:maxstepold) deallocate(iamtypetemp) endif elseif (.not.mixedtypes) then !--if called with mixedtypes explictly false, deallocate itype array if (allocated(iamtype)) deallocate(iamtype) endif elseif (reallocate_itype) then !--if called without mixedtypes, preserve contents of itype array allocate(iamtype(maxpart,maxstep), stat=ierr) if (ierr /= 0) stop 'error allocating memory for type array' iamtype = 1 iamtype(1:maxpartold,1:maxstepold) = iamtypetemp(1:maxpartold,1:maxstepold) deallocate(iamtypetemp) endif !--make sure iamtype is always allocated for safety, just with size=1 if not used if (.not.allocated(iamtype)) then allocate(iamtype(1,maxstep),stat=ierr) if (ierr /= 0) stop 'error allocating memory for type array (1)' endif ! !--particle arrays ! if (.not.allocated(icolourme) .or. reallocate_part) then allocate(icolourme(maxpart),stat=ierr) if (ierr /= 0) stop 'error allocating memory for icolourme array' icolourme = 1 if (reallocate_part) then icolourme(1:maxpartold) = icolourmetemp(1:maxpartold) deallocate(icolourmetemp) endif endif ! !--other arrays ! if (.not.allocated(npartoftype)) then allocate(npartoftype(maxparttypes,maxstep),stat=ierr) if (ierr /= 0) stop 'error allocating memory for header arrays' allocate(masstype(maxparttypes,maxstep),stat=ierr) if (ierr /= 0) stop 'error allocating memory for header arrays' allocate(time(maxstep),gamma(maxstep),stat=ierr) if (ierr /= 0) stop 'error allocating memory for header arrays' npartoftype = 0 masstype = 0. time = time_not_read_val ! initialise like this so we know if has not been read gamma = 0. if (reallocate_step) then npartoftype(:,1:maxstepold) = npartoftypetemp(:,1:maxstepold) masstype(:,1:maxstepold) = masstypetemp(:,1:maxstepold) time(1:maxstepold) = timetemp(1:maxstepold) gamma(1:maxstepold) = gammatemp(1:maxstepold) deallocate(npartoftypetemp,masstypetemp) deallocate(timetemp,gammatemp) endif endif return end subroutine alloc !----------------------------------------- ! ! deallocation of remaining memory ! (for tidiness - not strictly necessary) ! !----------------------------------------- subroutine deallocate_all use particle_data, only:dat,icolourme,iamtype,npartoftype,masstype,time,gamma implicit none if (allocated(dat)) deallocate(dat) if (allocated(icolourme)) deallocate(icolourme) if (allocated(iamtype)) deallocate(iamtype) if (allocated(npartoftype)) deallocate(npartoftype) if (allocated(masstype)) deallocate(masstype) if (allocated(time)) deallocate(time) if (allocated(gamma)) deallocate(gamma) return end subroutine deallocate_all end module mem_allocation splash/src/analysis.f90000644 000770 000000 00000116616 12560122726 015720 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------- ! module implementing the ability to use SPLASH to produce ! evolution files from a sequence of SPH dump files ! (ie. in order to produce plots of certain quantities vs time) ! Command is "splash calc X" where X is analysis type. !------------------------------------------------------------------- module analysis public :: isanalysis,open_analysis,close_analysis,write_analysis private integer, private, parameter :: iunit = 89 integer, private, parameter :: maxlevels = 20 ! ! default settings for the density thresholds for massaboverho output ! integer, private :: nlevels,nfilesread real, dimension(maxlevels), private :: rholevels character(len=64), private :: fileout real, dimension(:,:), allocatable :: datmean,datvar contains !----------------------------------------------------------------- ! utility to check if the choice of analysis type is valid ! and if not, to print the available options !----------------------------------------------------------------- logical function isanalysis(string,noprint) implicit none character(len=*), intent(in) :: string logical, intent(in), optional :: noprint logical :: doprint isanalysis = .false. select case(trim(string)) case('energies','energy') isanalysis = .true. case('massaboverho') isanalysis = .true. case('max','maxvals') isanalysis = .true. case('min','minvals') isanalysis = .true. case('diff','diffvals') isanalysis = .true. case('delta','deltavals') isanalysis = .true. case('amp','ampvals') isanalysis = .true. case('mean','meanvals') isanalysis = .true. case('rms','rmsvals') isanalysis = .true. case('vrms','vrmsvals','vwrms','rmsvw') isanalysis = .true. case('rhovar','rhomach') isanalysis = .true. case('kh') isanalysis = .true. case('timeaverage','timeav') isanalysis = .true. case('ratio') isanalysis = .true. end select if (present(noprint)) then doprint = .not.noprint else doprint = .true. endif if (.not.isanalysis .and. doprint) then print "(a)",' Analysis mode ("splash calc X dumpfiles") on a sequence of dump files: ' print "(a)",' splash calc energies : calculate KE,PE,total energy vs time' print "(a)",' output to file called ''energy.out''' print "(a)",' calc massaboverho : mass above a series of density thresholds vs time' print "(a)",' output to file called ''massaboverho.out''' ! print "(a)",' calc rhomach : density variance and RMS velocity dispersion vs. time' ! print "(a)",' output to file called ''rhomach.out''' print "(a)",' calc max : maximum of each column vs. time' print "(a)",' output to file called ''maxvals.out''' print "(a)",' calc min : minimum of each column vs. time' print "(a)",' output to file called ''minvals.out''' print "(a)",' calc diff : (max - min) of each column vs. time' print "(a)",' output to file called ''diffvals.out''' print "(a)",' calc amp : 0.5*(max - min) of each column vs. time' print "(a)",' output to file called ''ampvals.out''' print "(a)",' calc delta : 0.5*(max - min)/mean of each column vs. time' print "(a)",' output to file called ''deltavals.out''' print "(a)",' calc mean : mean of each column vs. time' print "(a)",' output to file called ''meanvals.out''' print "(a)",' calc rms : (mass weighted) root mean square of each column vs. time' print "(a)",' output to file called ''rmsvals.out''' ! print "(a)",' calc vrms : volume weighted root mean square of each column vs. time' ! print "(a)",' output to file called ''rmsvals-vw.out''' print "(/,a)",' the above options all produce a small ascii file with one row per input file.' print "(a)",' the following option produces a file equivalent in size to one input file (in ascii format):' print "(/,a)",' calc timeaverage : time average of *all* entries for every particle' print "(a)",' output to file called ''time_average.out''' print "(/,a)",' calc ratio : ratio of *all* entries in each file compared to first' print "(a)",' output to file called ''ratio.out''' endif return end function isanalysis !---------------------------------------------------------------- ! open output file/ initialise quantities needed for analysis ! over all dump files !---------------------------------------------------------------- subroutine open_analysis(analysistype,required,ncolumns,ndim,ndimV) use labels, only:ix,ivx,iBfirst,iutherm,irho,ipmass,label use asciiutils, only:read_asciifile use filenames, only:rootname,nfiles,tagline use params, only:maxplot implicit none integer, intent(in) :: ncolumns,ndim,ndimV character(len=*), intent(in) :: analysistype logical, dimension(0:ncolumns), intent(out) :: required character(len=1170) :: headerline ! len=64 x 18 characters character(len=64) :: levelsfile character(len=40) :: fmtstring logical :: iexist,standardheader integer :: ierr,i ! !--the 'required' array is used by the data reads (where implemented) ! to determine whether or not we actually need to read a given column ! from the file -- if not it can be skipped, leading to a faster ! data read. Here we want to specify which columns are required ! for the analysis in question. ! print "(/,5('-'),a,/)",'> CALCULATING '//trim(analysistype)//' vs time for all dump files' required(:)=.false. headerline = ' ' standardheader = .false. select case(trim(analysistype)) case('energy','energies') ! !--for energies need to read particle mass, velocity, utherm and if present, ! magnetic field and density. The obvious limitation here is that we ! cannot calculate the potential energy unless it is dumped and labelled ! (which is not currently implemented). ! required(ivx:ivx+ndimV-1) = .true. required(iBfirst:iBfirst+ndimV-1) = .true. required(iutherm) = .true. required(ipmass) = .true. if (iBfirst.gt.0) required(irho) = .true. required(ix(1:ndim)) = .true. ! !--set filename and header line ! fileout = 'energy.out' write(headerline,"('#',8(1x,'[',i2.2,1x,a11,']',2x))") & 1,'time',2,'ekin',3,'etherm',4,'emag',5,'epot',6,'etot',7,'totmom',8,'totang' case('massaboverho') ! !--only need to read mass and density from dump files ! required(ipmass) = .true. required(irho) = .true. ! !--need a user-configurable way of setting the density thresholds: ! implemented by setting them in a file which is read here ! (a new one is created if it doesn't exist) ! levelsfile = 'massaboverho.levels' inquire(file=levelsfile,exist=iexist) if (iexist) then call read_asciifile(trim(levelsfile),nlevels,rholevels) print "(a)",' read '//trim(levelsfile)//':' do i=1,nlevels print "(a,i2,a,es9.2)",' level ',i,': rho > ',rholevels(i) enddo print* else print "(a)",' SPLASH ANALYSIS: levels file '//trim(levelsfile)//' not found' print "(a)",' creating one with default levels for mass > rho' print "(a)",' edit this file to set the density levels' open(unit=iunit+1,file=levelsfile,status='new',form='formatted',iostat=ierr) if (ierr /= 0) then stop 'ERROR creating levels file' else nlevels = 10 rholevels(1:nlevels) = (/1.e-20,1.e-19,1.e-18,1.e-17,1.e-16, & 1.e-15,1.e-14,1.e-13,1.e-12,1.e-11/) write(iunit+1,*) rholevels(1:nlevels) close(iunit+1) endif stop endif ! !--set filename and header line ! fileout = 'massaboverho.out' write(headerline,"('#',1x,'[',i2.2,1x,a12,']',1x,20('[',i2.2,1x,a4,es8.1,a1,']',1x))") & 1,'time',(i+1,'M(r>',rholevels(i),')',i=1,nlevels) case('max','maxvals') ! !--read all columns from dump file ! required(:) = .true. ! !--set filename and header line ! fileout = 'maxvals.out' standardheader = .true. case('min','minvals') required(:) = .true. fileout = 'minvals.out' standardheader = .true. case('diff','diffvals') required(:) = .true. fileout = 'diffvals.out' standardheader = .true. case('amp','ampvals') required(:) = .true. fileout = 'ampvals.out' standardheader = .true. case('delta','deltavals','deltas') required(:) = .true. fileout = 'deltavals.out' standardheader = .true. case('mean','meanvals') required(:) = .true. fileout = 'meanvals.out' standardheader = .true. case('rms','rmsvals') required(:) = .true. fileout = 'rmsvals.out' standardheader = .true. case('vrms','vrmsvals','vwrms','rmsvw') required(:) = .true. fileout = 'rmsvals-vw.out' standardheader = .true. case('rhovar','rhomach') ! !--read density, velocity info ! required(ipmass) = .true. required(irho) = .true. required(ivx:ivx+ndimV-1) = .true. ! !--set filename and header line ! fileout = 'rhomach.out' write(fmtstring,"('(''#'',1x,',i3,'(''['',i2.2,1x,a12,'']'',2x))')",iostat=ierr) 17 write(headerline,fmtstring) 1,'time',2,'rhomean(vw)',3,'rhomean(mw)',4,'varrho(vw)',5,'varrho(mw)',& 6,'stddevrho(vw)',7,'stddevrho(mw)',8,'rms v (vw)',9,'rms v (mw)',10,'b (vw)',11,'b (mw)',& 12,'s mean(vw)',13,'s mean(mw)',14,'s var(vw)',15,'s var(mw)',16,'s stddev(vw)',17,'s stddev(mw)' case('kh') ! !--read all columns from dump file ! required(irho) = .true. required(ivx:ivx+ndimV-1) = .true. ! !--set filename and header line ! fileout = 'kh.out' standardheader = .true. write(fmtstring,"('(''#'',1x,',i3,'(''['',i2.2,1x,a12,'']'',2x))')",iostat=ierr) 2 write(headerline,fmtstring) 1,'time',2,'max(ekiny)' case('timeaverage','timeav') ! !--read all columns from dump file ! required(:) = .true. ! !--set filename and header line ! fileout = 'time_average.out' if (ncolumns.gt.0) then write(fmtstring,"('(''#'',1x,',i3,'(''['',i2.2,1x,a12,'']''))')",iostat=ierr) 2*ncolumns write(headerline,fmtstring,iostat=ierr) (i,label(i)(1:12),i=1,ncolumns),& (ncolumns+i,'err'//label(i)(1:9),i=1,ncolumns) endif case('ratio') ! !--read all columns from dump file ! required(:) = .true. ! !--set filename and header line ! fileout = 'ratio.out' if (ncolumns.gt.0 .and. ncolumns.ne.maxplot) then write(fmtstring,"('(''#'',1x,',i3,'(''['',i2.2,1x,a12,'']''))')",iostat=ierr) 2*ncolumns write(headerline,fmtstring,iostat=ierr) (i,label(i)(1:12),i=1,ncolumns),& (ncolumns+i,'err'//label(i)(1:9),i=1,ncolumns) endif end select if (standardheader) then ! !--standard header is time in column 1, with an entry for each column following ! (this is to avoid repeated code above) ! write(fmtstring,"('(''#'',1x,',i3,'(''['',i2.2,1x,a12,'']'',2x))')",iostat=ierr) ncolumns+1 write(headerline,fmtstring) 1,'time',(i+1,label(i)(1:12),i=1,ncolumns) endif ! !--do not replace the file if it already exists ! inquire(file=trim(fileout),exist=iexist) if (iexist) then print "(2(a,/))",' ERROR: analysis file '//trim(fileout)//' already exists', & ' delete, move or rename this file and try again' stop endif ! !--open the file for output ! open(unit=iunit,file=trim(fileout),status='new',form='formatted',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR opening file '//trim(fileout)//' for output' stop endif print "(a)",' WRITING '//trim(analysistype)//' vs time to file '//trim(fileout) ! !--write header if the headerline is set ! (no header is written if headerline is blank) ! if (len_trim(headerline).gt.0) then write(iunit,"(a)") '# '//trim(tagline) write(iunit,"(a)") '# '//trim(fileout)//' produced using "splash calc '//trim(analysistype)// & '" on dump files '//trim(rootname(1))//'->'//trim(rootname(nfiles)) write(iunit,"(a)") '# use asplash -e '//trim(fileout)//' to plot the contents of this file ' write(iunit,"(a)") '#' write(iunit,"(a)") trim(headerline) endif nfilesread = 0 return end subroutine open_analysis !---------------------------------------------------------------- ! this is the routine which actually calculates the quantities ! required from each dump file and spits out a line to the ! analysis file. Called once for each dump file. !---------------------------------------------------------------- subroutine write_analysis(time,dat,ntot,ntypes,npartoftype,massoftype,iamtype,ncolumns,ndim,ndimV,analysistype) use labels, only:ix,ivx,iBfirst,iutherm,irho,ipmass,labeltype,label use params, only:int1,doub_prec,maxplot use asciiutils, only:ucase use system_utils, only:renvironment use settings_part, only:iplotpartoftype use particle_data, only:time_was_read use settings_data, only:xorigin,icoords,icoordsnew use geomutils, only:change_coords implicit none integer, intent(in) :: ntot,ntypes,ncolumns,ndim,ndimV integer, intent(in), dimension(:) :: npartoftype real, intent(in), dimension(:) :: massoftype integer(kind=int1), intent(in), dimension(:) :: iamtype real, intent(in) :: time real, intent(in), dimension(:,:) :: dat character(len=*), intent(in) :: analysistype real(kind=doub_prec), dimension(maxlevels) :: massaboverho integer :: itype,i,j,ierr,ntot1,ncol1,nused real(kind=doub_prec) :: ekin,emag,etherm,epot,etot,totmom,pmassi,totang real(kind=doub_prec) :: totvol,voli,rhoi,rmsvmw,v2i real(kind=doub_prec) :: rhomeanmw,rhomeanvw,rhovarmw,rhovarvw,bval,bvalmw real(kind=doub_prec) :: smeanmw,smeanvw,svarmw,svarvw,si,ekiny,ekinymax real(kind=doub_prec) :: lmin(maxplot), lmax(maxplot),rmsvali real(kind=doub_prec), dimension(3) :: xmom,angmom,angmomi,ri,vi real :: delta,dn,valmin,valmax,valmean,timei character(len=20) :: fmtstring logical :: change_coordsys real :: x0(3),v0(3) ! ! array with one value for each column ! real(kind=doub_prec) :: coltemp(maxplot), vals(maxplot), rmsval(maxplot) nfilesread = nfilesread + 1 if (time_was_read(time)) then timei = time print "(/,5('-'),a,', TIME=',es9.2,' FILE #',i4,/)",& '> CALCULATING '//trim(ucase(analysistype)),time,nfilesread else timei = 0. print "(/,5('-'),a,', FILE #',i4,' (TIME NOT READ)'/)",& '> CALCULATING '//trim(ucase(analysistype)),nfilesread endif change_coordsys = (icoordsnew.ne.icoords .and. ndim.gt.0 .and. all(ix(1:ndim).gt.0)) x0 = xorigin(:) ! note that it is not currently possible to do splash to ascii v0 = 0. ! with coords set relative to a tracked particle, so just use xorigin select case(trim(analysistype)) case('energy','energies') ekin = 0. emag = 0. epot = 0. etherm = 0. etot = 0. xmom = 0. angmom = 0. nused = 0 do i=1,ntot itype = igettype(i) if (iplotpartoftype(itype)) then pmassi = particlemass(i,itype) !--kinetic energy if (ivx.gt.0 .and. ivx+ndimV-1.le.ncolumns) then vi(:) = 0. vi(1:ndimV) = dat(i,ivx:ivx+ndimV-1) ekin = ekin + pmassi*dot_product(vi,vi) !--linear momentum xmom = xmom + pmassi*vi !--angular momentum if (ndim.ge.1 .and. all(ix(1:ndim).gt.0)) then ri(:) = 0. ri(1:ndim) = dat(i,ix(1):ix(ndim)) call cross_product3D(ri,vi,angmomi) angmom(:) = angmom(:) + pmassi*angmomi(:) endif endif !--thermal energy if (iutherm.gt.0 .and. iutherm.le.ncolumns) then etherm = etherm + pmassi*dat(i,iutherm) endif !--magnetic energy if (iBfirst.gt.0 .and. iBfirst+ndimV-1.le.ncolumns) then emag = emag + pmassi*dot_product(dat(i,iBfirst:iBfirst+ndimV-1),& dat(i,iBfirst:iBfirst+ndimV-1))/dat(i,irho) endif nused = nused + 1 endif enddo ekin = 0.5*ekin emag = 0.5*emag etot = ekin + etherm + epot + emag totmom = sqrt(dot_product(xmom(1:ndimV),xmom(1:ndimV))) totang = sqrt(dot_product(angmom,angmom)) print "(7(/,1x,a6,' = ',es9.2))",'etot',etot,'ekin',ekin,'etherm',etherm,'epot',epot,'emag',emag,'totmom',totmom,'totang',totang ! !--write line to output file ! write(iunit,"(64(es18.10,1x))") timei,ekin,etherm,emag,epot,etot,totmom,totang if (nused.ne.ntot) print*,'energies calculated using ',nused,' of ',ntot,' particles' case('massaboverho') massaboverho(:) = 0. if (irho.gt.0 .and. irho.le.ncolumns) then ! !--warn if particle masses not found ! if (ipmass.le.0 .or. ipmass.gt.ncolumns .and. all(massoftype < tiny(massoftype))) then print "(a)",' WARNING in massaboverho analysis!'// & ' masses not read or are zero from dump file' endif ! !--calculate mass above each density threshold ! do i=1,ntot itype = igettype(i) pmassi = particlemass(i,itype) if (itype.eq.1) then ! !--gas particles contribute if they are above rho ! where(dat(i,irho).ge.rholevels(1:nlevels)) massaboverho(1:nlevels) = massaboverho(1:nlevels) + pmassi end where elseif (labeltype(itype).eq.'sink') then ! !--sink particles always contribute (ie. they are assumed to ! be above every density threshold) ! massaboverho(1:nlevels) = massaboverho(1:nlevels) + pmassi endif enddo ! !--write output to screen/terminal ! do i=1,nlevels print "(1x,'M(rho > ',es9.2,') = ',es9.2)",rholevels(i),massaboverho(i) enddo ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) nlevels+1 write(iunit,fmtstring) timei,massaboverho(1:nlevels) else print "(a)",' ERROR in massaboverho analysis!'// & ' either mass or density not found in dump file' return endif case('max','maxvals') ! !--calculate maximum for each column ! coltemp(:) = -huge(0.d0) !maxval(dat(1:ntot,i)) nused = 0 do j=1,ntot itype = igettype(j) if (iplotpartoftype(itype)) then vals(1:ncolumns) = real(dat(j,1:ncolumns),kind=doub_prec) if (change_coordsys) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) nused = nused + 1 do i=1,ncolumns coltemp(i) = max(coltemp(i),vals(i)) enddo endif enddo where (coltemp(:) < -0.5*huge(0.)) coltemp(:) = 0. ! !--write output to screen/terminal ! do i=1,ncolumns print "(1x,a20,'max = ',es18.10)",label(i),coltemp(i) enddo ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) ncolumns+1 write(iunit,fmtstring) timei,coltemp(1:ncolumns) if (nused.ne.ntot) print*,'max calculated using ',nused,' of ',ntot,' particles' case('min','minvals') ! !--calculate minimum for each column ! coltemp(:) = huge(0.d0) !minval(dat(1:ntot,i)) nused = 0 do j=1,ntot itype = igettype(j) if (iplotpartoftype(itype)) then vals(1:ncolumns) = real(dat(j,1:ncolumns),kind=doub_prec) if (change_coordsys) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) nused = nused + 1 do i=1,ncolumns coltemp(i) = min(coltemp(i),vals(i)) enddo endif enddo ! !--write output to screen/terminal ! do i=1,ncolumns print "(1x,a20,'min = ',es18.10)",label(i),coltemp(i) enddo ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) ncolumns+1 write(iunit,fmtstring) timei,coltemp(1:ncolumns) if (nused.ne.ntot) print*,'min calculated using ',nused,' of ',ntot,' particles' case('diff','diffvals','amp','ampvals','delta','deltavals','deltas') ! !--calculate difference between max and min for each column ! coltemp(:) = 0. lmin(:) = huge(0.d0) lmax(:) = -huge(0.d0) nused = 0 do j=1,ntot itype = igettype(j) if (iplotpartoftype(itype)) then vals(1:ncolumns) = real(dat(j,1:ncolumns),kind=doub_prec) if (change_coordsys) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) nused = nused + 1 do i=1,ncolumns lmin(i) = min(lmin(i), vals(i)) lmax(i) = max(lmax(i), vals(i)) coltemp(i) = coltemp(i) + vals(i) enddo endif enddo if (nused.gt.0) coltemp(:) = coltemp(:)/real(nused) select case(trim(analysistype)) case('amp','ampvals') do i=1,ncolumns coltemp(i) = 0.5*(lmax(i) - lmin(i)) print "(1x,a20,'0.5*(max - min) = ',es18.10)",label(i),coltemp(i) enddo case('delta','deltavals','deltas') do i=1,ncolumns valmean = coltemp(i) if (valmean > 0.) then coltemp(i) = 0.5*(lmax(i) - lmin(i))/valmean else coltemp(i) = 0.5*(lmax(i) - lmin(i)) endif print "(1x,a20,'0.5*(max - min)/mean = ',es18.10)",label(i),coltemp(i) enddo case default ! diff, diffvals do i=1,ncolumns coltemp(i) = lmax(i) - lmin(i) print "(1x,a20,'(max - min) = ',es18.10)",label(i),coltemp(i) enddo end select ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) ncolumns+1 write(iunit,fmtstring) timei,coltemp(1:ncolumns) if (nused.ne.ntot) then select case(trim(analysistype)) case('diff', 'diffvals') print*,'diff calculated using ',nused,' of ',ntot,' particles' case('amp','ampvals') print*,'amp calculated using ',nused,' of ',ntot,' particles' case('delta','deltavals','deltas') print*,'deltas calculated using ',nused,' of ',ntot,' particles' end select endif case('mean','meanvals') ! !--calculate mean for each column ! coltemp(:) = 0. nused = 0 do j=1,ntot itype = igettype(j) if (iplotpartoftype(itype)) then vals(1:ncolumns) = real(dat(j,1:ncolumns),kind=doub_prec) if (change_coordsys) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) nused = nused + 1 do i=1,ncolumns coltemp(i) = coltemp(i) + vals(i) enddo endif enddo if (nused.gt.0) then coltemp(:) = coltemp(:)/real(nused) else coltemp(:) = 0. endif ! !--write output to screen/terminal ! do i=1,ncolumns print "(1x,a20,'mean = ',es18.10)",label(i),coltemp(i) enddo ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) ncolumns+1 write(iunit,fmtstring) timei,coltemp(1:ncolumns) if (nused.ne.ntot) print*,'mean calculated using ',nused,' of ',ntot,' particles' case('rms','rmsvals') ! !--calculate RMS for each column ! coltemp(:) = 0. nused = 0 do j=1,ntot itype = igettype(j) if (iplotpartoftype(itype)) then vals(1:ncolumns) = real(dat(j,1:ncolumns),kind=doub_prec) if (change_coordsys) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) nused = nused + 1 do i=1,ncolumns coltemp(i) = coltemp(i) + vals(i)**2 enddo endif enddo if (nused.gt.0) then coltemp(:) = sqrt(coltemp(:)/real(nused)) else coltemp(:) = 0. endif ! !--write output to screen/terminal ! do i=1,ncolumns print "(1x,a20,'rms (mass weighted) = ',es18.10)",label(i),coltemp(i) enddo ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) ncolumns+1 write(iunit,fmtstring) timei,coltemp(1:ncolumns) if (nused.ne.ntot) print*,'rms calculated using ',nused,' of ',ntot,' particles' case('vrms','vrmsvals','vwrms','rmsvw') if (irho.le.0 .or. irho.gt.ncolumns) then print "(a)",' ERROR in volume weighted rms calculation!'// & ' density not present / not labelled in dump file, skipping...' return endif ! !--warn if particle masses not found ! if (ipmass.le.0 .or. ipmass.gt.ncolumns .and. all(massoftype < tiny(massoftype))) then print "(a)",' WARNING in volume weighted rms calculation!'// & ' masses not read or are zero from dump file' endif ! !--calculate volume-weighted RMS for each column ! rmsval(:) = 0. totvol = 0. do j=1,ntot itype = igettype(j) if (iplotpartoftype(itype)) then vals(1:ncolumns) = real(dat(j,1:ncolumns),kind=doub_prec) if (change_coordsys) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) pmassi = particlemass(j,itype) rhoi = dat(j,irho) if (rhoi.gt.0.) then voli = pmassi/rhoi else voli = 0. endif do i=1,ncolumns rmsval(i) = rmsval(i) + voli*vals(i)**2 enddo totvol = totvol + voli endif enddo coltemp(:) = real(sqrt(rmsval(:)/totvol)) print "(1x,a,es9.2)",'volume = ',totvol ! !--write output to screen/terminal ! do i=1,ncolumns print "(1x,a20,'rms (volume weighted) = ',es18.10)",label(i),coltemp(i) enddo ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) ncolumns+1 write(iunit,fmtstring) timei,coltemp(1:ncolumns) case('rhovar','rhomach') if (irho.le.0 .or. irho.gt.ncolumns) then print "(a)",' ERROR in density variance--rms velocity field calculation!'// & ' density not present / not labelled in dump file, skipping...' return endif ! !--warn if particle masses not found ! if (ipmass.le.0 .or. ipmass.gt.ncolumns .and. all(massoftype < tiny(massoftype))) then print "(a)",' WARNING in volume weighted rms calculation!'// & ' masses not read or are zero from dump file' endif if (ivx.le.0 .or. ivx.gt.ncolumns) then print "(a)",' WARNING in volume weighted rms calculation!'// & ' velocities not present / not labelled in dump file' endif ! !--calculate mean density and rms velocity values on first pass ! rmsvali = 0. rmsvmw = 0. rhomeanvw = 0. rhomeanmw = 0. totvol = 0. smeanvw = 0. smeanmw = 0. do i=1,ntot itype = igettype(i) pmassi = particlemass(i,itype) rhoi = dat(i,irho) if (rhoi.gt.0.) then voli = pmassi/rhoi else voli = 0. endif rhomeanmw = rhomeanmw + rhoi rhomeanvw = rhomeanvw + pmassi si = log(rhoi) smeanmw = smeanmw + si smeanvw = smeanvw + voli*si totvol = totvol + voli ! !--mean squared velocity ! if (ivx.gt.0 .and. ivx.le.ncolumns) then v2i = dot_product(dat(i,ivx:ivx+ndimV-1),dat(i,ivx:ivx+ndimV-1)) rmsvali = rmsvali + voli*v2i rmsvmw = rmsvmw + v2i endif enddo ! !--use the computed volume for velocity, otherwise won't be normalised correctly ! rmsvali = sqrt(rmsvali/totvol) rmsvmw = sqrt(rmsvmw/dble(ntot)) ! !--option to override volume from sum with environment variable ! voli = renvironment('SPLASH_CALC_VOLUME',errval=-1.0) if (voli.gt.0.) then print "(1x,a,es9.2)",& 'volume from sum(m/rho) = ',totvol totvol = voli print "(1x,a,es9.2,/)",& '**overridden with SPLASH_CALC_VOLUME = ',totvol else print "(1x,a,es9.2,/,1x,a,/)",& 'volume from sum(m/rho) = ',totvol,& '(override this using SPLASH_CALC_VOLUME environment variable)' endif rhomeanmw = rhomeanmw/real(ntot) rhomeanvw = rhomeanvw/totvol smeanmw = smeanmw/real(ntot) smeanvw = smeanvw/totvol ! !--calculate variance on second pass ! rhovarvw = 0. rhovarmw = 0. svarvw = 0. svarmw = 0. totvol = 0. do i=1,ntot itype = igettype(i) pmassi = particlemass(i,itype) rhoi = dat(i,irho) if (rhoi.gt.0.) then voli = pmassi/rhoi si = log(rhoi) else voli = 0. si = 0. endif totvol = totvol + voli rhovarmw = rhovarmw + (rhoi - rhomeanmw)**2 rhovarvw = rhovarvw + voli*(rhoi - rhomeanvw)**2 svarmw = svarmw + (si - smeanmw)**2 svarvw = svarvw + voli*(si - smeanvw)**2 enddo rhovarmw = rhovarmw/real(ntot) rhovarvw = rhovarvw/totvol svarmw = svarmw/real(ntot) svarvw = svarvw/totvol ! !--write output to screen/terminal ! print "(1x,'mean density (vol. weighted) = ',es11.4,' +/- ',es11.4)",rhomeanvw,sqrt(rhovarvw) print "(1x,'mean density (mass weighted) = ',es11.4,' +/- ',es11.4)",rhomeanmw,sqrt(rhovarmw) print "(1x,'density variance (vol. weighted) = ',es11.4)",rhovarvw print "(1x,'density variance (mass weighted) = ',es11.4)",rhovarmw print "(1x,'mean ln density (vol. weighted) = ',es11.4,' +/- ',es11.4)",smeanvw,sqrt(svarvw) print "(1x,' -0.5*var(ln density) = ',es11.4)",-0.5*svarvw print "(1x,'mean ln density (mass weighted) = ',es11.4,' +/- ',es11.4)",smeanmw,sqrt(svarmw) print "(1x,'ln density variance (vol. weighted) = ',es11.4)",svarvw print "(1x,'ln density variance (mass weighted) = ',es11.4)",svarmw print "(1x,'rms velocity (vol. weighted) = ',es11.4)",rmsvali print "(1x,'rms velocity (mass weighted) = ',es11.4)",rmsvmw if (rmsvali.gt.0.) then bval = sqrt(svarvw)/rmsvali else bval = 0. endif if (rmsvmw.gt.0.) then bvalmw = sqrt(svarmw)/rmsvmw else bvalmw = 0. endif print "(1x,'sqrt(sigma^2/v^2)(vol. weighted) = ',f11.3)",bval print "(1x,'sqrt(sigma^2/v^2)(mass weighted) = ',f11.3)",bvalmw ! !--write line to output file ! write(fmtstring,"('(',i3,'(es18.10,1x))')",iostat=ierr) 17 write(iunit,fmtstring) timei,rhomeanvw,rhomeanmw,rhovarvw,rhovarmw,sqrt(rhovarvw),sqrt(rhovarmw),& rmsvali,rmsvmw,bval,bvalmw,smeanvw,smeanmw,svarvw,svarmw,sqrt(svarvw),sqrt(svarmw) case('kh') if (irho.le.0 .or. irho.gt.ncolumns) then print "(a)",' ERROR in kh calculation!'// & ' density not present / not labelled in dump file, skipping...' return endif if (ivx.le.0 .or. ivx.gt.ncolumns) then print "(a)",' WARNING in kh calculation!'// & ' velocities not present / not labelled in dump file' endif ! !--calculate volume-weighted RMS for each column ! ekinymax = 0. do i=1,ntot ekiny = 0.5*dat(i,irho)*dat(i,ivx+1)**2 ekinymax = max(ekiny,ekinymax) enddo print "(1x,a,es9.2)",'ekiny(max) = ',ekinymax write(iunit,"(2(es18.10,1x))") timei,ekinymax case('timeaverage','timeav') if (.not.allocated(datmean)) then allocate(datmean(ntot,ncolumns),stat=ierr) if (ierr /= 0) stop 'error allocating memory for mean sum in calc' datmean = 0. endif if (.not.allocated(datvar)) then allocate(datvar(ntot,ncolumns),stat=ierr) if (ierr /= 0) stop 'error allocating memory for variance sum in calc' datvar = 0. endif ntot1 = size(datmean(:,1)) if (ntot.gt.ntot1) then print*,' WARNING: nrows = ',ntot,' > nrows from previous dumpfile =',ntot1 print*,' ignoring all rows/particles greater than ',ntot1 elseif (ntot.lt.ntot1) then print*,' WARNING: nrows = ',ntot,' < nrows from previous dumpfile =',ntot1 print*,' assuming zeros for rows/particles greater than ',ntot endif ncol1 = size(datmean(1,:)) if (ncolumns.gt.ncol1) then print*,' WARNING: ncolumns = ',ncolumns,' > ncolumns from previous dumpfile =',ncol1 print*,' ignoring all rows/particles greater than ',ncol1 elseif (ncolumns.lt.ncol1) then print*,' WARNING: ncolumns = ',ntot,' < ncolumns from previous dumpfile =',ncol1 print*,' assuming zeros for columns greater than ',ncolumns endif ntot1 = min(ntot1,ntot) ncol1 = min(ncol1,ncolumns) dn = 1./real(nfilesread) ! !--compute the mean and variance using Knuth/Welford's compensated ! summation algorithm to minimise round-off error ! (see http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance) ! do j=1,ncol1 do i=1,ntot1 delta = dat(i,j) - datmean(i,j) datmean(i,j) = datmean(i,j) + delta*dn datvar(i,j) = datvar(i,j) + delta*(dat(i,j) - datmean(i,j)) enddo enddo return !sum1(:,:) = sum1(:,:) + dat(1:ntot1,1:ncol1) !sum2(:,:) = sum2(:,:) + dat(1:ntot1,1:ncol1)**2 case('ratio') if (.not.allocated(datmean)) then allocate(datmean(size(dat(:,1)),size(dat(1,:))),stat=ierr) if (ierr /= 0) stop 'error allocating temporary memory in calc' datmean = 0. endif if (.not.allocated(datvar)) then allocate(datvar(size(dat(:,1)),size(dat(1,:))),stat=ierr) if (ierr /= 0) stop 'error allocating memory in calc' datvar = 0. endif ntot1 = size(datmean(:,1)) if (ntot.gt.ntot1) then print*,' WARNING: nrows = ',ntot,' > nrows from previous dumpfile =',ntot1 print*,' ignoring all rows/particles greater than ',ntot1 elseif (ntot.lt.ntot1) then print*,' WARNING: nrows = ',ntot,' < nrows from previous dumpfile =',ntot1 print*,' assuming zeros for rows/particles greater than ',ntot endif ncol1 = size(datmean(1,:)) if (size(dat(1,:)).gt.ncol1) then print*,' WARNING: ncolumns = ',ncolumns,' > ncolumns from previous dumpfile =',ncol1 print*,' ignoring all rows/particles greater than ',ncol1 elseif (ncolumns.lt.ncol1) then print*,' WARNING: ncolumns = ',ntot,' < ncolumns from previous dumpfile =',ncol1 print*,' assuming zeros for columns greater than ',ncolumns endif ntot1 = min(ntot1,ntot) ncol1 = min(ncol1,size(dat(1,:))) if (ntot1.le.0 .or. ncol1.le.0) then print "(a,i2,a,i2,a)",' ERROR: nrows = ',ntot1,' ncolumns = ',ncol1,' aborting...' return endif if (nfilesread.le.1) then !--store first dump datmean(1:ntot1,1:ncol1) = dat(1:ntot1,1:ncol1) else where (abs(datmean(1:ntot1,1:ncol1)) > epsilon(0.)) datvar(1:ntot1,1:ncol1) = dat(1:ntot1,1:ncol1)/datmean(1:ntot1,1:ncol1) ! ratio of current data to first step elsewhere datvar(1:ntot1,1:ncol1) = dat(1:ntot1,1:ncol1)/(datmean(1:ntot1,1:ncol1) + epsilon(0.)) end where valmin = datvar(1,1) valmax = datvar(1,1) valmean = 0. do j=1,ncol1 do i=1,ntot1 valmin = min(datvar(i,j),valmin) valmax = max(datvar(i,j),valmin) valmean = valmean + datvar(i,j) enddo enddo valmean = valmean/real(ntot1*ncol1) print "(/,a,es10.3)",' max ratio = ',valmax print "(a,es10.3)",' min ratio = ',valmin print "(a,es10.3,/)",' mean ratio = ',valmean print "(a)",'----> WRITING ratio.out ...' if (allocated(datmean) .and. allocated(datvar)) then write(iunit,"('# ',i4,1x,i4)") ntot1,ncol1 write(fmtstring,"(a,i6,a)",iostat=ierr) '(',ncol1,'(es14.6,1x,))' do i=1,ntot1 write(iunit,fmtstring) datvar(i,:) enddo endif endif return case default print "(a)",' ERROR: unknown analysis type in write_analysis routine' return end select print "(/,1x,'>>> ',a,' <<<')",'written to '//trim(fileout) return contains ! !--small internal utility to work out the particle type ! (which depends whether or not mixed types are stored) ! integer function igettype(i) implicit none integer :: np integer, intent(in) :: i if (size(iamtype).gt.1) then igettype = int(iamtype(i)) else np = 0 igettype = 0 do while (i.gt.np .and. igettype.le.ntypes) igettype = igettype + 1 np = np + npartoftype(igettype) enddo endif end function igettype ! !--small internal utility to get particle mass ! (depends on whether or not mass is stored for each particle ! or only for each type) ! real function particlemass(i,iparttype) implicit none integer, intent(in) :: i,iparttype if (ipmass.gt.0 .and. ipmass.le.ncolumns) then particlemass = dat(i,ipmass) else particlemass = massoftype(iparttype) endif end function particlemass end subroutine write_analysis subroutine cross_product3D(veca,vecb,vecc) use params, only:doub_prec implicit none real(kind=doub_prec), dimension(3), intent(in) :: veca,vecb real(kind=doub_prec), dimension(3), intent(out) :: vecc vecc(1) = veca(2)*vecb(3) - veca(3)*vecb(2) vecc(2) = veca(3)*vecb(1) - veca(1)*vecb(3) vecc(3) = veca(1)*vecb(2) - veca(2)*vecb(1) end subroutine cross_product3D !--------------------- ! close output file !--------------------- subroutine close_analysis(analysistype) implicit none character(len=*), intent(in) :: analysistype integer :: i select case(trim(analysistype)) case('timeaverage','timeav') print "(a)",'----> WRITING time_average.out ...' if (allocated(datmean) .and. allocated(datvar) .and. nfilesread.gt.0) then !--get standard deviation from variance (also normalise with 1/n) datvar(:,:) = sqrt(datvar(:,:))/sqrt(real(nfilesread)) do i=1,size(datmean(:,1)) write(iunit,"(1x,99(es15.7,2x))") datmean(i,:),datvar(i,:) enddo endif end select if (allocated(datmean)) deallocate(datmean) if (allocated(datvar)) deallocate(datvar) close(unit=iunit) return end subroutine close_analysis end module analysis splash/src/asciiutils.f90000644 000770 000000 00000045134 12370535230 016237 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !--------------------------------------------------------------------------- ! module containing various utility subroutines ! related to reading from ascii files and dealing with string variables ! ! written by Daniel Price, University of Exeter 2007 24th April '07 ! revised at Monash University, Nov '08. ! daniel.price@monash.edu ! ! this is a standalone module with no dependencies !--------------------------------------------------------------------------- module asciiutils implicit none public :: read_asciifile,get_ncolumns,get_nrows,ncolumnsline,safename,basename public :: cstring,fstring public :: string_replace, string_delete, nheaderlines, string_sub public :: ucase,lcase public :: get_line_containing private !-------------------------------------------------- ! Generic interface to ascii file read for either ! character arrays (ie. each line is an element) ! or an array of real numbers !-------------------------------------------------- interface read_asciifile module procedure read_asciifile_char, read_asciifile_real,& read_asciifile_real_string end interface read_asciifile contains !--------------------------------------------------------------------------- ! Generic subroutine to read all lines of an ascii file ! returns array of character strings (one per line) ! up to a maximum corresponding to the size of the array !--------------------------------------------------------------------------- subroutine read_asciifile_char(filename,nlinesread,charline,ierror) implicit none character(len=*), intent(in) :: filename integer, intent(out) :: nlinesread character(len=*), dimension(:), intent(out) :: charline integer, intent(out), optional :: ierror integer, parameter :: iunit = 66 ! logical unit number for read operation integer :: ierr,i,maxlines logical :: iexist nlinesread = 0 if (present(ierror)) ierror = 0 !--if file does not exist, do nothing and return inquire(file=filename,exist=iexist) if (.not.iexist) then if (present(ierror)) ierror = -1 return endif open(unit=iunit,file=filename,status='old',form='formatted',iostat=ierr) !--error opening file (but file does exist) if (ierr /= 0) then print "(a)",' ERROR opening '//trim(filename) if (present(ierror)) ierror = ierr return endif maxlines = size(charline) do i=1,maxlines read(iunit,"(a)",err=66,end=99) charline(i) enddo !--end of array limits ! check to see if there is anything more in the file. Report error if there is. read(iunit,"(a)",iostat=ierr) if (ierr.eq.0) then print "(a,i6)",' WARNING: array limits reached reading '//trim(filename)//', max = ',maxlines endif nlinesread = maxlines close(unit=iunit) return !--error encountered 66 continue print "(a,i6)",' ERROR reading '//trim(filename)//' at line ',i-1 if (present(ierror)) ierror = 1 nlinesread = i-1 close(unit=iunit) return !--reached end of file (the expected behaviour) 99 continue nlinesread = i-1 close(unit=iunit) return end subroutine read_asciifile_char !--------------------------------------------------------------------------- ! Generic subroutine to read all lines of an ascii file ! returns array of real numbers (either one per line or all on same line) ! up to a maximum corresponding to the size of the array !--------------------------------------------------------------------------- subroutine read_asciifile_real(filename,nlinesread,realarr,ierror) implicit none character(len=*), intent(in) :: filename integer, intent(out) :: nlinesread real, dimension(:), intent(out) :: realarr integer, intent(out), optional :: ierror integer, parameter :: iunit = 66 ! logical unit number for read operation integer :: ierr,i,maxlines logical :: iexist nlinesread = 0 if (present(ierror)) ierror = 0 !--if file does not exist, do nothing and return inquire(file=filename,exist=iexist) if (.not.iexist) then if (present(ierror)) ierror = -1 return endif open(unit=iunit,file=filename,status='old',form='formatted',iostat=ierr) !--error opening file (but file does exist) if (ierr /= 0) then print "(a)",' ERROR opening '//trim(filename) if (present(ierror)) then ierror = ierr endif return endif realarr(:) = -666. maxlines = size(realarr) read(iunit,*,err=66,end=99) (realarr(i),i=1,maxlines) !--end of array limits print "(a,i6)",' WARNING: array limits reached reading '//trim(filename)//', max = ',maxlines nlinesread = maxlines close(unit=iunit) return !--error encountered 66 continue print "(a,i6)",' ERROR reading '//trim(filename)//' at line ',i-1 if (present(ierror)) ierror = 1 do i=1,maxlines if (abs(realarr(i)+666.).gt.tiny(0.)) nlinesread = nlinesread + 1 enddo close(unit=iunit) return !--reached end of file (the expected behaviour) 99 continue do i=1,maxlines if (abs(realarr(i)+666.).gt.tiny(0.)) nlinesread = nlinesread + 1 enddo close(unit=iunit) return end subroutine read_asciifile_real !--------------------------------------------------------------------------- ! Generic subroutine to read all lines of an ascii file ! returns array of real numbers and corresponding string ! up to a maximum corresponding to the size of the array !--------------------------------------------------------------------------- subroutine read_asciifile_real_string(filename,nlinesread,realarr,charline,ierror) implicit none character(len=*), intent(in) :: filename integer, intent(out) :: nlinesread real, dimension(:), intent(out) :: realarr character(len=*), dimension(:), intent(out) :: charline integer, intent(out), optional :: ierror integer, parameter :: iunit = 66 ! logical unit number for read operation integer :: ierr,i,maxlines logical :: iexist nlinesread = 0 if (present(ierror)) ierror = 0 !--if file does not exist, do nothing and return inquire(file=filename,exist=iexist) if (.not.iexist) then if (present(ierror)) ierror = -1 return endif open(unit=iunit,file=filename,status='old',form='formatted',iostat=ierr) !--error opening file (but file does exist) if (ierr /= 0) then print "(a)",' ERROR opening '//trim(filename) if (present(ierror)) then ierror = ierr endif return endif if (size(realarr) /= size(charline)) then print "(a)",' WARNING: array size mismatch in call to read_asciifile' endif realarr(:) = -666. maxlines = min(size(realarr),size(charline)) read(iunit,*,err=66,end=99) (realarr(i),charline(i),i=1,maxlines) !--end of array limits print "(a,i6)",' WARNING: array limits reached reading '//trim(filename)//', max = ',maxlines nlinesread = maxlines close(unit=iunit) return !--error encountered 66 continue print "(a,i6)",' ERROR reading '//trim(filename)//' at line ',i-1 if (present(ierror)) ierror = 1 do i=1,maxlines if (abs(realarr(i)+666.).gt.tiny(0.)) nlinesread = nlinesread + 1 enddo close(unit=iunit) return !--reached end of file (the expected behaviour) 99 continue do i=1,maxlines if (abs(realarr(i)+666.).gt.tiny(0.)) nlinesread = nlinesread + 1 enddo close(unit=iunit) return end subroutine read_asciifile_real_string !--------------------------------------------------------------------------- ! utility to work out number of columns of real numbers ! in an ascii file ! ! file must already be open and at the start ! slightly ad-hoc but its the best way I could think of! !--------------------------------------------------------------------------- subroutine get_ncolumns(lunit,ncolumns,nheaderlines) implicit none integer, intent(in) :: lunit integer, intent(out) :: ncolumns,nheaderlines integer :: ierr,ncolprev,ncolsthisline character(len=5000) :: line logical :: nansinfile,infsinfile nheaderlines = 0 line = ' ' ierr = 0 ncolumns = 0 ncolprev = -100 ncolsthisline = 0 nansinfile = .false. infsinfile = .false. ! !--loop until we find two consecutive lines with the same number of columns (but non zero) ! do while ((len_trim(line).eq.0 .or. ncolsthisline.ne.ncolprev .or. ncolumns.le.0) .and. ierr.eq.0) ncolprev = ncolumns read(lunit,"(a)",iostat=ierr) line if (index(line,'NaN').gt.0) nansinfile = .true. if (index(line,'Inf').gt.0) infsinfile = .true. if (len_trim(line).eq.0) then ncolsthisline = -1 else if (ierr.eq.0) ncolsthisline = ncolumnsline(line) ncolumns = ncolsthisline endif nheaderlines = nheaderlines + 1 !print*,'DEBUG: header line ',nheaderlines,' ncols = ',ncolsthisline,'"'//trim(line)//'"' enddo !--subtract 2 from the header line count (the last two lines which were the same) nheaderlines = max(nheaderlines - 2,0) if (ierr .gt.0 .or. ncolumns.le.0) then ncolumns = 0 elseif (ierr .lt. 0) then !print*,ncolumns,ncolprev endif if (nansinfile) print "(a)",' INDIAN BREAD WARNING!! NaNs in file!!' if (infsinfile) print "(a)",' WARNING!! Infs in file!!' rewind(lunit) if (ncolumns.eq.0) print "(a)",' ERROR: no columns of real numbers found' end subroutine get_ncolumns !--------------------------------------------------------------------------- ! utility to work out number of rows in file !--------------------------------------------------------------------------- subroutine get_nrows(lunit,nheaderlines,nlines) implicit none integer, intent(in) :: lunit,nheaderlines integer, intent(out) :: nlines integer :: ierr,i rewind(lunit) ierr = 0 do i=1,nheaderlines read(lunit,*,iostat=ierr) enddo nlines = 0 do while (ierr==0) read(lunit,*,iostat=ierr) if (ierr==0) nlines = nlines + 1 enddo end subroutine get_nrows !--------------------------------------------------------------------------- ! ! function returning the number of columns of real numbers from a given line ! !--------------------------------------------------------------------------- integer function ncolumnsline(line) implicit none character(len=*), intent(in) :: line real :: dummyreal(1000) integer :: ierr,i dummyreal = -666666.0 ierr = 0 read(line,*,iostat=ierr) (dummyreal(i),i=1,size(dummyreal)) i = 1 ncolumnsline = 0 do while(abs(dummyreal(i)+666666.).gt.tiny(0.)) ncolumnsline = ncolumnsline + 1 i = i + 1 if (i.gt.size(dummyreal)) then print "(a)",'*** ERROR: too many columns in file' ncolumnsline = size(dummyreal) return endif enddo end function ncolumnsline !---------------------------------------------------------------------- ! ! Small utility to return the number of comment lines in an ascii ! file. These are lines that do not begin with a number. ! ! This is slightly different to what is done in the get_ncolumns ! routine, where header lines are any lines not having the same number ! of columns. Here we do not attempt to evaluate the number of data ! columns. ! ! File must be open and at the desired starting position !---------------------------------------------------------------------- integer function nheaderlines(lunit) integer, intent(in) :: lunit real :: dum integer :: ierr dum = -666. nheaderlines = 0 ierr = -1 do while (abs(dum+666.).lt.tiny(0.) .or. ierr.ne.0) nheaderlines = nheaderlines + 1 read(lunit,*,iostat=ierr) dum enddo nheaderlines = nheaderlines - 1 end function nheaderlines !--------------------------------------------------------------------------- ! ! function stripping '/', '\' and spaces out of filenames ! !--------------------------------------------------------------------------- function safename(string) implicit none character(len=*), intent(in) :: string character(len=len(string)) :: safename integer :: ipos safename = string !--remove forward slashes which can be mistaken for directories: replace with '_' call string_replace(safename,'/','_') call string_replace(safename,' ','_') !--delete brackets and operators of all kinds call string_delete(safename,'{') call string_delete(safename,'}') call string_delete(safename,'(') call string_delete(safename,')') call string_delete(safename,'[') call string_delete(safename,']') call string_delete(safename,'<') call string_delete(safename,'>') call string_delete(safename,'*') call string_delete(safename,'?') call string_delete(safename,'^') call string_delete(safename,'''') call string_delete(safename,'"') call string_delete(safename,'&') call string_delete(safename,'#') call string_delete(safename,'|') !--remove escape sequences: remove '\' and position following ipos = index(trim(safename),'\') do while (ipos.ne.0) safename = safename(1:ipos-1)//safename(ipos+2:len_trim(safename)) ipos = index(trim(safename),'\') enddo end function safename !--------------------------------------------------------------------------- ! ! function stripping the directory off a filename ! !--------------------------------------------------------------------------- function basename(string) implicit none character(len=*), intent(in) :: string character(len=len(string)) :: basename integer :: i,iposmax basename = string !--find the last forward slash iposmax = 0 i = len_trim(string) do while(i.ge.2 .and. iposmax.eq.0) i = i - 1 if (string(i:i).eq.'/') iposmax = i enddo basename = trim(string(iposmax+1:)) end function basename !--------------------------------------------------------------------------- ! ! function to safely convert a string to c format (ie. with a terminating ! ascii null character) ! !--------------------------------------------------------------------------- function cstring(string) implicit none character(len=*), intent(in) :: string character(len=len(string)+1) :: cstring cstring = trim(string)//achar(0) end function cstring !--------------------------------------------------------------------------- ! ! function to safely convert a string from c format (ie. with a terminating ! ascii null character) back to a normal Fortran string ! !--------------------------------------------------------------------------- function fstring(array) use, intrinsic :: iso_c_binding, only:c_char implicit none character(kind=c_char), dimension(:), intent(in) :: array character(len=size(array)-1) :: fstring integer :: i fstring = '' do i=1,size(array) if (array(i).eq.achar(0)) exit fstring(i:i) = array(i) enddo end function fstring !--------------------------------------------------------------------------- ! ! subroutine to replace a matching section of a string with another ! string, possibly of differing length ! !--------------------------------------------------------------------------- subroutine string_replace(string,skey,sreplacewith) implicit none character(len=*), intent(inout) :: string character(len=*), intent(in) :: skey,sreplacewith integer :: ipos,lensub ipos = index(trim(string),skey) lensub = len(skey) do while(ipos.gt.0) string = string(1:ipos-1)//sreplacewith//string(ipos+lensub:len_trim(string)) ipos = index(trim(string),skey) enddo end subroutine string_replace !--------------------------------------------------------------------------- ! ! subroutine to replace a specified section of a string with a ! replacement string, possibly of differing length ! !--------------------------------------------------------------------------- subroutine string_sub(string,i1,i2,sreplacewith) implicit none character(len=*), intent(inout) :: string integer, intent(in) :: i1,i2 character(len=*), intent(in) :: sreplacewith character(len=len(string)) :: oldstring oldstring = string if (i2 < len_trim(string)) then string = oldstring(1:i1-1)//sreplacewith//oldstring(i2+1:len_trim(oldstring)) else string = oldstring(1:i1-1)//sreplacewith endif end subroutine string_sub !--------------------------------------------------------------------------- ! ! subroutine to delete all matching occurrences of key from string ! !--------------------------------------------------------------------------- pure subroutine string_delete(string,skey) implicit none character(len=*), intent(inout) :: string character(len=*), intent(in) :: skey integer :: ipos,lensub ipos = index(trim(string),skey) lensub = len(skey) do while(ipos.gt.0) string = string(1:ipos-1)//string(ipos+lensub:len_trim(string)) ipos = index(trim(string),skey) enddo end subroutine string_delete !--------------------------------------------------------------------------- ! ! Converts a string to upper case ! !--------------------------------------------------------------------------- function ucase(string) implicit none character(len=*), intent(in) :: string character(len=len(string)) :: ucase integer :: is,ia integer, parameter :: aoffset = 32 ucase = string do is = 1, len(ucase) ia = iachar(ucase(is:is)) if (ia >= iachar('a').and.ia <= iachar('z')) & ucase(is:is) = achar(ia-aoffset) enddo end function ucase !--------------------------------------------------------------------------- ! ! Converts a string to lower case ! !--------------------------------------------------------------------------- function lcase(string) implicit none character(len=*), intent(in) :: string character(len=len(string)) :: lcase integer :: is,ia integer, parameter :: aoffset = 32 lcase = string do is = 1, len(lcase) ia = iachar(lcase(is:is)) if (ia >= iachar('A').and.ia <= iachar('Z')) & lcase(is:is) = achar(ia+aoffset) enddo end function lcase !--------------------------------------------------------------------------- ! ! Converts a string to lower case ! !--------------------------------------------------------------------------- integer function get_line_containing(filename,string) character(len=*), intent(in) :: filename, string character(len=130) :: line integer :: i,ierr integer, parameter :: lu=95 get_line_containing = 0 open(unit=lu,file=filename,status='old',iostat=ierr) i = 0 do while(ierr.eq.0) i = i + 1 read(lu,"(a)",iostat=ierr) line if (index(line,string).ne.0) get_line_containing = i enddo close(lu) end function get_line_containing end module asciiutils splash/src/calc_quantities.f90000644 000770 000000 00000103530 12534305326 017234 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! This module allows arbitrary functions to be computed from the ! particle data. Uses the fparser module to parse the functions. ! !----------------------------------------------------------------- module calcquantities use labels, only:lenlabel,lenunitslabel use params, only:maxplot implicit none public :: calc_quantities,setup_calculated_quantities public :: calc_quantities_use_x0,get_calc_data_dependencies integer, parameter, private :: maxcalc = 35 character(len=lenlabel), dimension(maxcalc) :: calcstring = ' ' character(len=lenlabel), dimension(maxcalc) :: calclabel = ' ' character(len=lenunitslabel), dimension(maxcalc) :: calcunitslabel = ' ' integer, parameter, private :: lenvars = 20 ! max length for any variable integer, parameter, private :: nextravars = 5 character(len=lenvars), dimension(nextravars), parameter, private :: & extravars=(/'t ','gamma','x0 ','y0 ','z0 '/) namelist /calcopts/ calcstring,calclabel,calcunitslabel public :: calcopts,calcstring,calclabel,calcunitslabel private contains !----------------------------------------------------------------- ! ! Allow the user to edit the list of function strings used ! to compute additional quantities from the particle data ! !----------------------------------------------------------------- subroutine setup_calculated_quantities(ncalc) use settings_data, only:ncolumns use prompting, only:prompt implicit none integer, intent(out) :: ncalc integer :: ncalctot,istart,iend, ipick, ninactive, i logical :: done,first character(len=1) :: charp integer, dimension(maxcalc) :: incolumn logical, save :: firstcall = .true. ipick = ncolumns + 1 done = .false. first = .true. ! !--on the first call to setup, prefill the list of calculated ! quantities with ALL of the valid examples. ! if (ncalc.eq.0 .and. firstcall) call print_example_quantities(ncalc) firstcall = .false. charp = 'a' calcmenu: do while (.not.done) call check_calculated_quantities(ncalc,ncalctot,incolumn) ninactive = ncalctot - ncalc iend = maxcalc if (ncalctot.gt.0 .or. .not.first) then charp='q' !'a' if (.not.first) charp = 'q' print* call prompt(' a)dd to, e)dit, c)lear current list or q)uit/finish? ',& charp,list=(/'a','e','c','q','s','S','Q'/),noblank=.true.) select case(charp) case('a') istart = ncalctot iend = ncalctot+1 case('e') if (ninactive.gt.0 .and. ncalc.gt.0) then call prompt(' pick a function to edit ',ipick,-ninactive,-1,ncolumns+1,ncolumns+ncalc) elseif (ncalc.gt.0) then call prompt(' pick a function to edit ',ipick,ncolumns+1,ncolumns+ncalc) endif istart = 0 do i=1,ncalctot if (incolumn(i).eq.ipick) istart = i - 1 enddo iend = istart + 1 case('c') calcstring(:) = ' ' calclabel(:) = ' ' calcunitslabel(:) = ' ' first = .false. cycle calcmenu case('q','Q','s','S') done = .true. case default istart = 0 iend = maxcalc end select else istart = 0 iend = 1 endif if (.not.done) call add_calculated_quantities(istart,iend,ncalc,first,incolumn) first = .false. enddo calcmenu if (ncalc.lt.10) then print "(a,i1,a)",' setup ',ncalc,' additional quantities' else print "(a,i2,a)",' setup ',ncalc,' additional quantities' endif end subroutine setup_calculated_quantities !----------------------------------------------------------------- ! ! utility (private) to add one or more calculated quantities ! to the current list and/or edit previous settings ! !----------------------------------------------------------------- subroutine add_calculated_quantities(istart,iend,ncalc,printhelp,incolumn) use prompting, only:prompt use fparser, only:checkf use settings_data, only:ncolumns,iRescale,required use labels, only:shortstring implicit none integer, intent(in) :: istart,iend integer, intent(out) :: ncalc logical, intent(in) :: printhelp integer, dimension(maxcalc), intent(in) :: incolumn integer :: i,j,ntries,ierr,iequal,nvars logical :: iask character(len=120) :: string character(len=lenvars), dimension(maxplot+nextravars) :: vars i = istart + 1 ntries = 0 ncalc = istart if (i.gt.maxcalc) then print "(/,a,i2,a)",' *** Error, maximum number of calculated quantities (',maxcalc,') reached, cannot add any more.' print "(a)", ' *** If you hit this limit, *please email me* so I can change the default limits!' print "(a)", ' *** (and then edit calc_quantities.f90, changing the parameter "maxcalc" to something higher...)' return endif if (printhelp) then print "(/,a)",' Specify a function to calculate from the data ' print "(10(a))",' Valid variables are the column labels',(', '''//trim(extravars(j))//'''',j=1,nextravars-1),& ' and '''//trim(extravars(nextravars))//'''' print "(a)",' Spaces, escape sequences (\d), arithmetic operators and units labels' print "(a)",' are removed from variable names. Note that previously calculated' print "(a)",' quantities can be used in subsequent calculations.' endif call print_example_quantities() overfuncs: do while(ntries.lt.3 .and. i.le.iend .and. i.le.maxcalc) if (len_trim(calcstring(i)).ne.0 .or. ncalc.gt.istart) then if (incolumn(i).gt.0) then write(*,"(a,i2,a)") '[Column ',incolumn(i),']' else write(*,"(a)") '[Currently inactive]' endif endif if (len_trim(calclabel(i)).gt.0) then string = trim(calclabel(i))//' = '//trim(calcstring(i)) else string = trim(calcstring(i)) endif call prompt('Enter function string to calculate (blank for none) ',string) if (len_trim(string).eq.0) then ! !--if editing list and get blank string at prompt, ! remove the entry and shuffle the list appropriately ! do j=i,maxcalc-1 !print*,' shuffling ',j,' = '//trim(calcstring(j+1)) calcstring(j) = trim(calcstring(j+1)) if (j+1.lt.size(calclabel)) then calclabel(j) = calclabel(j+1) endif if (len_trim(calcstring(j)).eq.0) then if (j.eq.i) then exit overfuncs else cycle overfuncs endif endif enddo else ! !--set label from what lies to the left of the equal sign ! and the calcstring from what lies to the right ! (if no equals sign, then prompt later for the label) ! iequal = index(string,'=') call splitstring(string,calclabel(i),calcstring(i)) ! !--fill variable array with the list of valid variable ! names for this column ! call get_variables(ncolumns+i-1,nvars,vars) ! !--check for errors parsing function ! ierr = checkf(shortstring(calcstring(i)),vars(1:nvars)) if (ierr.ne.0 ) then ntries = ntries + 1 print "(a,i1,a)",' error parsing function string: try again (',ntries,' of 3)' if (ntries.eq.3) then iask = .false. call prompt(' Cannot parse function (after 3 attempts). Set as inactive function anyway?',iask) if (iask) then ierr = 0 else calcstring(i) = ' ' endif endif else write(*,"(a)",advance='no') 'Function parses OK: ' required(ncolumns+i) = .true. endif if (ierr.eq.0) then ! !--prompt for label if not set ! if (iequal.eq.0) then call prompt(' Enter label for this quantity ',calclabel(i),noblank=.true.) endif if (iRescale) then call prompt(' Enter units label for this quantity ',calcunitslabel(i)) endif !print "(a,a,i2,/)",'Setting '//trim(calclabel(i)), & ! ' = '//trim(calcstring(i))//' in column ',ncolumns+i ncalc = i i = i + 1 endif endif enddo overfuncs end subroutine add_calculated_quantities !--------------------------------------------------------------------- ! ! utility to split input string into label and function at the ! equals sign ! !--------------------------------------------------------------------- subroutine splitstring(string,calclabel,calcstring) implicit none character(len=*), intent(in) :: string character(len=*), intent(inout) :: calclabel character(len=*), intent(out) :: calcstring integer :: iequal iequal = index(string,'=') if (iequal.ne.0) then calclabel = string(1:iequal-1) calcstring = string(iequal+1:len_trim(string)) else calcstring = trim(string) endif !--remove preceding spaces calcstring = trim(adjustl(calcstring)) end subroutine splitstring !--------------------------------------------------------------------- ! ! utility to give a nice list of examples to follow / cut and paste ! [ this basically replaces what was hardwired into the ! old calc_quantities routine ] ! !--------------------------------------------------------------------- subroutine print_example_quantities(ncalc) use labels, only:label,unitslabel,shortlabel,lenlabel,irho,iutherm,iBfirst,& ix,icv,idivB,ih,iradenergy,iamvec,labelvec,idustfrac,ideltav,ivx use settings_data, only:ncolumns,ndim,icoordsnew,ndimV use geometry, only:labelcoord implicit none integer, intent(inout), optional :: ncalc logical :: prefill character(len=lenlabel) :: string,ldfrac,temp,labelprev integer :: i,j,ivecstart,ierr,ilen logical :: gotpmag,gotpressure gotpmag = .false. gotpressure = .false. prefill = .false. if (present(ncalc)) prefill = .true. if (prefill) then print "(/,a)",' Prefilling list with useful quantities from current data...' else print "(/,a)",' Examples based on current data: ' endif !--radius string = ' ' if (ndim.gt.0 .and. icoordsnew.eq.1 .and. ncolumns.ge.ndim) then write(string,"(a)") 'r = sqrt(('// & trim(shortlabel(label(ix(1)),unitslabel(ix(1))))//'-'//trim(labelcoord(1,1))//'0)**2' ilen = len_trim(string) if (ndim.gt.1) then write(string(ilen+1:),"(a,a,a)",iostat=ierr) & (' + ('//trim(shortlabel(label(ix(i)),unitslabel(ix(i))))// & '-'//trim(labelcoord(i,1))//'0)**2',i=2,ndim),')' else write(string(ilen+1:),"(a)") ')' endif if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif elseif (ncolumns.ge.2 .and. .not.prefill) then !--if ndim=0 give random example to give at least one print "(11x,a)",trim(shortlabel(label(1)))//'*'//trim(shortlabel(label(2))) endif !--pressure string = ' ' if (irho.gt.0 .and. iutherm.gt.0) then gotpressure = .true. write(string,"(a)",iostat=ierr) & 'pressure = (gamma-1)*'//trim(shortlabel(label(irho),unitslabel(irho)))// & '*'//trim(shortlabel(label(iutherm),unitslabel(iutherm))) if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif endif ! !--one-fluid dust stuff ! if (idustfrac.gt.0 .and. irho.gt.0) then string = ' ' ldfrac = shortlabel(label(idustfrac),unitslabel(idustfrac)) !--gas density write(string,"(a)",iostat=ierr) '\rho_{g} = ' & //trim(shortlabel(label(irho),unitslabel(irho))) & //'*(1 - '//trim(ldfrac)//')' if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) labelprev = calclabel(ncalc) else print "(11x,a)",trim(string) call splitstring(string,labelprev,temp) endif !--dust density write(string,"(a)",iostat=ierr) '\rho_{d} = ' & //trim(ldfrac)//'*'//trim(shortlabel(label(irho),unitslabel(irho))) if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif !--dust-to-gas ratio write(string,"(a)",iostat=ierr) 'dust-to-gas ratio = ' & //trim(ldfrac)//'/(1. - '//trim(ldfrac)//')' if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif if (ideltav.gt.0 .and. ivx.gt.0 .and. ndimV.gt.0) then !--gas velocities do i=1,ndimV write(string,"(a)",iostat=ierr) trim(labelvec(ivx))//'_{gas,'//trim(labelcoord(i,icoordsnew))//'} = ' & //trim(shortlabel(label(ivx + i-1),unitslabel(ivx + i-1))) & //' - r_{dust}/'//trim(shortlabel(label(irho),unitslabel(irho))) & //'*'//trim(shortlabel(label(ideltav + i-1),unitslabel(ideltav + i-1))) if (prefill) then ncalc = ncalc + 1 !if (i.eq.1) labelvec(ncalc) = 'v_{gas}' !iamvec(ncalc) = ncolumns + ncalc - i + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif enddo !--dust velocities do i=1,ndimV write(string,"(a)",iostat=ierr) trim(labelvec(ivx))//'_{dust,'//trim(labelcoord(i,icoordsnew))//'} = ' & //trim(shortlabel(label(ivx + i-1),unitslabel(ivx + i-1))) & //' + r_{gas}/'//trim(shortlabel(label(irho),unitslabel(irho))) & //'*'//trim(shortlabel(label(ideltav + i-1),unitslabel(ideltav + i-1))) if (prefill) then ncalc = ncalc + 1 !if (i.eq.1) labelvec(ncalc) = 'v_{dust}' !iamvec(ncalc) = ncolumns + ncalc - i + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif enddo endif endif ! !--magnitudes of all vector quantities (only if cartesian coords are set) ! ivecstart = 0 if (icoordsnew.eq.1 .and. ndim.gt.0 .and. ndimV.gt.0) then do i=1,ncolumns if (iamvec(i).gt.0 .and. iamvec(i).le.ncolumns .and. iamvec(i).ne.ivecstart) then ivecstart = iamvec(i) string = ' ' write(string,"(a)",iostat=ierr) '|'//trim(labelvec(ivecstart))//'| '// & '= sqrt('//trim(shortlabel(label(ivecstart),unitslabel(ivecstart)))//'**2' ilen = len_trim(string) if (ndimV.gt.1) then write(string(ilen+1:),"(a,a,a)",iostat=ierr) & (' + '//trim(shortlabel(label(j),unitslabel(j)))//'**2',& j=ivecstart+1,ivecstart+ndimV-1),')' else write(string(ilen+1:),"(a)",iostat=ierr) ')' endif if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif endif enddo endif !--magnetic pressure string = ' ' if (ndim.gt.0 .and. ndimV.gt.0 .and. iBfirst.gt.0 .and. icoordsnew.eq.1) then gotpmag = .true. write(string,"(a)",iostat=ierr) & 'P_{mag} = 0.5*('//trim(shortlabel(label(iBfirst),unitslabel(iBfirst)))//'**2' ilen = len_trim(string) if (ndimV.gt.1) then write(string(ilen+1:),"(a,a,a)",iostat=ierr) & (' + '//trim(shortlabel(label(i),unitslabel(i)))//'**2',i=iBfirst+1,iBfirst+ndimV-1),')' else write(string(ilen+1:),"(a)",iostat=ierr) ')' endif if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif endif !--h*div B / B if (ndim.gt.0 .and. ndimV.gt.0 .and. ih.gt.0 .and. iBfirst.gt.0 .and. & icoordsnew.eq.1 .and. idivB.gt.0) then write(string,"(a)",iostat=ierr) & 'h|div B|/|B| = '//trim(shortlabel(label(ih),unitslabel(ih)))//'*abs(' & //trim(shortlabel(label(idivB),unitslabel(idivB)))//')/' & //'sqrt(('//trim(shortlabel(label(iBfirst),unitslabel(iBfirst)))//'^2' ilen = len_trim(string) if (ndimV.gt.1) then write(string(ilen+1:),"(a,a,a)",iostat=ierr) & (' + '//trim(shortlabel(label(i),unitslabel(i)))//'^2',i=iBfirst+1,iBfirst+ndimV-1),'))' else write(string(ilen+1:),"(a)",iostat=ierr) '))' endif if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif endif !--Plasma beta if (ndim.gt.0 .and. ndimV.gt.0 .and. iBfirst.gt.0 .and. gotpmag .and. gotpressure) then write(string,"(a)",iostat=ierr) 'plasma \beta = pressure/P_mag' if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string)//' [ assuming pressure and Pmag calculated ]' endif endif !--gas temperature if cv present if (ndim.gt.0 .and. iutherm.gt.0 .and. icv.gt.0) then string = ' ' write(string,"(a)",iostat=ierr) 'T_{gas} = '//trim(shortlabel(label(iutherm),unitslabel(iutherm)))//'/' & //trim(shortlabel(label(icv),unitslabel(icv))) if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif endif !--radiation temperature if (ndim.gt.0 .and. irho.gt.0 .and. iradenergy.gt.0) then string = ' ' write(string,"(a)",iostat=ierr) 'T_{rad} = ('//trim(shortlabel(label(irho),unitslabel(irho)))//'*' & //trim(shortlabel(label(iradenergy),unitslabel(iradenergy)))//'/7.5646e-15)**0.25' if (prefill) then ncalc = ncalc + 1 call splitstring(string,calclabel(ncalc),calcstring(ncalc)) else print "(11x,a)",trim(string) endif endif if (.not.prefill) print "(a)" end subroutine print_example_quantities !----------------------------------------------------------------- ! ! utility (private) to print the current list of calculated ! quantities, checking that they parse correctly ! !----------------------------------------------------------------- subroutine check_calculated_quantities(ncalcok,ncalctot,incolumn,verbose) use settings_data, only:ncolumns,iRescale use fparser, only:checkf use labels, only:label,unitslabel,shortstring implicit none integer, intent(out) :: ncalcok,ncalctot integer, dimension(maxcalc), intent(out), optional :: incolumn logical, intent(in), optional :: verbose integer :: i,ierr,nvars,indexinactive character(len=lenvars), dimension(maxplot+nextravars) :: vars logical :: isverbose if (present(verbose)) then isverbose = verbose else isverbose = .true. endif ncalcok = 0 ncalctot = 0 indexinactive = 0 i = 1 if (present(incolumn)) incolumn(:) = 0 if (isverbose) print "(/,a)", ' Current list of calculated quantities:' do while(i.le.maxcalc .and. len_trim(calcstring(i)).ne.0) ! !--get the list of valid variable names for this column ! call get_variables(ncolumns+ncalcok,nvars,vars) ! !--check that the function parses ! ierr = checkf(shortstring(calcstring(i)),vars(1:nvars),Verbose=.false.) if (ierr.eq.0) then ncalcok = ncalcok + 1 if (isverbose) then print "(1x,i2,') ',a50,' [OK]')",ncolumns+ncalcok,trim(calclabel(i))//' = '//calcstring(i) endif if (present(incolumn)) incolumn(i) = ncolumns + ncalcok ! !--set the label for the proposed column here ! so that subsequent calculations can use this variable ! (note that we don't need to set the units label here ! as this is done in the actual calc_quantities call) ! label(ncolumns+ncalcok) = trim(calclabel(i)) unitslabel(ncolumns+ncalcok) = trim(calcunitslabel(i)) if (iRescale) label(ncolumns+ncalcok) = trim(label(ncolumns+ncalcok))//trim(unitslabel(ncolumns+ncalcok)) else indexinactive = indexinactive - 1 if (isverbose) then print "(i3,') ',a50,' [INACTIVE]')",indexinactive,trim(calclabel(i))//' = '//calcstring(i) endif if (present(incolumn)) incolumn(i) = indexinactive endif ncalctot = i i = i + 1 enddo if (ncalcok.eq.0 .and. isverbose) print "(a)",' (none)' end subroutine check_calculated_quantities !----------------------------------------------------------------- ! ! utility (private) to check dependencies of calculated ! quantities, so that we only read what is necessary ! from the dump file ! !----------------------------------------------------------------- subroutine get_calc_data_dependencies(required) use params, only:maxplot use settings_data, only:debugmode use fparser, only:checkf use labels, only:label,shortlabel,shortstring logical, dimension(0:maxplot), intent(inout) :: required character(len=lenvars), dimension(maxplot+nextravars) :: vars integer, dimension(maxcalc) :: incolumn integer :: ncalcok,ncalctot,nvars,i,j call check_calculated_quantities(ncalcok,ncalctot,incolumn,verbose=.false.) do i=ncalctot,1,-1 ! go in REVERSE order to get recursive dependencies properly if (incolumn(i).gt.0) then if (required(incolumn(i))) then if (debugmode) then print*,'DEBUG: computing dependencies for '//trim(label(incolumn(i)))//& ' = '//trim(shortstring(calcstring(i))) endif ! !--get the list of valid variable names for this column ! call get_variables(incolumn(i),nvars,vars) ! !--check if the string contains any preceding variables ! do j=1,incolumn(i)-1 ! !--this could be smarter here (at the moment we just check for ! matching substrings, but we should check for the use of the ! string as an actual variable -- this is mainly an issue for ! single letter variables like x,y,z etc) ! if (index(shortlabel(calcstring(i)),trim(vars(j))).ne.0) then if (debugmode) print*,'DEBUG: -> depends on '//trim(label(j)) required(j) = .true. endif enddo endif endif enddo end subroutine get_calc_data_dependencies !----------------------------------------------------------------- ! ! actually compute the extra quantities from the particle data ! !----------------------------------------------------------------- subroutine calc_quantities(ifromstep,itostep,dontcalculate) use labels, only:label,unitslabel,labelvec,iamvec,ix,ivx,shortstring use particle_data, only:dat,npartoftype,gamma,time,maxpart,maxstep,maxcol,iamtype use settings_data, only:ncolumns,ncalc,iRescale,xorigin,debugmode,ndim,required,iverbose, & icoords,icoordsnew,ipartialread,itracktype,itrackoffset use mem_allocation, only:alloc use settings_units, only:units use fparser, only:checkf,parsef,evalf,EvalerrMsg,EvalErrType,rn,initf,endf use params, only:maxplot use timing, only:wall_time,print_time use geomutils, only:change_coords use part_utils, only:get_tracked_particle implicit none integer, intent(in) :: ifromstep, itostep logical, intent(in), optional :: dontcalculate integer :: i,j,ncolsnew,ierr,icalc,ntoti,nvars,ncalctot,nused,itrackpart logical :: skip ! real, parameter :: mhonkb = 1.6733e-24/1.38e-16 ! real, parameter :: radconst = 7.5646e-15 ! real, parameter :: lightspeed = 3.e10 ! in cm/s (cgs) real(kind=rn), dimension(maxplot+nextravars) :: vals character(len=lenvars), dimension(maxplot+nextravars) :: vars real, dimension(3) :: x0,v0 real :: t1,t2 ! !--allow dummy call to set labels without actually calculating stuff ! if (present(dontcalculate)) then skip = dontcalculate else skip = .false. endif ierr = 0 ncalc = 0 call check_calculated_quantities(ncalc,ncalctot,verbose=(.not.skip .and. iverbose.gt.0)) if (.not.skip .and. ncalc.gt.0) then nused = 0 if (.not.ipartialread) then ! !--need to be careful if data file has been read fully ! as in this case we also assume all calculated quantities ! have been done. So need to make sure that all quantities ! *are* actually calculated in this case. ! required(:) = .true. endif do i=1,ncalc if (required(ncolumns+i)) nused = nused + 1 enddo if (iverbose > 0) print "(2(a,i2),a,/)",' Calculating ',nused,' of ',ncalctot,' additional quantities...' endif ncolsnew = ncolumns + ncalc if (ncolsnew.gt.maxcol) call alloc(maxpart,maxstep,ncolsnew) ! !--reset iamvec to zero for calculated columns ! iamvec(ncolumns+1:ncolsnew) = 0 labelvec(ncolumns+1:ncolsnew) = ' ' ! !--evaluate functions in turn ! if (.not.skip .and. ncalc.gt.0) then call initf(ncalc) ! !--compile each function into bytecode ! icalc = 1 do i=1,maxcalc if (icalc.le.ncalc) then ! !--get the list of valid variable names for this column ! call get_variables(ncolumns+icalc-1,nvars,vars) ! !--now actually parse the function ! call parsef(icalc,shortstring(calcstring(i)),vars(1:nvars),err=ierr,Verbose=.false.) if (ierr.eq.0) then icalc = icalc + 1 endif endif enddo ! !--evaluate functions from particle data ! call wall_time(t1) do i=ifromstep,itostep ntoti = SUM(npartoftype(:,i)) ! !--set origin position ! v0(:) = 0. itrackpart = get_tracked_particle(itracktype,itrackoffset,npartoftype(:,i),iamtype(:,i)) if (itrackpart.gt.0 .and. itrackpart.le.ntoti) then x0(:) = 0. if (ix(1).gt.0 .and. ix(1).le.ncolumns) then x0(1) = dat(itrackpart,ix(1),i) else print*,'** internal error: tracking particle set but cannot locate x coordinate' endif if (ix(2).gt.0 .and. ix(2).le.ncolumns) x0(2) = dat(itrackpart,ix(2),i) if (ix(3).gt.0 .and. ix(3).le.ncolumns) x0(3) = dat(itrackpart,ix(3),i) if (i.eq.ifromstep) then print "(a,i10)",' using position of tracked particle ',itrackpart print "(a,3(e11.3),/)",' (x0,y0,z0) = ',dat(itrackpart,ix(1:ndim),i) endif if (ivx.gt.0 .and. ivx+ndim-1.le.ncolumns) then v0(1:ndim) = dat(itrackpart,ivx:ivx+ndim-1,i) endif else x0(:) = xorigin(:) endif do icalc=1,ncalc if (required(ncolumns+icalc)) then if (debugmode) print*,'DEBUG: ',icalc,' calculating '//trim(label(ncolumns+icalc)) ! !--additional settings allowed in function evaluations ! i.e., time and gamma from dump file and current origin settings ! make sure the number here aligns with the "nextravars" setting ! vals(ncolumns+icalc) = time(i) vals(ncolumns+icalc+1) = gamma(i) vals(ncolumns+icalc+2) = x0(1) vals(ncolumns+icalc+3) = x0(2) vals(ncolumns+icalc+4) = x0(3) if (icoordsnew.ne.icoords .and. ndim.gt.0 .and. all(ix(1:ndim).gt.0)) then ! !--if alternative coordinate system is in use, then we need to apply ! the coordinate transformations to the data BEFORE using it ! to calculate additional quantities ! do j=1,ntoti vals(1:ncolumns+icalc-1) = dat(j,1:ncolumns+icalc-1,i) call change_coords(vals(1:ncolumns+icalc-1),ncolumns+icalc-1,ndim,icoords,icoordsnew,x0(1:ndim),v0(1:ndim)) !--evaluate function with transformed values dat(j,ncolumns+icalc,i) = real(evalf(icalc,vals(1:ncolumns+icalc+nextravars-1))) enddo else !!$omp parallel do default(none) private(j,vals) shared(dat,i,icalc,ncolumns) do j=1,ntoti vals(1:ncolumns+icalc-1) = dat(j,1:ncolumns+icalc-1,i) dat(j,ncolumns+icalc,i) = real(evalf(icalc,vals(1:ncolumns+icalc+nextravars-1))) enddo !!$omp end parallel do endif if (EvalErrType.ne.0) then print "(a)",' ERRORS evaluating '//trim(calcstring(icalc))//': ' & //trim(EvalerrMsg()) endif ! !--identify calculated quantities based on the label ! if (i.eq.ifromstep) then call identify_calculated_quantity(label(ncolumns+icalc),ncolumns,ncolumns+icalc) endif else if (debugmode) print*,'DEBUG: ',icalc,' skipping '//trim(label(ncolumns+icalc))//' (not required)' endif enddo enddo call endf call wall_time(t2) if (t2-t1.gt.1.) call print_time(t2-t1) endif ! !--override units of calculated quantities if necessary ! if (iRescale .and. any(abs(units(ncolumns+1:ncolumns+ncalc)-1.0).gt.tiny(0.)) & .and. .not.skip) then !write(*,"(/a)") ' rescaling data...' do i=ncolumns+1,ncolumns+ncalc if (abs(units(i)-1.0).gt.tiny(0.) .and. abs(units(i)).gt.tiny(0.)) then dat(:,i,ifromstep:itostep) = dat(:,i,ifromstep:itostep)*units(i) endif if (index(label(i),trim(unitslabel(i))).eq.0) label(i) = trim(label(i))//trim(unitslabel(i)) enddo elseif (iRescale) then do i=ncolumns+1,ncolumns+ncalc if (index(label(i),trim(unitslabel(i))).eq.0) label(i) = trim(label(i))//trim(unitslabel(i)) enddo endif return end subroutine calc_quantities !----------------------------------------------------------------- ! ! utility (private) to internally identify a calculated quantity ! so that the relevant exact solutions can be plotted for that ! quantity. This is mainly just the radius, but can include ! other things also. ! !----------------------------------------------------------------- subroutine identify_calculated_quantity(labelcol,ncolumns,icolumn) use asciiutils, only:lcase use labels, only:irad,ike,ipr use settings_data, only:debugmode implicit none character(len=*), intent(in) :: labelcol integer, intent(in) :: ncolumns,icolumn ! !--identify quantities based on the label ! only do this if the location flags are not already set ! (e.g. in the data read) - but DO overwrite if they ! are calculated quantities as the locations can change ! select case(lcase(trim(labelcol))) case('r','radius','rad') if (irad.le.0 .or. irad.gt.ncolumns) then irad = icolumn if (debugmode) print "(1x,a,i2,a)",'identifying column ',icolumn,' as the radius' endif case('kinetic energy','ke','1/2 v^2','v^2/2') if (ike.le.0 .or. irad.gt.ncolumns) then ike = icolumn if (debugmode) print "(1x,a,i2,a)",'identifying column ',icolumn,' as the kinetic energy' endif case('pressure','pr','p') if (ipr.le.0 .or. ipr.gt.ncolumns) then ipr = icolumn if (debugmode) print "(1x,a,i2,a)",'identifying column ',icolumn,' as the pressure' endif end select end subroutine identify_calculated_quantity !----------------------------------------------------------------- ! ! utility (private) to fill the array of variable names ! !----------------------------------------------------------------- subroutine get_variables(maxlabel,nvars,variables) use labels, only:label,shortlabel,unitslabel implicit none integer, intent(in) :: maxlabel integer, intent(out) :: nvars character(len=*), dimension(:), intent(out) :: variables integer :: i ! !--can use column labels up to the previous quantity calculated ! variables(:) = ' ' nvars = maxlabel + nextravars do i=1,maxlabel variables(i) = trim(adjustl(shortlabel(label(i),unitslabel(i)))) enddo do i=1,nextravars variables(maxlabel+i) = trim(extravars(i)) enddo end subroutine get_variables !----------------------------------------------------------------- ! ! utility (public) to query whether or not the origin position ! is actually used in the currently set quantities ! !----------------------------------------------------------------- logical function calc_quantities_use_x0() implicit none integer :: i calc_quantities_use_x0 = .false. do i=1,maxcalc if (index(calcstring(i),trim(extravars(3))).gt.0) calc_quantities_use_x0 = .true. if (index(calcstring(i),trim(extravars(4))).gt.0) calc_quantities_use_x0 = .true. if (index(calcstring(i),trim(extravars(5))).gt.0) calc_quantities_use_x0 = .true. enddo end function calc_quantities_use_x0 end module calcquantities splash/src/colourbar.f90000644 000770 000000 00000045343 12375513343 016066 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------ ! Module containing routines related to plotting the colour bar ! in various styles !------------------------------------------------------------------------ module colourbar implicit none integer, parameter, public :: maxcolourbarstyles = 10 character(len=28), dimension(0:maxcolourbarstyles), parameter, public :: & labelcolourbarstyles = (/'no colour bar ', & 'vertical (right hand side) ', & 'horizontal (underneath plot)', & 'plot-hugging vertical ', & 'plot-hugging horizontal ', & 'one-sided vertical ', & 'one-sided horizontal ', & 'floating/inset vertical ', & 'floating/inset horizontal ', & 'custom vertical ', & 'custom horizontal '/) ! !--these are settings that have default values but can ! be changed if required ! real, public :: ColourBarDisp = 5.0 real, public :: ColourBarWidth = 2. ! width in character heights logical, public :: iplotcolourbarlabel = .true. public :: plotcolourbar,incolourbar,incolourbarlabel,barisvertical public :: get_colourbarmargins,isfloating,adjustcolourbar,iscustombar real, private, save :: xlabeloffsetsave = 0. real, parameter, private :: dispall = 0.25 real, public :: ColourBarPosx = 0.01 ! default x pos of short/fat bars real, public :: ColourBarPosy = 0.05 ! default y pos of short/fat bars real, public :: ColourBarLen = 0.25 ! default length of short/fat bars character(len=10), public :: ColourBarFmtStr = 'BCMSTV ' private contains !-------------------------------------------------------- ! this subroutine plots the colour bar in various styles !-------------------------------------------------------- subroutine plotcolourbar(istyle,icolours,datmin,datmax,label,log, & xlabeloffset,vptxminfull,vptxmaxfull,vptyminfull,vptymaxfull) use plotlib, only:plot_set_exactpixelboundaries,plotlib_is_pgplot use plotlib, only:plot_bbuf,plot_ebuf,plot_qwin,plot_qvp,plot_qcs,& plot_svp,plot_swin,plot_imag,plot_box,plot_annotate,plot_gray,& plotlib_extend_pad implicit none integer, intent(in) :: istyle,icolours real, intent(in) :: datmin,datmax,xlabeloffset character(len=*), intent(in) :: label logical, intent(in) :: log real, intent(in), optional :: vptxminfull,vptxmaxfull,vptyminfull,vptymaxfull integer, parameter :: npixwedg = 400 real, dimension(6), parameter :: trans = (/-0.5,1.0,0.0,-0.5,0.0,1.0/) real, dimension(1,npixwedg) :: sampley real, dimension(npixwedg,1) :: samplex integer :: i real :: disp,width,xch,ych,dx real :: xmin,xmax,ymin,ymax,vptxmin,vptxmax,vptymin,vptymax real :: vptxmini,vptxmaxi,vptymini,vptymaxi real :: vptxminp,vptxmaxp,vptyminp,vptymaxp real :: xmaxpix,xminpix,yminpix,ymaxpix ! !--return on style 0 ! if (istyle.le.0) return ! !--set colour bar displacement and width in character heights ! width = ColourBarWidth xlabeloffsetsave = xlabeloffset ! !--start buffering ! call plot_bbuf ! !--query and save current viewport, page and character height settings ! call plot_qwin(xmin,xmax,ymin,ymax) call plot_qvp(0,vptxmin,vptxmax,vptymin,vptymax) call plot_qcs(0,xch,ych) !--if colour bar stretches across multiple plots, ! override settings for vptymin and vptymax with input values if (present(vptxminfull) .and. present(vptxmaxfull) .and. & present(vptyminfull) .and. present(vptymaxfull)) then vptxmini = vptxminfull vptxmaxi = vptxmaxfull vptymini = vptyminfull vptymaxi = vptymaxfull else vptxmini = vptxmin vptxmaxi = vptxmax vptymini = vptymin vptymaxi = vptymax endif ! !--fill array with all values from datmin to datmax ! dx = (datmax-datmin)/real(npixwedg-1) do i=1,npixwedg sampley(1,i) = datmin + (i-1)*dx samplex(i,1) = datmin + (i-1)*dx enddo disp = dispall select case(istyle) !------------------------ ! horizontal colour bar !------------------------ case(2,4,6,8,10) if (istyle.eq.4) disp = 0. ! plot-hugging ! !--set viewport for the wedge ! if (istyle.eq.8 .or. istyle.eq.10) then vptxminp = vptxmini ! to vptxmaxp = vptxmaxi ! avoid vptyminp = vptymini ! compiler vptymaxp = vptymaxi ! warnings call barlimits(vptxmini,vptxmaxi,vptxminp,vptxmaxp,ColourBarPosx,ColourBarLen) call barlimits(vptymini,vptymaxi,vptyminp,vptymaxp,ColourBarPosy,ColourBarLen) vptymaxi = vptymini + width*ych else vptymaxi = vptymini - (disp + xlabeloffset)*ych vptymini = vptymaxi - width*ych endif call plot_svp(vptxmini,vptxmaxi,vptymini,vptymaxi) call plot_set_exactpixelboundaries() ! !--draw colour bar, by cleverly setting window size ! call plot_swin(1.0,real(npixwedg),0.0,1.0) !--check number of pixels in colour bar call plot_qvp(3,xminpix,xmaxpix,yminpix,ymaxpix) if (abs(icolours).gt.0) then ! colour !--check if the colour bar will be more than 1024 pixels if ((xmaxpix-xminpix).le.1024 .or. .not.plotlib_is_pgplot) then ! !--the standard way is to use the default line below ! if (icolours.eq.1) then call plot_gray(samplex,npixwedg,1,1,npixwedg,1,1,datmin,datmax,trans,iextend=plotlib_extend_pad) else call plot_imag(samplex,npixwedg,1,1,npixwedg,1,1,datmin,datmax,trans,iextend=plotlib_extend_pad) endif else ! !--if > 1024 pixels, we instead use the following: ! this is a workaround for a PGPLOT bug with large colour bars ! (> 1024 device pixels long) - plot colour bar in two halves. ! this works up to 2048 pixels, really should divide by n. ! call plot_svp(vptxmini,vptxmaxi-0.5*(vptxmaxi-vptxmini),vptymini,vptymaxi) call plot_swin(1.0,real(npixwedg/2),0.0,1.0) call plot_set_exactpixelboundaries() call plot_imag(samplex,npixwedg,1,1,npixwedg/2,1,1,datmin,datmax,trans) call plot_svp(vptxmaxi-0.5*(vptxmaxi-vptxmini)-0.001,vptxmaxi,vptymini,vptymaxi) call plot_swin(real(npixwedg/2 + 1),real(npixwedg),0.0,1.0) call plot_set_exactpixelboundaries() call plot_imag(samplex,npixwedg,1,npixwedg/2+1,npixwedg,1,1,datmin,datmax,trans) call plot_svp(vptxmini,vptxmaxi,vptymini,vptymaxi) call plot_set_exactpixelboundaries() endif endif call plot_swin(datmin,datmax,0.0,1.0) ! !--draw labelled frame around the wedge ! if (istyle.eq.10) then call plot_box(ColourBarFmtStr,0.0,0,'BC',0.0,0) elseif (istyle.eq.4 .or. istyle.eq.6 .or. istyle.eq.8) then call plot_box('BNST',0.0,0,'BC',0.0,0) if (istyle.eq.6 .or. istyle.eq.8) call plot_box('C',0.0,0,' ',0.0,0) else call plot_box('BCNST',0.0,0,'BC',0.0,0) endif ! !--write the units label: the position is relative to the bottom of ! the wedge because of the way we have defined the viewport. ! For the horizontal colour bar this never needs to change ! (0.25 space + 1 character height for numeric labels + 0.25 space ! + 1 character height for actual label = 2.5 character heights) ! if (len_trim(label).gt.0 .and. iplotcolourbarlabel) then call plot_annotate('B',2.5,0.5,0.5,trim(label)) endif !------------------------------- ! vertical colour bar (default) !------------------------------- case default if (istyle.eq.3) disp = 0. ! plot-hugging ! !--set viewport for the wedge ! if (istyle.eq.7 .or. istyle.eq.9) then vptxminp = vptxmini ! to vptxmaxp = vptxmaxi ! avoid vptyminp = vptymini ! compiler vptymaxp = vptymaxi ! warnings call barlimits(vptxmini,vptxmaxi,vptxminp,vptxmaxp,ColourBarPosx,ColourBarLen) call barlimits(vptymini,vptymaxi,vptyminp,vptymaxp,ColourBarPosy,ColourBarLen) vptxmaxi = vptxmini + width*xch else vptxmini = vptxmaxi + disp*xch vptxmaxi = vptxmini + width*xch endif call plot_svp(vptxmini,vptxmaxi,vptymini,vptymaxi) call plot_set_exactpixelboundaries() ! !--draw colour bar, by cleverly setting window size ! call plot_swin(0.0,1.0,1.0,real(npixwedg)) if (icolours.eq.1) then ! greyscale call plot_gray(sampley,1,npixwedg,1,1,1,npixwedg,datmin,datmax,trans,iextend=plotlib_extend_pad) elseif (abs(icolours).gt.0) then ! colour call plot_imag(sampley,1,npixwedg,1,1,1,npixwedg,datmin,datmax,trans,iextend=plotlib_extend_pad) endif call plot_swin(0.0,1.0,datmin,datmax) ! !--draw labelled frame around the wedge ! if (istyle.eq.9) then call plot_box('BC',0.0,0,ColourBarFmtStr,0.0,0) elseif (istyle.eq.3 .or. istyle.eq.5 .or. istyle.eq.7) then call plot_box('BC',0.0,0,'CMSTV',0.0,0) if (istyle.eq.5 .or. istyle.eq.7) call plot_box(' ',0.0,0,'B',0.0,0) else call plot_box('BC',0.0,0,'BCMSTV',0.0,0) endif ! !--write the units label: the position is relative to the edge of ! the wedge because of the way we have defined the viewport. ! For the vertical colour bar ColourBarDisp is a set by default to ! the maximum size for the numeric label (written horizontally) - ! this is about 4 character heights for something like "-5 x 10^10" ! We allow the user to adjust this parameter to bring the label ! closer where the numeric labels are smaller (e.g. "-5"). ! if (len_trim(label).gt.0 .and. iplotcolourbarlabel) then call plot_annotate('R',ColourBarDisp+0.75,1.0,1.0,trim(label)) endif end select ! !--reset window and viewport ! call plot_svp(vptxmin,vptxmax,vptymin,vptymax) call plot_swin(xmin,xmax,ymin,ymax) call plot_ebuf return end subroutine plotcolourbar !------------------------------------------------------- ! query function to see if colour bar is plotted ! vertically or horizontally for a given style !------------------------------------------------------- logical function barisvertical(istyle) implicit none integer, intent(in) :: istyle barisvertical = .true. if (istyle.le.0) return select case(istyle) case(2,4,6,8,10) barisvertical = .false. case default barisvertical = .true. end select end function barisvertical !------------------------------------------------------- ! query function to see if a given position on ! the plot should lie within the colour bar or not !------------------------------------------------------- logical function incolourbar(istyle,iunits,xpt,ypt,xmin,xmax,ymin,ymax) use plotlib, only:plot_qcs implicit none integer, intent(in) :: istyle,iunits real, intent(in) :: xpt,ypt,xmin,xmax,ymin,ymax real :: xminbar,xmaxbar,yminbar,ymaxbar,xch,ych,barwidth incolourbar = .false. if (istyle.le.0) return select case(istyle) case(8,10) call barlimits(xminbar,xmaxbar,xmin,xmax,ColourBarPosx,ColourBarLen) call barlimits(yminbar,ymaxbar,ymin,ymax,ColourBarPosy,ColourBarLen) call plot_qcs(iunits,xch,ych) ymaxbar = yminbar + 2.*ColourBarWidth*ych if (iplotcolourbarlabel) then yminbar = yminbar - 3.0*ych else yminbar = yminbar - 2.0*ych endif if ((xpt.ge.xminbar .and. xpt.le.xmaxbar) .and. & (ypt.ge.yminbar .and. ypt.le.ymaxbar)) then incolourbar = .true. endif case(7,9) call barlimits(xminbar,xmaxbar,xmin,xmax,ColourBarPosx,ColourBarLen) call barlimits(yminbar,ymaxbar,ymin,ymax,ColourBarPosy,ColourBarLen) call plot_qcs(iunits,xch,ych) if (iplotcolourbarlabel) then barwidth = (2.*ColourBarWidth+0.75 + max(ColourBarDisp+0.75,0.0))*xch else barwidth = (2.*ColourBarWidth+0.75 + 5.0)*xch endif xmaxbar = xminbar + barwidth if ((xpt.ge.xminbar .and. xpt.le.xmaxbar) .and. & (ypt.ge.yminbar .and. ypt.le.ymaxbar)) then incolourbar = .true. endif case(2,4,6) if (ypt.lt.ymin) incolourbar = .true. case default if (xpt.gt.xmax) incolourbar = .true. end select return end function incolourbar !------------------------------------------------------- ! query function to see if a given position on ! the plot should lie within the colour bar label or not !------------------------------------------------------- logical function incolourbarlabel(istyle,iunits,xpt,ypt,xmin,xmax,ymin,ymax) use plotlib, only:plot_qcs implicit none integer, intent(in) :: istyle,iunits real, intent(in) :: xpt,ypt,xmin,xmax,ymin,ymax real :: xch,ych,disp,xminbar,xmaxbar,yminbar,ymaxbar incolourbarlabel = .false. if (iplotcolourbarlabel) then call plot_qcs(iunits,xch,ych) disp = dispall if (istyle.eq.3 .or. istyle.eq.4) disp = 0. select case(istyle) case(8,10) call barlimits(xminbar,xmaxbar,xmin,xmax,ColourBarPosx,ColourBarLen) if (ypt.lt.(ymin-(disp + xlabeloffsetsave + ColourBarWidth+2.0)*ych) .and. & ypt.gt.(ymin-(disp + xlabeloffsetsave + ColourBarWidth+3.0)*ych) .and. & xpt.gt.xminbar .and. xpt.lt.xmaxbar) incolourbarlabel = .true. case(7,9) call barlimits(yminbar,ymaxbar,ymin,ymax,ColourBarPosy,ColourBarLen) if (xpt.gt.(xmax+(disp + ColourBarWidth-0.25 + max(ColourBarDisp-0.25,0.0))*xch) .and. & xpt.lt.(xmax+(disp + ColourBarWidth+0.75 + max(ColourBarDisp+0.75,0.0))*xch) .and. & ypt.gt.yminbar .and. ypt.lt.ymaxbar) incolourbarlabel = .true. case(2,4,6) if (ypt.lt.(ymin-(disp + xlabeloffsetsave + ColourBarWidth+2.0)*ych) .and. & ypt.gt.(ymin-(disp + xlabeloffsetsave + ColourBarWidth+3.0)*ych)) incolourbarlabel = .true. case default if (xpt.gt.(xmax+(disp + ColourBarWidth-0.25 + max(ColourBarDisp-0.25,0.0))*xch) .and. & xpt.lt.(xmax+(disp + ColourBarWidth+0.75 + max(ColourBarDisp+0.75,0.0))*xch)) incolourbarlabel = .true. end select endif return end function incolourbarlabel !------------------------------------------ ! utility function to avoid repeated code !------------------------------------------ subroutine barlimits(barmin,barmax,posmin,posmax,pos,barlen) implicit none real, intent(out) :: barmin,barmax real, intent(in) :: posmin,posmax,pos,barlen real :: dpos dpos = (posmax - posmin) ! in case posmin and barmin are same variable barmin = posmin + pos*dpos barmax = barmin + barlen*dpos end subroutine barlimits !------------------------------------------------------- ! query function to get margins which should ! be allowed on the page in order to later plot ! the colour bar !------------------------------------------------------- subroutine get_colourbarmargins(istyle,xmaxmargin,yminmargin,barwidth) use plotlib, only:plot_qcs,plot_qvp implicit none integer, intent(in) :: istyle real, intent(inout) :: xmaxmargin,yminmargin real, intent(out) :: barwidth real :: xch,ych,vptxmin,vptxmax,vptymin,vptymax barwidth = 0. if (istyle.le.0) return call plot_qcs(0,xch,ych) call plot_qvp(0,vptxmin,vptxmax,vptymin,vptymax) if (barisvertical(istyle)) then if (iplotcolourbarlabel) then barwidth = (ColourBarWidth+0.75 + max(ColourBarDisp+0.75,0.0))*xch else barwidth = (ColourBarWidth+0.75 + 5.0)*xch endif if (isfloating(istyle)) then barwidth = max((ColourBarPosx-1.) + barwidth,0.) endif xmaxmargin = xmaxmargin + barwidth else if (iplotcolourbarlabel) then barwidth = (ColourBarWidth+3.0)*ych ! ie. width + 2.5 + 0.5 margin else barwidth = (ColourBarWidth+2.0)*ych ! ie. width + 1.5 + 0.5 margin endif if (isfloating(istyle)) then barwidth = max(-(ColourBarPosy - (barwidth - ColourBarWidth*ych)),0.) endif yminmargin = yminmargin + barwidth endif return end subroutine get_colourbarmargins !------------------------------------------------------- ! query function for floating colour bar styles !------------------------------------------------------- logical function isfloating(istyle) integer, intent(in) :: istyle select case(istyle) case(7,8,9,10) isfloating = .true. case default isfloating = .false. end select end function isfloating !------------------------------------------------------- ! query function for custom colour bar styles !------------------------------------------------------- logical function iscustombar(istyle) integer, intent(in) :: istyle if (istyle.eq.10 .or. istyle.eq.9) then iscustombar = .true. else iscustombar = .false. endif end function iscustombar !--------------------------------------------------------------------- ! utility function used when interactively changing colour bar limits !--------------------------------------------------------------------- subroutine adjustcolourbar(istyle,xpt1,ypt1,xpt2,ypt2,& xmin,xmax,ymin,ymax,barmin,barmax) implicit none integer, intent(in) :: istyle real, intent(in) :: xpt1,ypt1,xpt2,ypt2,xmin,xmax,ymin,ymax real, intent(inout) :: barmin,barmax real :: dbar,xminbar,xmaxbar,yminbar,ymaxbar if (istyle.eq.8 .or. istyle.eq.10) then !--floating horizontal bar xminbar = xmin + ColourBarPosx*(xmax - xmin) xmaxbar = xminbar + ColourBarLen*(xmax - xmin) else xminbar = xmin xmaxbar = xmax endif if (istyle.eq.7 .or. istyle.eq.9) then !--floating vertical bar yminbar = ymin + ColourBarPosy*(ymax - ymin) ymaxbar = yminbar + ColourBarLen*(ymax - ymin) else yminbar = ymin ymaxbar = ymax endif if (barisvertical(istyle)) then if ((ymaxbar-yminbar).gt.0.) then dbar = (barmax-barmin)/(ymaxbar-yminbar) else dbar = 0. endif barmax = barmin + (max(ypt1,ypt2)-yminbar)*dbar barmin = barmin + (min(ypt1,ypt2)-yminbar)*dbar else if ((xmaxbar-xminbar).gt.0.) then dbar = (barmax-barmin)/(xmaxbar-xminbar) else dbar = 0. endif barmax = barmin + (max(xpt1,xpt2)-xminbar)*dbar barmin = barmin + (min(xpt1,xpt2)-xminbar)*dbar endif end subroutine adjustcolourbar end module colourbar splash/src/colourparts.f90000644 000770 000000 00000003157 11622211702 016434 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- module colourparts implicit none contains subroutine colour_particles(dat,datmin,datmax,icolour,npart) use plotlib, only: plot_qcir implicit none integer, intent(in) :: npart real, dimension(npart), intent(in) :: dat real, intent(in) :: datmin, datmax integer, dimension(npart), intent(out) :: icolour integer :: i,icolourmin,icolourmax,icolourtemp real :: dx call plot_qcir(icolourmin,icolourmax) dx = (datmax - datmin)/real(icolourmax - icolourmin) do i=1,npart icolourtemp = int((dat(i) - datmin)/dx) + icolourmin if (icolourtemp.gt.icolourmax) icolourtemp = icolourmax if (icolourtemp.lt.icolourmin) icolourtemp = icolourmin icolour(i) = icolourtemp enddo return end subroutine colour_particles end module colourparts splash/src/colours.f90000644 000770 000000 00000047155 12022313272 015553 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! This module contains subroutines and variables for setting the ! colour schemes for rendered plots ! module colours implicit none integer, parameter :: ncolourmax = 256 integer, parameter :: ncolourschemes = 33 character(len=17), dimension(ncolourschemes), parameter :: schemename = & (/'greyscale ', & 'red ', & 'Bate red-yellow ', & 'heat ', & 'rainbow ', & 'prism ', & 'red-blue-yellow ', & 'blue-yellow-red ', & 'purple-blue-green', & 'gamma ', & 'gamma- no black ', & 'grn-red-blue-wht ', & 'blk-blu-cyan-yell', & 'rainbow II ', & 'rainbow III ', & 'haze ', & 'huesatval2 ', & 'blue-red ', & 'blue-grn-red-yell', & 'Bate BRY saoimage', & 'ice (blue-white) ', & 'fire ', & 'blue-red ', & 'menacing ', & 'rt ', & 'Dolag I ', & 'Dolag II ', & 'Dolag III ', & 'Alice WBYR ', & 'light blue ', & 'light green ', & 'light red ', & 'CMRmap '/) ! !--rgb colours of the colour table are stored in the array below ! this is used for colour blending (opacity rendering) ! integer :: ifirstcolour, ncolours real, dimension(3,ncolourmax) :: rgbtable contains ! ------------------------------------------------------------------------ ! defines colour schemes for rendering ! ** add your own here ** ! ------------------------------------------------------------------------ subroutine colour_set(icolourscheme) use plotlib, only:plot_qcol,plot_qcir,plot_scir,plot_ctab,plot_scr,plot_qcr use settings_data, only:debugmode implicit none integer, intent(in) :: icolourscheme integer :: i,icolmin,icolmax,ncolmax,nset,index real :: brightness,contrast real, dimension(22) :: lumarr,redarr,greenarr,bluearr ncolours = ncolourmax-1 nset = 0 ! !--set first colour index (warning: colours 1-16 have presets, so ! overwriting these means that line graphs that use colour will come ! out funny). Best to leave 0 and 1 alone as these are black and white. ! ifirstcolour = 2 ! !--inquire as to colour range available on current device ! adjust ncolours if necessary ! call plot_qcol(icolmin,icolmax) ! print*,' from device = ',icolmin,icolmax call plot_qcir(icolmin,icolmax) ! print*,' other = ',icolmin,icolmax if (ifirstcolour.lt.icolmin) ifirstcolour = icolmin ncolmax = icolmax - ifirstcolour if (ncolours.gt.ncolmax) then ncolours = ncolmax print*,'Warning: Device allows only ',ncolours+1,' colours' endif ! !--set this as the range of colour indices to use ! if (debugmode) print*,'DEBUG: querying colour index range' call plot_scir(ifirstcolour,ifirstcolour+ncolours) if (abs(icolourscheme).le.ncolourschemes) then brightness = 0.5 contrast = 1.0 !--invert colour table for negative values if (icolourscheme.lt.0) contrast = -1.0 select case(abs(icolourscheme)) case(1) !--greyscale nset = 2 lumarr(1:nset) = (/0.000,1.000/) redarr(1:nset) = (/0.000,1.000/) greenarr(1:nset)= (/0.000,1.000/) bluearr(1:nset) = (/0.000,1.000/) case(2) !--red temperature (IDL red-temperature) nset = 5 lumarr(1:nset) = (/0.000,0.475,0.694,0.745,1.000/) redarr(1:nset) = (/0.000,0.686,1.000,1.000,1.000/) greenarr(1:nset)= (/0.000,0.004,0.420,0.518,1.000/) bluearr(1:nset) = (/0.000,0.000,0.000,0.000,1.000/) case(3) !--Bate red-yellow-white nset = 4 lumarr(1:nset) = (/0.000,0.337,0.666,1.000/) redarr(1:nset) = (/0.000,1.000,1.000,1.000/) greenarr(1:nset)= (/0.000,0.000,1.000,1.000/) bluearr(1:nset) = (/0.000,0.000,0.000,1.000/) case(4) !--heat nset = 5 lumarr(1:nset) = (/0.,0.25,0.5,0.75,1.0/) redarr(1:nset) = (/0.0,0.0,0.0,1.0,1.0/) greenarr(1:nset)= (/0.0,1.0,1.0,1.0,0.0/) bluearr(1:nset) = (/1.0,1.0,0.0,0.0,0.0/) case(5) !--rainbow nset = 8 lumarr(1:nset) = (/0.0,0.125,0.225,0.25,0.425,0.625,0.8125,1.0/) redarr(1:nset) = (/0.0,0.341,0.100,0.00,0.000,0.000,1.0000,1.0/) greenarr(1:nset)= (/0.0,0.000,0.000,0.00,1.000,1.000,1.0000,0.0/) bluearr(1:nset) = (/0.0,0.569,1.000,1.00,1.000,0.000,0.0000,0.0/) case(6) !--prism (IDL prism) nset = 8 lumarr(1:nset) = (/0.000,0.251,0.263,0.494,0.502,0.749,0.753,1.000/) redarr(1:nset) = (/0.000,0.953,1.000,0.035,0.000,0.000,0.000,0.000/) greenarr(1:nset)= (/0.000,0.000,0.043,0.969,1.000,0.000,0.000,0.000/) bluearr(1:nset) = (/0.000,0.000,0.000,0.000,0.027,0.984,1.000,0.000/) case(7) !--red-blue-yellow (IDL 16: stern special) nset = 7 lumarr(1:nset) = (/0.000,0.055,0.247,0.251,0.502,0.737,1.000/) redarr(1:nset) = (/0.000,0.996,0.000,0.251,0.502,0.737,1.000/) greenarr(1:nset)= (/0.000,0.055,0.247,0.251,0.502,0.737,1.000/) bluearr(1:nset) = (/0.000,0.106,0.490,0.498,1.000,0.000,1.000/) case(8) !--blue-yellow-red (IDL 34: blue-red) nset = 10 lumarr(1:nset) = (/0.000,0.004,0.125,0.129,0.380,0.384,0.635,0.886,0.996,1.000/) redarr(1:nset) = (/0.000,0.000,0.000,0.000,0.000,0.000,1.000,1.000,0.514,0.514/) greenarr(1:nset)= (/0.000,0.000,0.000,0.000,1.000,1.000,1.000,0.000,0.000,0.000/) bluearr(1:nset) = (/0.514,0.514,1.000,1.000,1.000,1.000,0.000,0.000,0.000,0.000/) ! nset = 6 ! lumarr(1:nset) = (/0.0,0.2,0.4,0.6,0.8,1.0/) ! redarr(1:nset) = (/0.0,0.0,0.5,1.0,1.0,0.5/) ! bluearr(1:nset) = (/1.0,1.0,0.5,0.0,0.0,0.0/) ! greenarr(1:nset)= (/0.0,1.0,0.5,1.0,0.0,0.0/) case(9) !--purple-blue-green nset = 6 lumarr(1:nset) = (/0.0,0.1,0.2,0.5,0.8,1.0/) redarr(1:nset) = (/0.0,0.1,0.5,0.02,0.0,0.0/) bluearr(1:nset) = (/0.0,0.2,0.5,0.98,0.0,0.0/) greenarr(1:nset)= (/0.0,0.0,0.0,0.0,0.62,0.98/) case(10) !--gamma (IDL 6: stdgamma-ii) nset = 18 lumarr(1:nset) =(/0.,0.184,0.192,0.251,0.31,0.376,0.427,0.431,0.443,0.502,0.569,0.624,0.635,0.682,0.69,0.749,0.753,1./) redarr(1:nset) =(/0.,0.000,0.035,0.318,0.31,0.643,0.914,1.000,1.000,1.000,1.000,1.000,1.000,0.639,0.678,0.976,1.00,1./) greenarr(1:nset)=(/0.,0.000,0.000,0.000,0.00,0.000,0.000,0.000,0.000,0.318,0.639,0.639,0.639,0.639,0.639,1.000,1.00,1./) bluearr(1:nset) =(/0.,0.957,1.000,0.682,0.365,0.00,0.000,0.000,0.000,0.000,0.322,0.000,0.000,0.000,0.000,0.188,0.20,1./) case(11) !--gamma but without the fade to black nset = 18 lumarr(1:nset) =(/0.,0.184,0.192,0.251,0.31,0.376,0.427,0.431,0.443,0.502,0.569,0.624,0.635,0.682,0.69,0.749,0.753,1./) redarr(1:nset) =(/0.,0.000,0.035,0.318,0.31,0.643,0.914,1.000,1.000,1.000,1.000,1.000,1.000,0.639,0.678,0.976,1.00,1./) greenarr(1:nset)=(/0.,0.000,0.000,0.000,0.00,0.000,0.000,0.000,0.000,0.318,0.639,0.639,0.639,0.639,0.639,1.000,1.00,1./) bluearr(1:nset) =(/0.5,0.957,1.000,0.682,0.365,0.00,0.000,0.000,0.000,0.000,0.322,0.000,0.000,0.000,0.000,0.188,0.20,1./) case(12) !--IDL 3: grn-red-blu-wht nset = 13 lumarr(1:nset) = (/0.000,0.008,0.047,0.110,0.125,0.267,0.282,0.298,0.773,0.788,0.863,0.988,1.000/) redarr(1:nset) = (/0.000,0.000,0.000,0.000,0.094,0.941,0.988,0.988,0.643,0.639,0.580,0.988,1.000/) greenarr(1:nset)= (/0.000,0.282,0.424,0.988,0.941,0.094,0.000,0.000,0.000,0.000,0.000,0.988,1.000/) bluearr(1:nset) = (/0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.004,0.984,1.000,1.000,1.000,1.000/) case(13) !--black-blue-cyan-yellow nset = 4 lumarr(1:nset) = (/0.,0.333,0.666,1.0/) redarr(1:nset) = (/0.0,0.0,0.0,1.0/) greenarr(1:nset)= (/0.0,0.0,1.0,1.0/) bluearr(1:nset) = (/0.0,1.0,1.0,0.0/) case(14) !--rainbow II (as used in NS merger I) nset = 10 lumarr(1:nset) = (/0.000,0.153,0.157,0.310,0.314,0.467,0.471,0.624,0.627,1.000/) redarr(1:nset) = (/1.000,1.000,0.996,0.016,0.000,0.000,0.000,0.000,0.020,1.000/) greenarr(1:nset)= (/0.000,0.980,1.000,1.000,1.000,1.000,0.984,0.004,0.000,0.000/) bluearr(1:nset) = (/0.000,0.000,0.000,0.000,0.012,0.988,1.000,1.000,1.000,1.000/) case(15) !--rainbow III nset = 13 lumarr(1:nset) = (/0.000,0.004,0.110,0.114,0.333,0.557,0.561,0.565,0.569,0.776,0.780,0.996,1.000/) redarr(1:nset) = (/0.486,0.486,0.012,0.000,0.000,0.004,0.020,0.051,0.055,0.992,1.000,1.000,1.000/) greenarr(1:nset)= (/0.000,0.000,0.000,0.008,0.996,1.000,1.000,1.000,1.000,1.000,0.988,0.020,0.020/) bluearr(1:nset) = (/1.000,1.000,1.000,1.000,1.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000/) case(16) !--haze (IDL 17: haze) ! nset = 11 ! lumarr(1:nset) = (/0.000,0.008,0.016,0.486,0.494,0.502,0.514,0.953,0.961,0.996,1.000/) ! redarr(1:nset) = (/0.655,1.000,0.976,0.047,0.031,0.016,0.027,0.898,0.914,0.984,0.984/) ! greenarr(1:nset)= (/0.439,0.835,0.824,0.161,0.149,0.137,0.122,0.706,0.718,0.765,0.765/) ! bluearr(1:nset) = (/1.000,0.996,0.980,0.510,0.502,0.494,0.482,0.043,0.035,0.000,0.000/) !--without the bottom colour nset = 11 lumarr(1:nset) = (/0.000,0.008,0.016,0.486,0.494,0.502,0.514,0.953,0.961,0.996,1.000/) redarr(1:nset) = (/1.000,1.000,0.976,0.047,0.031,0.016,0.027,0.898,0.914,0.984,0.984/) greenarr(1:nset)= (/0.835,0.835,0.824,0.161,0.149,0.137,0.122,0.706,0.718,0.765,0.765/) bluearr(1:nset) = (/1.000,0.996,0.980,0.510,0.502,0.494,0.482,0.043,0.035,0.000,0.000/) case(17) !--huesatval nset = 11 lumarr(1:nset) = (/0.000,0.506,0.514,0.675,0.682,0.843,0.851,0.961,0.969,0.996,1.000/) redarr(1:nset) = (/1.000,0.494,0.486,0.329,0.345,0.988,1.000,1.000,1.000,1.000,1.000/) greenarr(1:nset)= (/0.992,0.992,1.000,1.000,1.000,1.000,0.969,0.345,0.294,0.114,0.114/) bluearr(1:nset) = (/0.992,1.000,0.980,0.337,0.322,0.161,0.153,0.043,0.035,0.008,0.008/) case(18) !--blue-red2 (IDL 12: blue-red) nset = 10 lumarr(1:nset) = (/0.000,0.016,0.247,0.255,0.498,0.506,0.749,0.757,0.996,1.000/) redarr(1:nset) = (/0.000,0.000,0.000,0.000,0.000,0.016,1.000,1.000,1.000,1.000/) greenarr(1:nset)= (/0.000,0.016,1.000,0.984,0.000,0.000,0.000,0.000,0.000,0.000/) bluearr(1:nset) = (/0.000,0.016,1.000,1.000,1.000,1.000,1.000,0.984,0.000,0.000/) case(19) !--blue-green-red-yellow (IDL 5: blue-green-red-yellow) nset = 8 lumarr(1:nset) = (/0.000,0.125,0.188,0.314,0.439,0.502,0.565,1.000/) redarr(1:nset) = (/0.000,0.000,0.000,0.000,0.000,0.471,0.784,1.000/) greenarr(1:nset)= (/0.000,0.000,0.196,0.588,0.549,0.392,0.000,1.000/) bluearr(1:nset) = (/0.000,0.259,0.392,0.392,0.000,0.000,0.000,0.000/) case(20) !--Bate BRY saoimage nset = 5 lumarr(1:nset) = (/0.000,0.25,0.50,0.75,1.00/) redarr(1:nset) = (/0.000,0.00,1.00,1.00,1.00/) greenarr(1:nset)= (/0.000,0.00,0.00,1.00,1.00/) bluearr(1:nset) = (/0.000,1.00,0.00,0.00,1.00/) ! !--Bate BRY original ! nset = 5 ! lumarr(1:nset) = (/0.000,0.195,0.586,0.781,1.00/) ! redarr(1:nset) = (/0.000,0.000,1.000,1.000,1.00/) ! greenarr(1:nset)= (/0.000,0.000,0.000,1.000,1.00/) ! bluearr(1:nset) = (/0.000,1.000,0.000,0.000,1.00/) case(21) !--ice blue (IDL blue-white) nset = 5 lumarr(1:nset) = (/0.000,0.376,0.737,0.753,1.000/) redarr(1:nset) = (/0.000,0.000,0.000,0.000,1.000/) greenarr(1:nset)= (/0.000,0.000,0.580,0.604,1.000/) bluearr(1:nset) = (/0.000,0.510,1.000,1.000,1.000/) case(22) !--fire (from FLASH code) nset = 6 lumarr(1:nset) = (/0.000,0.016,0.078,0.643,0.800,1.000/) redarr(1:nset) = (/1.000,1.000,1.000,1.000,0.000,0.973/) greenarr(1:nset)= (/0.000,0.039,0.129,0.957,0.357,0.980/) bluearr(1:nset) = (/0.000,0.000,0.000,0.000,0.000,0.973/) case(23) !--blue-red (from FLASH code) nset = 7 lumarr(1:nset) = (/0.000,0.149,0.345,0.541,0.643,0.769,1.000/) redarr(1:nset) = (/0.000,0.000,0.157,0.792,0.894,0.988,0.996/) greenarr(1:nset)= (/0.063,0.271,0.584,0.800,0.427,0.220,0.004/) bluearr(1:nset) = (/0.173,0.722,0.153,0.153,0.082,0.165,0.000/) case(24) !--menacing (from FLASH code) nset = 22 lumarr(1:nset) = (/0.000,0.078,0.133,0.161,0.169,0.263,0.271,0.302, & 0.357,0.455,0.478,0.514,0.545,0.588,0.612,0.624, & 0.643,0.722,0.749,0.796,0.808,1.000/) redarr(1:nset) = (/0.388,1.000,0.757,0.953,0.949,0.859,0.906,1.000, & 1.000,0.196,0.098,0.004,0.000,0.000,0.000,0.000, & 0.000,0.051,0.278,0.561,0.612,0.988/) greenarr(1:nset)= (/0.000,0.000,0.118,0.318,0.306,0.749,0.792,1.000, & 1.000,0.490,0.420,0.220,0.125,0.906,0.718,0.569, & 0.000,0.000,0.004,0.008,0.000,0.973/) bluearr(1:nset) = (/0.000,0.000,0.024,0.051,0.059,0.173,0.157,0.000, & 0.000,0.086,0.063,0.004,0.000,0.941,0.827,0.725, & 0.322,0.302,0.518,0.635,0.600,0.988/) case(25) !--RT (from FLASH code) nset = 6 lumarr(1:nset) = (/0.000,0.455,0.580,0.765,0.773,1.000/) redarr(1:nset) = (/0.220,1.000,1.000,1.000,1.000,1.000/) greenarr(1:nset)= (/0.000,0.000,0.478,0.980,1.000,1.000/) bluearr(1:nset) = (/0.000,0.000,0.000,0.588,0.608,0.737/) case(26) ! !--these are Klaus Dolag colour schemes nset = 3 !--blue-green-red ("highlight") lumarr(1:nset) = (/0.0,0.5,1.0/) redarr(1:nset) = (/0.0,0.5,1.0/) greenarr(1:nset) = (/0.0,1.0,0.0/) bluearr(1:nset) = (/1.0,0.5,0.0/) case(27) nset = 3 !--red-greeny-blue lumarr(1:nset) = (/0.0,0.5,1.0/) redarr(1:nset) = (/1.0,0.66,0.0/) greenarr(1:nset) = (/0.0,0.66,0.0/) bluearr(1:nset) = (/0.0,0.66,1.0/) case(28) nset = 5 !--dolag other lumarr(1:nset) = (/0.0,0.33,0.5,0.66,1.0/) redarr(1:nset) = (/0.0,1.00,0.5,0.00,1.0/) greenarr(1:nset) = (/0.0,0.66,1.0,0.66,0.0/) bluearr(1:nset) = (/1.0,0.66,0.5,0.33,0.0/) case(29) !--Alice WBYR nset = 12 lumarr(1:nset) = (/0.0,0.002,0.00672,0.01344,0.40824,0.41496,0.42168,0.43176,0.80052,0.80724,0.84,1.0/) redarr(1:nset) = (/1.0,1.0,1.0,0.976,0.047,0.031,0.016,0.027,0.898,0.914,0.984,0.996/) greenarr(1:nset) = (/1.0,0.835,0.835,0.824,0.161,0.149,0.137,0.122,0.706,0.718,0.765,0.055/) bluearr(1:nset) = (/1.0,1.0,0.996,0.980,0.510,0.502,0.494,0.482,0.043,0.035,0.0,0.0/) case(30) nset = 6 !--light blue lumarr(1:nset) = (/0.0,0.125,0.25,0.5,0.75,1.0/) redarr(1:nset) = (/0.000,0.00,0.00,0.300,0.700,1.000/) greenarr(1:nset) = (/0.145,0.25,0.36,0.612,0.816,1.000/) bluearr(1:nset) = (/0.350,0.54,0.65,0.800,0.918,1.000/) case(31) nset = 6 !--light green lumarr(1:nset) = (/0.0,0.125,0.25,0.5,0.75,1.0/) redarr(1:nset) = (/0.00,0.0,0.075,0.37,0.73,1.000/) greenarr(1:nset) = (/0.20,0.353,0.471, 0.718,0.895,1.000/) bluearr(1:nset) = (/0.082,0.13,0.21, 0.384,0.700,1.000/) case(32) !--light red nset = 7 lumarr(1:nset) = (/0.00,0.13,0.25,0.4,0.50,0.75,1.00/) redarr(1:nset) = (/0.44,0.60,0.84,1.0,1.00,1.00,1.00/) greenarr(1:nset)= (/0.11,0.15,0.21,0.35,0.50,0.75,1.00/) bluearr(1:nset) = (/0.00,0.00,0.00,0.00,0.15,0.55,1.00/) case(33) nset = 9 !--from Carey Rappaport ! "A colormap for effective black and white rendering of color scale images" ! IEEE Antennas Propagat. Mag. vol. 44, no. 3, pp 94-96, Jun 2002. lumarr(1:nset) = (/0.0,0.125,0.25,0.375,0.5,0.625,0.75,0.875,1.0/) redarr(1:nset) = (/0.00,0.15,0.30,0.60,1.00,0.90,0.90,0.90,1.00/) greenarr(1:nset) = (/0.00,0.15,0.15,0.20,0.25,0.50,0.75,0.90,1.00/) bluearr(1:nset) = (/0.00,0.50,0.75,0.50,0.15,0.00,0.10,0.50,1.00/) end select if (debugmode) print*,'DEBUG: setting colour table' call plot_ctab(lumarr(1:nset),redarr(1:nset),greenarr(1:nset),bluearr(1:nset), & nset,contrast,brightness) endif ! !--if icolourscheme = ncolourschemes+1 set the PGPLOT colour indices ! from the contents of the rgbtable array ! if (abs(icolourscheme).eq.ncolourschemes+1) then call plot_scir(ifirstcolour,ifirstcolour+ncolourmax) do i=1,ncolourmax index = ifirstcolour + (i-1) call plot_scr(index,rgbtable(1,i),rgbtable(2,i),rgbtable(3,i)) enddo print "(1x,a)",'using colour scheme other' elseif (abs(icolourscheme).le.ncolourschemes) then ! !--also store the colour table as a list of r,g,b values ! if (debugmode) print*,'DEBUG: querying colour table' do i=1,ncolours+1 index = ifirstcolour + (i-1) call plot_qcr(index,rgbtable(1,i),rgbtable(2,i),rgbtable(3,i)) enddo if (icolourscheme.lt.0) then print "(1x,a)",'using colour scheme inverse '//trim(schemename(abs(icolourscheme))) else print "(1x,a)",'using colour scheme '//trim(schemename(icolourscheme)) endif else print "(1x,a)",'warning: unknown colour scheme - uses default greyscale' endif if (debugmode) print*,'DEBUG: finished colour_set' return end subroutine colour_set !------------------------------------------------ ! demonstration plot of all the colour schemes !------------------------------------------------ subroutine colour_demo implicit none ! integer :: i,j,nc ! !--npixx should be >= ncolours in setcolours.f ! ! integer, parameter :: npixx = ncolourmax ! integer, parameter :: npixy = npixx/10 ! real, dimension(npixx,npixy) :: sample ! real :: xmin,xmax,ymin,ymax,dx,dy,trans(6) ! character(len=10) :: string ! call pgbegin(0,'?',1,ncolourschemes) !! call pgpaper(6.0,8.0) !!!0.25/sqrt(2.)) ! xmin = 0.0 ! xmax = 1.0 ! ymin = 0.0 ! ymax = 0.1 ! dx = (xmax-xmin)/float(npixx) ! dy = (ymax-ymin)/float(npixy) ! trans(1) = xmin - 0.5*dx ! trans(2) = dx ! trans(3) = 0.0 ! trans(4) = ymin - 0.5*dy ! trans(5) = 0.0 ! trans(6) = dy ! do j=1,npixy ! do i=1,npixx ! sample(i,j) = (i-1)*dx ! enddo ! enddo !! call pgsch(2.0) !! call pgenv(xmin,xmax,ymin,ymax,0,-1) !! call pgsch(1.0) !! call pggray(sample,npixx,npixy,1,npixx,1,npixy, & !! minval(sample),maxval(sample),trans) !! call pgnumb(1,0,0,string,nc) !! call pgsch(7.0) !! call pgmtxt('t',0.5,0.5,0.5,string(1:nc)//': '//trim(schemename(1))) ! do i=1,ncolourschemes ! call pgsch(2.0) ! call pgenv(xmin,xmax,ymin,ymax,0,-1) ! call pgsch(7.0) ! call pgnumb(i,0,0,string,nc) ! call pgmtxt('t',0.5,0.5,0.5,string(1:nc)//': '//trim(schemename(i))) ! call colour_set(i) ! call pgimag(sample,npixx,npixy,1,npixx,1,npixy, & ! minval(sample),maxval(sample),trans) ! enddo ! call pgsch(1.0) ! call pgend end subroutine colour_demo end module colours splash/src/contours.f90000644 000770 000000 00000004013 11622150512 015724 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2011 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! ! This module contributed by Andrew McLeod !----------------------------------------------------------------- module contours_module implicit none integer, parameter, private :: maxcontours = 50 integer, parameter, public :: lencontourtitles = 60 real, dimension(maxcontours), public :: contours_list character(len=lencontourtitles), dimension(maxcontours), public :: contourtitles logical, public :: fixed_contours public :: read_contours private contains ! !--reads a list of contours (one per line), to be used on contour plots ! subroutine read_contours(ncontours,ierr) use asciiutils, only:read_asciifile use filenames, only:fileprefix implicit none integer, intent(out) :: ncontours, ierr character(len=50) :: contourfile logical :: iexist contourfile = trim(fileprefix)//'.contours' ncontours = 0 ierr = 0 inquire(file=contourfile,exist=iexist) if (iexist) then call read_asciifile(contourfile,ncontours,contours_list,contourtitles) else contours_list(:) = 0. contourtitles(:) = '' ierr = 1 endif if (ncontours.gt.0) then print "(1x,a)",'read contours and titles from file '//trim(contourfile) else ierr = -1 endif return end subroutine read_contours end module contours_module splash/src/convert.f90000644 000770 000000 00000011441 12160063531 015535 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! interface routine to convert all of the dump files ! on the SPLASH command line to a specified output format ! ! (c) D. Price 22/01/08 !----------------------------------------------------------------- module convert implicit none contains subroutine convert_all(outformat,igotfilenames,useall) use particle_data, only:time,gamma,dat,npartoftype,masstype,iamtype use settings_data, only:ncolumns,ncalc,required,ntypes,ndim,ndimV,lowmemorymode use filenames, only:rootname,nstepsinfile,nfiles,limitsfile use write_sphdata, only:write_sphdump use readwrite_griddata, only:isgridformat use analysis, only:isanalysis,open_analysis,write_analysis,close_analysis use convert_grid, only:convert_to_grid use getdata, only:get_data use asciiutils, only:ucase use limits, only:read_limits implicit none character(len=*), intent(in) :: outformat logical, intent(inout) :: igotfilenames logical, intent(in) :: useall logical :: doanalysis,converttogrid integer :: ifile,idump,ntotal,ierr character(len=len(rootname)+4) :: filename character(len=10) :: string required = .true. ! read whole dump file by default doanalysis = isanalysis(outformat,noprint=.true.) converttogrid = isgridformat(outformat) lowmemorymode = .false. ! must not be true for first file if (.not.doanalysis) then ! !--for format conversion each dump file is independent ! print "(/,5('-'),a,/)",'> CONVERTING DUMPFILES TO '//trim(ucase(outformat))//' FORMAT ' endif ! !--if nfiles = 0 (ie. no files read from command line), then call get_data here ! to also get nfiles correctly prior to the loop ! if (nfiles.eq.0) then call get_data(1,igotfilenames) igotfilenames = .true. endif do ifile=1,nfiles !--read data from dump file + calculate extra columns if (ifile.eq.1) then call get_data(ifile,igotfilenames,firsttime=.true.) ! ! read plot limits from file (overrides get_data limits settings) ! call read_limits(trim(limitsfile),ierr) ! !--for analysis we need to initialise the output file ! and close it at the end - do this here so we know ! the first filename and ndimV, labels etc. ! if (doanalysis) then call open_analysis(outformat,required,ncolumns+ncalc,ndim,ndimV) endif else call get_data(ifile,.true.) endif !--dump each step in file to an output file do idump = 1,nstepsinfile(ifile) if (idump.gt.1) then write(filename,"(a,'_',i3.3)") rootname(ifile),idump else filename = trim(rootname(ifile)) endif ntotal = sum(npartoftype(1:ntypes,idump)) if (doanalysis) then call write_analysis(time(idump),dat(1:ntotal,:,idump),ntotal,ntypes, & npartoftype(1:ntypes,idump),masstype(1:ntypes,idump),iamtype(:,idump), & ncolumns+ncalc,ndim,ndimV,outformat) elseif (converttogrid) then call convert_to_grid(time(idump),dat(:,:,idump),ntypes,& npartoftype(1:ntypes,idump),masstype(1:ntypes,idump),iamtype(:,idump), & ncolumns+ncalc,filename,outformat,useall) else call write_sphdump(time(idump),gamma(idump),dat(1:ntotal,1:ncolumns+ncalc,idump),ntotal,ntypes, & npartoftype(1:ntypes,idump),masstype(1:ntypes,idump),iamtype(:,idump), & ncolumns+ncalc,filename,outformat) endif enddo enddo !--for analysis we need to start and end differently if (doanalysis) then call close_analysis(outformat) write(string,"(i10)") nfiles print "(/,5('-'),a,i5,a,/)",'> FINISHED CALCULATING '//trim(ucase(outformat))//' (USED '//trim(adjustl(string))//' DUMP FILES)' else print "(/,5('-'),a,/)",'> FINISHED CONVERTING DUMP FILES ' endif return end subroutine convert_all end module convert splash/src/convert_grid.f90000644 000770 000000 00000073766 12430362246 016571 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! Module containing routines for converting 3D SPH dump ! files to 3D gridded data. !----------------------------------------------------------------- module convert_grid private public :: convert_to_grid contains !----------------------------------------------------------------- ! interpolate 3D SPH data to grid and interface to grid ! data output routines !----------------------------------------------------------------- subroutine convert_to_grid(time,dat,ntypes,npartoftype,masstype,itype,ncolumns,filename,& outformat,interpolateall) use labels, only:label,labelvec,irho,ih,ipmass,ix,ivx,iBfirst use limits, only:lim,get_particle_subset use settings_units, only:units,unit_interp use settings_data, only:ndim,ndimV,UseTypeInRenderings,iRescale,required,lowmemorymode,debugmode use settings_part, only:iplotpartoftype use settings_render, only:npix,inormalise_interpolations,idensityweightedinterpolation use params, only:int1 use interpolation, only:set_interpolation_weights use interpolations3D, only:interpolate3D,interpolate3D_vec use interpolations2D, only:interpolate2D,interpolate2D_vec use system_utils, only:lenvironment,renvironment,envlist,lenvstring,ienvstring use readwrite_griddata, only:open_gridfile_w,write_grid use particle_data, only:icolourme use params, only:int8 implicit none integer, intent(in) :: ntypes,ncolumns integer, intent(in), dimension(:) :: npartoftype integer(kind=int1), intent(in), dimension(:) :: itype real, intent(in) :: time real, intent(in), dimension(:,:) :: dat real, intent(in), dimension(:) :: masstype character(len=*), intent(in) :: filename,outformat logical, intent(in) :: interpolateall integer, parameter :: iunit = 89 integer :: ierr,i,k,ncolsgrid,ivec,nvec,iloc,j,nzero integer :: npixx,ntoti,ninterp,nstring character(len=40) :: fmtstring character(len=64) :: fmtstring1 real, dimension(:,:,:), allocatable :: datgrid real, dimension(:,:), allocatable :: datgrid2D real, dimension(:,:,:,:), allocatable :: datgridvec real, dimension(:,:,:), allocatable :: datgridvec2D real, dimension(:), allocatable :: weight real, dimension(3) :: xmin,xmax real, dimension(3) :: partmin,partmax,partmean real, dimension(3) :: datmin,datmax,datmean integer, dimension(3) :: npixels integer(kind=int8), dimension(3) :: npixels8 integer, dimension(12) :: icoltogrid integer :: ncolstogrid,icol real :: hmin,pixwidth,rhominset,rhomin,gridmin,gridmax,gridmean logical :: inormalise,lowmem logical, dimension(3) :: isperiodic character(len=30), dimension(12) :: strings character(len=1), dimension(3), parameter :: xlab = (/'x','y','z'/) ! !--check for errors in input settings ! if (ndim.lt.2 .or. ndim.gt.3) then print "(/,a,i2,a,/)",' ERROR: SPH data has ',ndim,' spatial dimensions: cannot convert to 3D grid' return endif print "(/,'----->',1x,a,i1,a,/)",'CONVERTING SPH DATA -> ',ndim,'D GRID' xmin(1:ndim) = lim(ix(1:ndim),1) xmax(1:ndim) = lim(ix(1:ndim),2) ! !--print limits information ! print "(a)",' grid dimensions:' do i=1,ndim if (maxval(abs(xmax)).lt.1.e7) then print "(1x,a,': ',f14.6,' -> ',f14.6)",trim(label(ix(i))),xmin(i),xmax(i) else print "(1x,a,': ',es14.6,' -> ',es14.6)",trim(label(ix(i))),xmin(i),xmax(i) endif enddo ! !--SPLASH_TO_GRID can be set to comma separated list of columns ! in order to select particular quantities for interpolation to grid ! ncolstogrid = 0 icoltogrid(:) = 0 call envlist('SPLASH_TO_GRID',nstring,strings) if (nstring.gt.0) then do i=1,nstring icol = ienvstring(strings(i)) if (ienvstring(strings(i)).gt.0) then ncolstogrid = ncolstogrid + 1 icoltogrid(ncolstogrid) = icol endif enddo endif ! !--for backwards compatibility, support the SPLASH_TO_GRID_DENSITY_ONLY option ! but only if SPLASH_TO_GRID is not set ! if (ncolstogrid.eq.0 .and. lenvironment('SPLASH_TO_GRID_DENSITY_ONLY')) then ncolstogrid = 1 icoltogrid(1) = irho endif ! !--whether or not to wrap particle contributions across boundaries ! isperiodic(:) = .false. call envlist('SPLASH_TO_GRID_PERIODIC',nstring,strings) if (nstring.gt.ndim) then print "(a)",' ERROR in SPLASH_TO_GRID_PERIODIC setting' nstring = ndim endif do i=1,nstring isperiodic(i) = lenvstring(strings(i)) enddo if (nstring.eq.1) isperiodic(2:ndim) = isperiodic(1) if (all(isperiodic(1:ndim))) then print "(/,a)",' using PERIODIC boundaries (from SPLASH_TO_GRID_PERIODIC setting)' elseif (isperiodic(1) .or. isperiodic(2) .or. isperiodic(3)) then print* do i=1,ndim if (isperiodic(i)) then print "(a)",' using PERIODIC boundaries in '//xlab(i)//' (from SPLASH_TO_GRID_PERIODIC setting)' else print "(a)",' using NON-PERIODIC bounds in '//xlab(i)//' (from SPLASH_TO_GRID_PERIODIC setting)' endif enddo else print "(/,a)",' using NON-PERIODIC boundaries' print "(a)",' (set SPLASH_TO_GRID_PERIODIC=yes for periodic' if (ndim.eq.3) then print "(a)",' or SPLASH_TO_GRID_PERIODIC=yes,no,yes for mixed)' else print "(a)",' or SPLASH_TO_GRID_PERIODIC=yes,no for mixed)' endif endif ierr = 0 do i=1,ndim if ((xmax(i)-xmin(i)).lt.tiny(0.)) then print "(a)",' ERROR: min = max in '//trim(label(ix(i)))//& ' coordinate: cannot interpolate to zero-sized grid!' ierr = 1 endif enddo if (irho.le.0 .or. irho.gt.ncolumns) then print "(a)",' ERROR: density not found in data read.' ierr = 2 endif if (ih.le.0 .or. ih.gt.ncolumns) then print "(a)",' ERROR: smoothing length not found in data read.' ierr = 3 endif if (ipmass.le.0 .or. ipmass.gt.ncolumns) then if (all(masstype(:).lt.tiny(0.))) then print "(a)",' ERROR: particle masses not read as column, and mass per type not set.' ierr = 4 endif endif if (ierr /= 0) then print "(a,i1,a)",' cannot perform SPH interpolation to ',ndim,'D grid, skipping file...' return endif ierr = 0 ! !--set number of particles to use in the interpolation routines ! (by default, only the gas particles) ! ntoti = sum(npartoftype) ninterp = npartoftype(1) if (any(UseTypeInRenderings(2:ntypes).and.iplotpartoftype(2:ntypes)) & .or. size(itype).gt.1) ninterp = ntoti allocate(weight(ninterp),stat=ierr) if (ierr /= 0) then print*,' ERROR allocating memory for interpolation weights, aborting...' return endif ! !--set interpolation weights (w = m/(rho*h^ndim) ! inormalise = inormalise_interpolations call set_interpolation_weights(weight,dat,itype,(iplotpartoftype .and. UseTypeInRenderings),& ninterp,npartoftype,masstype,ntypes,ncolumns,irho,ipmass,ih,ndim,iRescale,& idensityweightedinterpolation,inormalise,units,unit_interp,required,.false.) ! !--set colours (just in case) ! icolourme(:) = 1 ! !--apply range restrictions to data ! call get_particle_subset(icolourme,dat,ncolumns) ! !--work out how many pixels to use ! npixx = npix if (npixx.le.0) then print "(/,a)",' WARNING: number of pixels = 0, using automatic pixel numbers' hmin = 0. call minmaxmean_part(dat(:,ih:ih),weight,ninterp,partmin,partmax,partmean,nonzero=.true.) hmin = partmin(1) if (hmin.gt.0.) then print*,'based on the minimum smoothing length of hmin = ',hmin npixels8(1:ndim) = int((xmax(1:ndim) - xmin(1:ndim))/hmin,kind=int8) + 1 if (ndim.eq.3) then print "(a,i6,2(' x',i6),a)",' requires ',npixels8(1:ndim),' pixels to capture the full resolution' if (product(npixels8(1:ndim)).gt.512**3 .or. product(npixels8(1:ndim)).le.0) then npixx = 512 print "(a,i4)",' but this is ridiculous, so instead we choose ',npixx else npixx = npixels8(1) endif else print "(a,i6,1(' x',i6),a)",' requires ',npixels8(1:ndim),' pixels to capture the full resolution' if (product(npixels8(1:ndim)).gt.1024**ndim .or. product(npixels8(1:ndim)).le.0) then npixx = 1024 print "(a,i4)",' but this is very large, so instead we choose ',npixx else npixx = npixels8(1) endif endif else npixx = 512 print "(a)",' ...but cannot get auto pixel number because hmin = 0' print "(a)",' so instead we choose npixels = ',npixx endif endif print* pixwidth = (xmax(1)-xmin(1))/npixx npixels(1:ndim) = int((xmax(1:ndim)-xmin(1:ndim) - 0.5*pixwidth)/pixwidth) + 1 ! !--work out how many columns will be written to file ! nvec = 0 if (ncolstogrid.gt.0) then ncolsgrid = ncolstogrid elseif (interpolateall) then ncolsgrid = 0 do i=1,ncolumns if (.not.any(ix(1:ndim).eq.i) .and. i.ne.ih .and. i.ne.ipmass) then ncolsgrid = ncolsgrid + 1 endif enddo else if (ndimV.eq.ndim) then if (ivx.gt.0 .and. ivx+ndimV-1.le.ncolumns) nvec = nvec + 1 if (iBfirst.gt.0 .and. iBfirst+ndimV-1.le.ncolumns) nvec = nvec + 1 endif ncolsgrid = 1 + ndimV*nvec endif ! !--use low memory mode for large grids ! if ((ndim.eq.3 .and. product(npixels).gt.256**3)) then lowmem = .true. else lowmem = lowmemorymode endif if (lowmem .and. nvec.gt.0) & print "(a,/)",' [doing velocity field components separately (low memory mode)]' ! !--allocate memory for the grid ! if (allocated(datgrid)) deallocate(datgrid) if (allocated(datgrid2D)) deallocate(datgrid2D) if (ndim.eq.3) then write(*,"(a,i5,2(' x',i5),a)",advance='no') ' >>> allocating memory for ',npixels(1:ndim),' grid ...' allocate(datgrid(npixels(1),npixels(2),npixels(3)),stat=ierr) elseif (ndim.eq.2) then write(*,"(a,i5,1(' x',i5),a)",advance='no') ' >>> allocating memory for ',npixels(1:ndim),' grid ...' allocate(datgrid2D(npixels(1),npixels(2)),stat=ierr) endif if (ierr /= 0) then write(*,*) 'FAILED: NOT ENOUGH MEMORY' if (allocated(weight)) deallocate(weight) return else write(*,*) 'OK' endif ! !--open grid file for output (also checks format is OK) ! call open_gridfile_w(iunit,filename,outformat,ndim,ncolsgrid,npixels(1:ndim),time,ierr) if (ierr /= 0) then print "(a)",' ERROR: could not open grid file for output, skipping...' if (allocated(datgrid)) deallocate(datgrid) if (allocated(datgrid)) deallocate(datgrid2D) if (allocated(weight)) deallocate(weight) return endif fmtstring1 = "(12x,a20,1x,' min ',1x,' max ',1x,' mean ')" fmtstring = "(22x,a10,1x,3(es10.2,1x))" ! !--interpolate density to the 3D grid ! print "(/,a,i1,a)",' interpolating density to ',ndim,'D grid...' if (debugmode) print*,'DEBUG: density in column ',irho,' vals = ',dat(1:10,irho) call minmaxmean_part(dat(1:ninterp,irho:irho),weight,ninterp,partmin,partmax,partmean) print fmtstring1,trim(label(irho)) print fmtstring,' on parts:',partmin(1),partmax(1),partmean(1) if (ndim.eq.3) then call interpolate3D(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),dat(1:ninterp,ix(3)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,irho),icolourme,ninterp,& xmin(1),xmin(2),xmin(3),datgrid,npixels(1),npixels(2),npixels(3),& pixwidth,pixwidth,inormalise,isperiodic(1),isperiodic(2),isperiodic(3)) ! !--set minimum density on the grid ! call minmaxmean_grid(datgrid,npixels,gridmin,gridmax,gridmean,nonzero=.true.) else call interpolate2D(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,irho),icolourme,ninterp,& xmin(1),xmin(2),datgrid2D,npixels(1),npixels(2),& pixwidth,pixwidth,inormalise,isperiodic(1),isperiodic(2)) ! !--set minimum density on the grid ! call minmaxmean_grid2D(datgrid2D,npixels,gridmin,gridmax,gridmean,nonzero=.true.) endif print fmtstring1,trim(label(irho)) print fmtstring,' on grid :',gridmin,gridmax,gridmean rhomin = gridmin rhominset = renvironment('SPLASH_TO_GRID_RHOMIN',errval=-1.) print* if (rhominset.ge.0.) then rhomin = rhominset print*,'enforcing minimum density on grid = ',rhomin print*,'(based on SPLASH_TO_GRID_RHOMIN setting)' elseif (rhomin.gt.0.) then print*,'enforcing minimum density on grid = ',rhomin print*,'set SPLASH_TO_GRID_RHOMIN=minval to manually set this (e.g. to zero)' endif if (rhomin.gt.0.) then nzero = 0 if (ndim.eq.3) then !$omp parallel do private(k,j,i) reduction(+:nzero) schedule(static) do k=1,npixels(3) do j=1,npixels(2) do i=1,npixels(1) if (datgrid(i,j,k).le.tiny(datgrid)) then datgrid(i,j,k) = rhomin nzero = nzero + 1 endif enddo enddo enddo else !$omp parallel do private(j,i) reduction(+:nzero) schedule(static) do j=1,npixels(2) do i=1,npixels(1) if (datgrid2D(i,j).le.tiny(datgrid2D)) then datgrid2D(i,j) = rhomin nzero = nzero + 1 endif enddo enddo endif print "(a,i8,a)",' minimum density enforced on ',nzero,' grid cells' else print*,'minimum density NOT enforced' endif ! !--write density to grid data file ! print* if (ndim.eq.3) then call write_grid(iunit,filename,outformat,ndim,npixels,trim(label(irho)),& time,pixwidth,xmin,ierr,dat3D=datgrid) else call write_grid(iunit,filename,outformat,ndim,npixels,trim(label(irho)),& time,pixwidth,xmin,ierr,dat2D=datgrid2D) endif ! !--interpolate remaining quantities to the 3D grid ! if (interpolateall .or. ncolstogrid.gt.0) then if (ncolstogrid.gt.0) then print "(/,a,i2,a)",' Interpolating ',ncolstogrid,' columns to grid from SPLASH_TO_GRID setting:' print "(' got SPLASH_TO_GRID=',10(i2,1x))",icoltogrid(1:ncolstogrid) endif do i=1,ncolumns if ((ncolstogrid.gt.0 .and. any(icoltogrid.eq.i) .and. i.ne.irho) .or. & (interpolateall .and. & .not.any(ix(:).eq.i) .and. i.ne.ih .and. i.ne.ipmass .and. i.ne.irho)) then print "(/,a)",' interpolating '//trim(label(i)) print fmtstring1,trim(label(i)) call minmaxmean_part(dat(1:ninterp,i:i),weight,ninterp,partmin,partmax,partmean) print fmtstring,' on parts:',partmin(1),partmax(1),partmean(1) if (iszero(partmin,partmax,1)) then datgrid = 0. else if (ndim.eq.3) then call interpolate3D(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),dat(1:ninterp,ix(3)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,i),icolourme,ninterp,& xmin(1),xmin(2),xmin(3),datgrid,npixels(1),npixels(2),npixels(3),& pixwidth,pixwidth,.true.,isperiodic(1),isperiodic(2),isperiodic(3)) else call interpolate2D(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,i),icolourme,ninterp,& xmin(1),xmin(2),datgrid2D,npixels(1),npixels(2),& pixwidth,pixwidth,.true.,isperiodic(1),isperiodic(2)) endif endif ! !--write gridded data to file ! if (ndim.eq.3) then call minmaxmean_grid(datgrid,npixels,gridmin,gridmax,gridmean,.false.) print fmtstring,' on grid :',gridmin,gridmax,gridmean call write_grid(iunit,filename,outformat,ndim,npixels,trim(label(i)),& time,pixwidth,xmin,ierr,dat3D=datgrid) else call minmaxmean_grid2D(datgrid2D,npixels,gridmin,gridmax,gridmean,.false.) print fmtstring,' on grid :',gridmin,gridmax,gridmean call write_grid(iunit,filename,outformat,ndim,npixels,trim(label(i)),& time,pixwidth,xmin,ierr,dat2D=datgrid2D) endif endif enddo else if (.not.lowmem) then if (allocated(datgrid)) deallocate(datgrid) endif if (nvec.gt.0) then print "(/,a,i2,a)",' set SPLASH_TO_GRID=',irho,' to interpolate density ONLY and skip remaining columns' print "(a,i2,a)", ' SPLASH_TO_GRID=6,8,10 to select particular columns' if (.not.lowmem) then if (ndim.eq.3) then write(*,"(/,a,i5,2(' x',i5),a)",advance='no') ' >>> allocating memory for ',npixels(1:ndim),' x 3 grid ...' allocate(datgridvec(3,npixels(1),npixels(2),npixels(3)),stat=ierr) else write(*,"(/,a,i5,1(' x',i5),a)",advance='no') ' >>> allocating memory for ',npixels(1:ndim),' x 3 grid ...' allocate(datgridvec2D(2,npixels(1),npixels(2)),stat=ierr) endif if (ierr /= 0) then write(*,*) 'FAILED: NOT ENOUGH MEMORY' return else write(*,*) 'OK' endif endif ! !--interpolate velocity field and magnetic fields and write to file ! over_vec: do ivec=1,nvec select case(ivec) case(1) iloc = ivx print "(a,i1,a)",' interpolating velocity field to ',ndim,'D grid...' case(2) iloc = iBfirst print "(a,i1,a)",' interpolating magnetic field to ',ndim,'D grid...' case default iloc = 0 exit over_vec end select if (iloc.le.0 .or. iloc.ge.ncolumns) cycle over_vec if (lowmem) then do i=iloc,iloc+ndimV-1 print "(/,a)",' interpolating '//trim(label(i)) print fmtstring1,trim(label(i)) call minmaxmean_part(dat(1:ninterp,i:i),weight,ninterp,partmin,partmax,partmean) print fmtstring,' on parts:',partmin(1),partmax(1),partmean(1) if (iszero(partmin,partmax,1)) then datgrid = 0. else if (ndim.eq.3) then call interpolate3D(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),dat(1:ninterp,ix(3)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,i),icolourme,ninterp,& xmin(1),xmin(2),xmin(3),datgrid,npixels(1),npixels(2),npixels(3),& pixwidth,pixwidth,.true.,isperiodic(1),isperiodic(2),isperiodic(3)) else call interpolate2D(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,i),icolourme,ninterp,& xmin(1),xmin(2),datgrid2D,npixels(1),npixels(2),& pixwidth,pixwidth,.true.,isperiodic(1),isperiodic(2)) endif endif ! !--write gridded data to file ! if (ndim.eq.3) then call minmaxmean_grid(datgrid,npixels,gridmin,gridmax,gridmean,.false.) print fmtstring,' on grid :',gridmin,gridmax,gridmean call write_grid(iunit,filename,outformat,ndim,npixels,trim(label(i)),& time,pixwidth,xmin,ierr,dat3D=datgrid) else call minmaxmean_grid2D(datgrid2D,npixels,gridmin,gridmax,gridmean,.false.) print fmtstring,' on grid :',gridmin,gridmax,gridmean call write_grid(iunit,filename,outformat,ndim,npixels,trim(label(i)),& time,pixwidth,xmin,ierr,dat2D=datgrid2D) endif enddo else print fmtstring1,trim(labelvec(iloc)) call minmaxmean_part(dat(1:ninterp,iloc:iloc+ndimV-1),weight,ninterp,partmin,partmax,partmean) do i=1,ndimV print fmtstring,' on parts:',partmin(i),partmax(i),partmean(i) enddo if (iszero(partmin,partmax,ndimV)) then datgridvec = 0. else if (ndim.eq.3) then call interpolate3D_vec(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),dat(1:ninterp,ix(3)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,iloc:iloc+ndimV-1),icolourme,ninterp,& xmin(1),xmin(2),xmin(3),datgridvec,npixels(1),npixels(2),npixels(3),& pixwidth,pixwidth,.true.,isperiodic(1),isperiodic(2),isperiodic(3)) else call interpolate2D_vec(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),& dat(1:ninterp,ih),weight(1:ninterp),dat(1:ninterp,iloc),dat(1:ninterp,iloc+1), & icolourme,ninterp,xmin(1),xmin(2),datgridvec2D(1,:,:),datgridvec2D(2,:,:), & npixels(1),npixels(2),pixwidth,pixwidth,.true.,isperiodic(1),isperiodic(2)) endif endif if (ndim.eq.3) then call minmaxmean_gridvec(datgridvec,npixels,ndimV,datmin,datmax,datmean) else call minmaxmean_gridvec2D(datgridvec2D,npixels,ndimV,datmin,datmax,datmean) endif do i=1,ndimV print fmtstring,' on grid :',datmin(i),datmax(i),datmean(i) enddo ! !--write result to grid file ! do i=1,ndimV if (ndim.eq.3) then call write_grid(iunit,filename,outformat,ndim,npixels,& trim(label(iloc+i-1)),time,pixwidth,xmin,ierr,dat3D=datgridvec(i,:,:,:)) else call write_grid(iunit,filename,outformat,ndim,npixels,& trim(label(iloc+i-1)),time,pixwidth,xmin,ierr,dat2D=datgridvec2D(i,:,:)) endif enddo endif print* enddo over_vec endif ! else ! print "(/,a)",' skipping remaining quantities (from SPLASH_TO_GRID_DENSITY_ONLY setting)' endif close(iunit) if (allocated(datgrid)) deallocate(datgrid) if (allocated(datgrid2D)) deallocate(datgrid2D) if (allocated(datgridvec)) deallocate(datgridvec) if (allocated(datgridvec2D)) deallocate(datgridvec2D) if (allocated(weight)) deallocate(weight) return end subroutine convert_to_grid !----------------------------------------------- ! calculate max and min and mean values on grid !----------------------------------------------- subroutine minmaxmean_grid(datgrid,npixels,gridmin,gridmax,gridmean,nonzero) implicit none real, dimension(:,:,:), intent(in) :: datgrid integer, dimension(3), intent(in) :: npixels real, intent(out) :: gridmin,gridmax,gridmean logical, intent(in) :: nonzero real :: dati integer :: i,j,k gridmax = -huge(gridmax) gridmin = huge(gridmin) gridmean = 0. !$omp parallel do schedule(static) & !$omp reduction(min:gridmin) & !$omp reduction(max:gridmax) reduction(+:gridmean) & !$omp private(k,j,i,dati) do k=1,npixels(3) do j=1,npixels(2) do i=1,npixels(1) dati = datgrid(i,j,k) gridmax = max(gridmax,dati) if (nonzero) then if (dati.gt.tiny(0.)) gridmin = min(gridmin,dati) else gridmin = min(gridmin,dati) endif gridmean = gridmean + dati enddo enddo enddo gridmean = gridmean/product(npixels(1:3)) return end subroutine minmaxmean_grid !---------------------------------------------------- ! calculate max and min and mean values on grid (2D) !---------------------------------------------------- subroutine minmaxmean_grid2D(datgrid,npixels,gridmin,gridmax,gridmean,nonzero) implicit none real, dimension(:,:), intent(in) :: datgrid integer, dimension(2), intent(in) :: npixels real, intent(out) :: gridmin,gridmax,gridmean logical, intent(in) :: nonzero real :: dati integer :: i,j gridmax = -huge(gridmax) gridmin = huge(gridmin) gridmean = 0. !$omp parallel do schedule(static) & !$omp reduction(min:gridmin) & !$omp reduction(max:gridmax) reduction(+:gridmean) & !$omp private(j,i,dati) do j=1,npixels(2) do i=1,npixels(1) dati = datgrid(i,j) gridmax = max(gridmax,dati) if (nonzero) then if (dati.gt.tiny(0.)) gridmin = min(gridmin,dati) else gridmin = min(gridmin,dati) endif gridmean = gridmean + dati enddo enddo gridmean = gridmean/product(npixels(1:2)) return end subroutine minmaxmean_grid2D !----------------------------------------------- ! calculate max and min and mean values on grid ! (for vector quantities) !----------------------------------------------- subroutine minmaxmean_gridvec(datgridvec,npixels,jlen,gridmin,gridmax,gridmean) implicit none real, dimension(:,:,:,:), intent(in) :: datgridvec integer, dimension(3), intent(in) :: npixels integer, intent(in) :: jlen real, dimension(jlen), intent(out) :: gridmin,gridmax,gridmean real :: dati integer :: ivec,i,j,k gridmax(:) = -huge(gridmax) gridmin(:) = huge(gridmin) gridmean(:) = 0. !$omp parallel do schedule(static) & !$omp reduction(min:gridmin) & !$omp reduction(max:gridmax) reduction(+:gridmean) & !$omp private(k,j,i,dati) do k=1,npixels(3) do j=1,npixels(2) do i=1,npixels(1) do ivec=1,jlen dati = datgridvec(ivec,i,j,k) gridmax(ivec) = max(gridmax(ivec),dati) gridmin(ivec) = min(gridmin(ivec),dati) gridmean(ivec) = gridmean(ivec) + dati enddo enddo enddo enddo gridmean(1:jlen) = gridmean(1:jlen)/real(product(npixels(1:3))) return end subroutine minmaxmean_gridvec !----------------------------------------------- ! calculate max and min and mean values on grid ! (for vector quantities) !----------------------------------------------- subroutine minmaxmean_gridvec2D(datgridvec,npixels,jlen,gridmin,gridmax,gridmean) implicit none real, dimension(:,:,:), intent(in) :: datgridvec integer, dimension(2), intent(in) :: npixels integer, intent(in) :: jlen real, dimension(jlen), intent(out) :: gridmin,gridmax,gridmean real :: dati integer :: ivec,i,j gridmax(:) = -huge(gridmax) gridmin(:) = huge(gridmin) gridmean(:) = 0. !$omp parallel do schedule(static) & !$omp reduction(min:gridmin) & !$omp reduction(max:gridmax) reduction(+:gridmean) & !$omp private(j,i,dati) do j=1,npixels(2) do i=1,npixels(1) do ivec=1,jlen dati = datgridvec(ivec,i,j) gridmax(ivec) = max(gridmax(ivec),dati) gridmin(ivec) = min(gridmin(ivec),dati) gridmean(ivec) = gridmean(ivec) + dati enddo enddo enddo gridmean(1:jlen) = gridmean(1:jlen)/real(product(npixels(1:2))) return end subroutine minmaxmean_gridvec2D !---------------------------------------------------- ! calculate max and min and mean values on particles !---------------------------------------------------- subroutine minmaxmean_part(dat,weight,npart,partmin,partmax,partmean,nonzero) implicit none real, dimension(:,:), intent(in) :: dat real, dimension(:), intent(in) :: weight integer, intent(in) :: npart real, dimension(3), intent(out) :: partmin,partmax,partmean logical, intent(in), optional :: nonzero real :: partval integer :: np,jlen,i,j logical :: usenonzero usenonzero = .false. if (present(nonzero)) usenonzero = nonzero partmax(:) = -huge(partmax) partmin(:) = huge(partmin) partmean(:) = 0. np = 0 jlen = min(size(dat(1,:)),3) !--could do this in parallel but reduction on arrays ! does not seem to work in ifort !!$omp parallel do default(none) schedule(static) & !!$omp shared(dat,weight,jlen,npart,usenonzero) & !!$omp reduction(min:partmin) & !!$omp reduction(max:partmax) & !!$omp reduction(+:partmean,np) & !!$omp private(i,j,partval) do i=1,npart !--only count particles used in the rendering if (weight(i).gt.tiny(0.)) then np = np + 1 do j=1,jlen partval = dat(i,j) if (usenonzero) then if (partval.gt.tiny(0.)) partmin(j) = min(partmin(j),partval) else partmin(j) = min(partmin(j),partval) endif partmax(j) = max(partmax(j),partval) partmean(j) = partmean(j) + partval enddo endif enddo !!$omp end parallel do if (np.gt.0) then partmean(:) = partmean(:)/real(np) endif return end subroutine minmaxmean_part !---------------------------------------------------- ! calculate max and min and mean values on particles !---------------------------------------------------- logical function iszero(partmin,partmax,ndim) implicit none real, dimension(:), intent(in) :: partmin,partmax integer, intent(in) :: ndim if (all(abs(partmin(1:ndim)).lt.tiny(0.)) .and. & all(abs(partmax(1:ndim)).lt.tiny(0.))) then iszero = .true. print "(a)",' min=max=0 on particles: skipping pointless interpolation and setting dat = 0.' else iszero = .false. endif end function iszero end module convert_grid splash/src/cubicsolve.f90000644 000770 000000 00000016133 11622211702 016213 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2011 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- module cubic implicit none contains !------------------------------------------------------------- ! this subroutine finds the real solutions to ! a cubic equation of the form ! ! a*x^3 + b*x^2 + c*x + d ! ! formulae taken from: ! Woan, The Cambridge Handbook of Physics Formulas, 2000, p51 ! ! input : a,b,c,d : coefficients of cubic polynomial ! output : x(3) : array containing up to 3 real solutions ! => x(1:nreal) non-zero, rest set to zero ! nreal : number of real solutions ! ! Daniel Price, 22/2/07 ! dprice@astro.ex.ac.uk !------------------------------------------------------------- subroutine cubicsolve(a,b,c,d,x,nreal,check) implicit none real, intent(in) :: a,b,c,d real, intent(out), dimension(3) :: x integer, intent(out) :: nreal logical, intent(in), optional :: check real :: p,q,det,sqrtdet real :: a2,b2,u,v,y1,y2,y3,term,phi real, parameter :: eps = 1000.*epsilon(0.) real, parameter :: pi = 3.14159265358979323846 integer :: i x = 0. ! !--handle all trivial cases (quadratic, linear, all zero) ! if (abs(a).lt.eps) then det = c**2 - 4.*b*d if (det.lt.0.) then ! no solutions to quadratic nreal = 0 else if (abs(b).lt.eps) then !--no solutions if a = 0, b = 0, c = 0 if (abs(c).lt.eps) then nreal = 0 else !--solve linear equation if a = 0, b = 0 nreal = 1 x(1) = -d/c endif else !--solve quadratic for a = 0 nreal = 2 sqrtdet = sqrt(det) x(1) = 0.5*(-c + sqrtdet)/b x(2) = 0.5*(-c - sqrtdet)/b endif endif else ! !--cubic solution ! a2 = a**2 b2 = b**2 p = (c/a - b2/(3.*a2)) q = (2.*b**3/(27.*a2*a) - b*c/(3.*a2) + d/a) det = (p**3)/27. + 0.25*q**2 ! !--determine number of solutions ! if (det.lt.0.) then !--3 distinct real roots nreal = 3 term = sqrt(abs(p)/3.) phi = ACOS(-0.5*q*term**(-3)) !--these are the solutions to the reduced cubic ! y^3 + py + q = 0 y1 = 2.*term*COS(phi/3.) y2 = -2.*term*COS((phi + pi)/3.) y3 = -2.*term*COS((phi - pi)/3.) else !--1 real, 2 complex roots term = -0.5*q + sqrt(det) !--must take cube root of positive quantity, then give sign later ! (otherwise gives NaNs) u = (abs(term))**(1/3.)*SIGN(1.0,term) term = -0.5*q - sqrt(det) v = (abs(term))**(1/3.)*SIGN(1.0,term) nreal = 1 y1 = u + v !--if det=0, 3 real roots, but at least 2 equal, so max of 2 unique roots) if (abs(det).lt.tiny(det)) then nreal = 2 y2 = -(u + v)/2. endif y3 = 0. endif !--return solutions to original cubic, not reduced cubic term = b/(3.*a) if (nreal.ge.1) x(1) = y1 - term if (nreal.ge.2) x(2) = y2 - term if (nreal.ge.3) x(3) = y3 - term endif if (present(check)) then if (check) then !--verify the cubic solution print*,'verifying: ',a,'x^3 + ',b,'x^2 + ',c,'x + ',d do i=1,nreal term = a*x(i)**3 + b*x(i)**2 + c*x(i) + d if (abs(term).lt.eps) then print*,'root ',i,':',x(i),'f=',term,': OK' else print*,'root ',i,':',x(i),'f=',term,': FAILED',eps endif enddo endif endif return end subroutine cubicsolve !------------------------------------------------------------- ! this subroutine returns both the real and complex ! solutions to a cubic equation of the form ! ! x^3 + b*x^2 + c*x + d ! ! input : b,c,d : coefficients of cubic polynomial ! output : x(3) : array of 3 COMPLEX solutions ! nreal : number of real solutions ! ! The form of the equation above means that we ! do not need to handle trivial cases (quadratic, etc.) ! and that there will always be 3 solutions. ! ! Daniel Price, daniel.price@monash.edu 21/01/2011 ! !------------------------------------------------------------- subroutine cubicsolve_complex(b,c,d,x,nreal,check) implicit none real, intent(in) :: b,c,d complex, intent(out), dimension(3) :: x integer, intent(out), optional :: nreal logical, intent(in), optional :: check double precision :: p,q,q2,xi double precision :: b2,term,termA,det,phi real :: termr,termi double precision :: fx,dfx real, parameter :: eps = 1000.*epsilon(0.) double precision, parameter :: pi = 3.14159265358979323846d0 integer :: i,j,nroots x = (0.,0.) ! !--preliminaries ! b2 = b*b p = (c - b2/3.) q = (2.*b2*b - 9.*b*c + 27.*d)/27. q2 = q*q det = (p*p*p)/27. + 0.25*q2 if (det < 0) then !--3 distinct real roots nroots = 3 term = sqrt(abs(p)/3.) phi = ACOS(-0.5*q*term**(-3)) !--these are the solutions to the reduced cubic ! y^3 + py + q = 0 x(1) = real(2.d0*term*COS(phi/3.d0)) x(2) = real(-2.d0*term*COS((phi + pi)/3.d0)) x(3) = real(-2.d0*term*COS((phi - pi)/3.d0)) else !--1 real, two complex nroots = 1 if (abs(det).lt.tiny(det)) nroots = 2 term = -0.5*q + sqrt(det) termA = (abs(term))**(1.d0/3.d0)*SIGN(1.0d0,term) x(1) = real(termA - p/(3.*termA)) termr = real(-0.5*termA + p/(6.*termA)) ! convert from double prec. termi = real(0.5*sqrt(3.d0)*(termA + p/(3.d0*termA))) x(2) = cmplx(termr,termi) x(3) = cmplx(termr,-termi) endif !--return solutions to original cubic, not reduced cubic x(:) = x(:) - b/3. !--if determinant is small, take a couple of Newton-Raphson iterations ! to beat down the error if (abs(det).lt.eps) then do i=1,nroots xi = dble(x(i)) do j=1,3 fx = xi*(xi*(xi + b) + c) + d dfx = xi*(3.d0*xi + 2.d0*b) + c if (abs(dfx).gt.0.) xi = xi - fx/dfx enddo x(i) = real(xi) enddo endif if (present(nreal)) nreal = nroots !--the following lines can be used for debugging if (present(check)) then if (check) then !--verify the cubic solution print*,'verifying: x^3 + ',b,'x^2 + ',c,'x + ',d do i=1,3 term = real(x(i)**3 + b*x(i)**2 + c*x(i) + d) if (abs(term).lt.eps) then print*,'root ',i,':',x(i),'f=',term,': OK' else print*,'root ',i,':',x(i),'f=',term,': FAILED',eps endif enddo endif endif return end subroutine cubicsolve_complex end module cubic splash/src/dataread_utils.f90000644 000770 000000 00000011013 12567067742 017060 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------- ! ! utility routines used during data read ! !----------------------------------------------------------- module dataread_utils use params, only:doub_prec implicit none public :: check_range integer, private :: iverbose_level = 1 ! can be changed private ! generic interface check_range interface check_range module procedure check_range_int, check_range_intarr,check_range_double end interface check_range contains !--------------------------------------------- ! set verboseness for remaining routines !--------------------------------------------- subroutine set_check_range_verboseness(ilevel) integer, intent(in) :: ilevel iverbose_level = ilevel end subroutine set_check_range_verboseness !----------------------------------------------- ! standardised print statement for range errors !----------------------------------------------- subroutine handle_range_error(tag,string,ierror) character(len=*), intent(in) :: tag,string integer, intent(inout) :: ierror if (iverbose_level > 0) then print "(1x,5a)",'ERROR: ',trim(tag),' value of ',trim(string),' out of range' endif ierror = ierror + 1 end subroutine handle_range_error !---------------------------------------------------- ! check that an integer is within a prescribed range !---------------------------------------------------- subroutine check_range_int(ivar,tag,min,max,err) integer, intent(in) :: ivar character(len=*), intent(in) :: tag integer, intent(in), optional :: min,max integer, intent(out), optional :: err integer :: ierror character(len=12) :: string write(string,"(i12)") ivar string = trim(adjustl(string)) ierror = 0 if (present(min)) then if (ivar < min) call handle_range_error(tag,string,ierror) endif if (present(max)) then if (ivar > max) call handle_range_error(tag,string,ierror) endif if (present(err)) then err = ierror endif end subroutine check_range_int !------------------------------------------------------------------------ ! check that all values of an integer array is within a prescribed range !------------------------------------------------------------------------ subroutine check_range_intarr(ivar,tag,min,max,err) integer, intent(in) :: ivar(:) character(len=*), intent(in) :: tag integer, intent(in), optional :: min,max integer, intent(out), optional :: err integer :: ierror,i character(len=12) :: string ierror = 0 do i=1,size(ivar) write(string,"(i12)") ivar(i) string = trim(adjustl(string)) if (present(min)) then if (ivar(i) < min) call handle_range_error(tag,string,ierror) endif if (present(max)) then if (ivar(i) > max) call handle_range_error(tag,string,ierror) endif enddo if (present(err)) then err = ierror endif end subroutine check_range_intarr !---------------------------------------------------- ! check that a real*8 is within a prescribed range !---------------------------------------------------- subroutine check_range_double(dvar,tag,min,max,err) real(doub_prec), intent(in) :: dvar character(len=*), intent(in) :: tag real(doub_prec), intent(in), optional :: min,max integer, intent(out), optional :: err integer :: ierror character(len=12) :: string write(string,"(1pg12.3)") dvar string = trim(adjustl(string)) ierror = 0 if (present(min)) then if (dvar < min) call handle_range_error(tag,string,ierror) endif if (present(max)) then if (dvar > max) call handle_range_error(tag,string,ierror) endif if (present(err)) then err = ierror endif end subroutine check_range_double end module dataread_utils splash/src/defaults.f90000644 000770 000000 00000022374 12403304013 015664 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------- ! ! Module containing subroutines relating to ! setting/saving default options ! !------------------------------------------------- module defaults implicit none contains !! !! initialise some variables !! this should only be called at code start !! subroutine defaults_set_initial use filenames, only:rootname use labels, only:label,labeltype,iamvec,labelvec,labeldefault,reset_columnids use limits, only:lim,range use particle_data, only:maxpart,maxstep,maxcol use settings_data, only:UseTypeInRenderings use settings_page, only:device implicit none integer :: i ! !--limits (could set them to anything but min & max must be different ! to enable them to be reset interactively if not set elsewhere) ! lim(:,1) = 0. lim(:,2) = 1. range(:,:) = 0. call reset_columnids() ! !--filenames ! rootname = ' ' ! !--data array sizes ! maxpart = 0 maxcol = 0 maxstep = 0 ! !--labels ! ! column labels do i=1,size(label) write(label(i),"(a,1x,i3)") trim(labeldefault),i enddo ! particle types labeltype(1) = 'gas' do i=2,size(labeltype) if (i > 9) then write(labeltype(i),"(a,1x,i2)") 'type',i else write(labeltype(i),"(a,1x,i1)") 'type',i endif enddo UseTypeInRenderings(:) = .false. UseTypeInRenderings(1) = .true. ! vector labels iamvec(:) = 0 labelvec = ' ' ! device from command line device = ' ' return end subroutine defaults_set_initial !! !! set initial default options !! these are used if no defaults file is found !! subroutine defaults_set(use_evdefaults) use exact, only:defaults_set_exact use multiplot use settings_limits, only:defaults_set_limits use options_data, only:defaults_set_data use settings_part, only:defaults_set_part,defaults_set_part_ev use settings_page, only:defaults_set_page,defaults_set_page_ev use settings_render, only:defaults_set_render use settings_vecplot, only:defaults_set_vecplot use settings_xsecrot, only:defaults_set_xsecrotate use settings_powerspec, only:defaults_set_powerspec use settings_units, only:defaults_set_units use titles, only:pagetitles,steplegend implicit none logical, intent(in) :: use_evdefaults integer :: i ! !--set defaults for submenu options ! call defaults_set_data call defaults_set_limits call defaults_set_page call defaults_set_part call defaults_set_render call defaults_set_xsecrotate call defaults_set_vecplot call defaults_set_exact call defaults_set_powerspec call defaults_set_units ! !--if using evsplash, override some default options ! if (use_evdefaults) then print "(a)",'setting evsplash defaults' call defaults_set_page_ev call defaults_set_part_ev endif itrans(:) = 0 ! !--multiplot ! nyplotmulti = 4 ! number of plots in multiplot multiploty(:) = 0 do i=1,4 multiploty(i) = 1+i ! first plot : y axis enddo multiplotx(:) = 1 ! first plot : x axis irendermulti(:) = 0 ! rendering ivecplotmulti(:) = 0 ! vector plot x_secmulti(:) = .false. ! take cross section? xsecposmulti(:) = 0.0 ! position of cross section icontourmulti(:) = 0 ! contour plot iplotpartoftypemulti(:,:) = .false. do i=1,size(iplotpartoftypemulti(:,1)) iplotpartoftypemulti(i,i) = .true. enddo iusealltypesmulti(:) = .true. ! !--titles ! pagetitles = ' ' steplegend = ' ' return end subroutine defaults_set ! ! writes default options to file (should match defaults_read) ! subroutine defaults_write(filename) use exact, only:exactopts,exactparams use filenames, only:rootname,nfiles use settings_data, only:dataopts use settings_part, only:plotopts use settings_page, only:pageopts use settings_render, only:renderopts use settings_vecplot, only:vectoropts use settings_xsecrot, only:xsecrotopts,animopts use settings_powerspec, only:powerspecopts use multiplot, only:multi use shapes, only:shapeopts use calcquantities, only:calcopts implicit none character(len=*), intent(in) :: filename integer :: i,ierr integer, parameter :: iunit = 1 open(unit=iunit,file=trim(adjustl(filename)),status='replace',form='formatted', & delim='apostrophe',iostat=ierr) ! without delim namelists may not be readable if (ierr /= 0) then print*,'ERROR: cannot write file '//trim(filename) close(unit=iunit) return endif write(iunit,NML=dataopts) write(iunit,NML=plotopts) write(iunit,NML=pageopts) write(iunit,NML=renderopts) write(iunit,NML=vectoropts) write(iunit,NML=xsecrotopts) write(iunit,NML=powerspecopts) write(iunit,NML=exactopts) write(iunit,NML=exactparams) write(iunit,NML=multi) write(iunit,NML=shapeopts) write(iunit,NML=calcopts) write(iunit,NML=animopts) do i=1,nfiles write(iunit,"(a)") trim(rootname(i)) enddo close(unit=iunit) print "(a)",'default options saved to file '//trim(filename) return end subroutine defaults_write !----------------------------------------------- ! reads default options from file ! uses namelist input to group the options ! these are specified in the modules !----------------------------------------------- subroutine defaults_read(filename) use filenames, only:rootname,maxfile use multiplot, only:multi use settings_data, only:dataopts use settings_part, only:plotopts use settings_page, only:pageopts use settings_render, only:renderopts use settings_vecplot, only:vectoropts use settings_xsecrot, only:xsecrotopts,animopts use settings_powerspec, only:powerspecopts use exact, only:exactopts,exactparams use shapes, only:shapeopts use calcquantities, only:calcopts implicit none character(len=*), intent(in) :: filename logical :: iexist integer :: ierr,i integer, parameter :: iunit = 1 inquire (exist=iexist, file=filename) if (iexist) then open(unit=iunit,file=filename,status='old',form='formatted',delim='apostrophe',err=88) ierr = 0 read(iunit,NML=dataopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading data options from '//trim(filename) ierr = 0 read(iunit,NML=plotopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading plot options from '//trim(filename) ierr = 0 read(iunit,NML=pageopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading page options from '//trim(filename) ierr = 0 read(iunit,NML=renderopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading render options from '//trim(filename) ierr = 0 read(iunit,NML=vectoropts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading vector plot options from '//trim(filename) ierr = 0 read(iunit,NML=xsecrotopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading xsec/rotation options from '//trim(filename) ierr = 0 read(iunit,NML=powerspecopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading power spectrum options from '//trim(filename) ierr = 0 read(iunit,NML=exactopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading exact solution options from '//trim(filename) ierr = 0 read(iunit,NML=exactparams,iostat=ierr) if (ierr /= 0) print "(a)",'error reading exact solution parameters from '//trim(filename) ierr = 0 read(iunit,NML=multi,iostat=ierr) if (ierr /= 0) print "(a)",'error reading multiplot options from '//trim(filename) ierr = 0 read(iunit,NML=shapeopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading shape options from '//trim(filename) ierr = 0 read(iunit,NML=calcopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading calculated quantity settings from '//trim(filename) ierr = 0 read(iunit,NML=animopts,iostat=ierr) if (ierr /= 0) print "(a)",'error reading animation sequence settings from '//trim(filename) if (len_trim(rootname(1)).eq.0) then do i=1,maxfile read(iunit,*,end=66,iostat=ierr) rootname(i) enddo endif 66 continue close(unit=iunit) print*,'read '//trim(filename) return else print*,trim(filename)//' not found: using default settings' return endif 88 continue print "(a)",' *** error opening defaults file '//trim(filename)//': using default settings' return end subroutine defaults_read end module defaults splash/src/discplot.f90000644 000770 000000 00000017207 12607400052 015703 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! module handling plotting of azimuthally-averaged quantities ! for disc simulations !----------------------------------------------------------------- module disc implicit none integer, parameter, private :: maxbins = 1001 integer, dimension(maxbins), private :: ninbin real, dimension(maxbins), private :: radius,sigma,spsound integer, private :: nbins public :: disccalc,discplot private contains subroutine disccalc(iplot,npart,rpart,npmass,pmass,unit_mass,unit_r,rminin,rmaxin,ymin,ymax,& itransx,itransy,icolourpart,iamtype,usetype,noftype,gamma,unit_u,u,u_is_spsound) use transforms, only:transform_limits_inverse,transform_inverse,transform use params, only:int1,maxparttypes,doub_prec use part_utils, only:igettype implicit none integer, intent(in) :: iplot,npart,npmass,itransx,itransy real, dimension(npart), intent(in) :: rpart real, dimension(npmass), intent(in) :: pmass real(doub_prec), intent(in) :: unit_mass,unit_r real, intent(in) :: rminin,rmaxin,gamma real, intent(out) :: ymin,ymax integer, dimension(npart), intent(in) :: icolourpart integer(kind=int1), dimension(:), intent(in) :: iamtype logical, dimension(maxparttypes), intent(in) :: usetype integer, dimension(maxparttypes), intent(in) :: noftype real(doub_prec), intent(in), optional :: unit_u real, dimension(npart), intent(in), optional :: u logical, intent(in), optional :: u_is_spsound integer :: i,ibin real, parameter :: pi = 3.1415926536 real :: pmassi,rbin,deltar,area,rmin,rmax real(doub_prec) :: sigmai,toomreq,epicyclic,Omegai,spsoundi,unit_cs2 real, dimension(1) :: rad logical :: mixedtypes,gotspsound integer :: itype,np ninbin(:) = 0 sigma(:) = 0. spsound(:) = 0. pmassi = 0 if (npmass.le.0) then print*,' INTERNAL ERROR in discplot: dimension of mass array <= 0' return endif gotspsound = .false. if (present(u_is_spsound)) gotspsound = u_is_spsound if (present(unit_u)) then unit_cs2 = unit_u else unit_cs2 = 1.d0 endif ! !--print info ! select case(iplot) case(1) print "(a,i4,a)",' calculating disc surface density profile using',nbins,' bins' case(2) if (present(u)) then print "(a)",' calculating Toomre Q parameter (assuming Mstar=1 and a Keplerian rotation profile)' if (.not.gotspsound) then if (gamma.lt.1.00001) then print "(a)",' isothermal equation of state: using cs^2 = 2/3*utherm' else print "(a,f6.3,a,f6.3,a)",' ideal gas equation of state: using cs^2 = ',gamma*(gamma-1),'*u (gamma = ',gamma,')' endif endif else print "(a)",' ERROR: cannot calculate Toomre Q parameter: thermal energy/sound speed not present in dump file' return endif case default print "(a)",' ERROR: unknown plot in discplot. ' return end select ! !--if transformations (e.g. log) are applied to r, then limits ! will already be set in transformed space - need to obtain ! limits in non-transformed space. ! rmin = rminin rmax = rmaxin if (itransx.gt.0) call transform_limits_inverse(rmin,rmax,itransx) ! !--try to get appropriate value for nbins ! nbins = min(4*int(npart**(1./3.)) + 1,maxbins) ! !--set array of radius values for plotting ! deltar = (rmax - rmin)/(nbins - 1) do ibin=1,nbins radius(ibin) = rmin + (ibin-0.5)*deltar enddo mixedtypes = size(iamtype).ge.npart ! !--calculate surface density in each radial bin ! np = 0 !$omp parallel do default(none) & !$omp shared(npart,rpart,sigma,npmass,pmass,itransx,icolourpart,rmin,deltar,nbins) & !$omp shared(ninbin,spsound,gamma,u,iamtype,mixedtypes,usetype,noftype,gotspsound,unit_cs2) & !$omp private(i,rad,pmassi,ibin,rbin,area,itype) & !$omp reduction(+:np) over_parts: do i=1,npart !--skip particles with itype < 0 if (icolourpart(i) < 0) cycle over_parts if (mixedtypes) then itype = int(iamtype(i)) else itype = igettype(i,noftype) endif if (.not.usetype(itype)) cycle over_parts np = np + 1 if (itransx.eq.0) then rad(1) = rpart(i) else rad(1) = rpart(i) call transform_inverse(rad,itransx) endif if (npmass.ge.npart) then pmassi = pmass(i) else pmassi = pmass(1) endif ibin = int((rad(1) - rmin)/deltar) + 1 if (ibin.gt.0 .and. ibin.le.nbins) then rbin = rmin + (ibin-0.5)*deltar area = pi*((rbin + 0.5*deltar)**2 - (rbin - 0.5*deltar)**2) !$omp atomic sigma(ibin) = sigma(ibin) + pmassi/area if (present(u)) then if (gotspsound) then !$omp atomic spsound(ibin) = spsound(ibin) + real((u(i))**2/unit_cs2) else if (gamma.lt.1.00001) then !$omp atomic spsound(ibin) = spsound(ibin) + real(2./3.*(u(i)/unit_cs2)) else !$omp atomic spsound(ibin) = spsound(ibin) + real(gamma*(gamma-1.)*(u(i)/unit_cs2)) endif endif !$omp atomic ninbin(ibin) = ninbin(ibin) + 1 endif endif enddo over_parts !$omp end parallel do print "(1x,a,i10,a,i10,a,i4,a)",'used ',np,' of ',npart,' particles in ',nbins,' bins' ! !--calculate Toomre Q parameter in each bin using surface density ! if (iplot.eq.2) then epicyclic = 0. do ibin=1,nbins sigmai = sigma(ibin)*(unit_r**2/unit_mass) ! convert back to code units ! !--for Toomre Q need the epicyclic frequency ! in a Keplerian disc kappa = Omega ! Omegai = sqrt(1./(radius(ibin)/unit_r)**3) epicyclic = Omegai ! !--spsound is RMS sound speed for all particles in the annulus ! if (ninbin(ibin).gt.0) then spsoundi = sqrt(spsound(ibin)/real(ninbin(ibin))) ! unit conversion already done else spsoundi = 0. endif ! !--now calculate Toomre Q ! if (sigmai > 0.) then toomreq = spsoundi*epicyclic/(pi*sigmai) else toomreq = 0. endif sigma(ibin) = real(toomreq,kind=kind(sigma)) enddo endif if (itransx.gt.0) call transform(radius,itransx) if (itransy.gt.0) call transform(sigma,itransy) ! !--return min and max of y axis so adaptive plot limits can be set ! ymin = minval(sigma(1:nbins),mask=(sigma(1:nbins).ne.0.)) ymax = maxval(sigma(1:nbins),mask=(sigma(1:nbins).ne.0.)) return end subroutine disccalc !--------------------------------------------------- ! ! subroutine to actually perform the disc plotting ! !--------------------------------------------------- subroutine discplot use plotlib, only:plot_line implicit none call plot_line(nbins,radius,sigma) end subroutine discplot end module disc splash/src/exact.f90000644 000770 000000 00000167053 12574155370 015210 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! This module handles all of the settings relating to the exact solution ! plotting and calls the appropriate routines to change these settings and ! plot the actual solutions. ! ! The only thing to do with exact solutions that is not entirely handled ! by this module is the toy star AC plane solution (because ! it is called under different circumstances to the other solutions). ! module exact implicit none ! !--maximum number of solutions in any one plot ! integer, parameter :: maxexact=10 ! !--options used to plot the exact solution line ! integer :: maxexactpts, iExactLineColour, iExactLineStyle,iPlotExactOnlyOnPanel logical :: iApplyTransExactFile,iCalculateExactErrors,iPlotResiduals logical :: iApplyUnitsExactFile real :: fracinsetResiduals,residualmax ! !--declare all of the parameters required for the various exact solutions ! !--toy star integer :: iACplane ! label position of toy star AC plane plot integer :: norder,morder ! for toy star real, public :: atstar,ctstar,sigma real :: htstar,alphatstar,betatstar,ctstar1,ctstar2 real :: sigma0,totmass !--sound wave integer :: iwaveploty,iwaveplotx ! linear wave real :: ampl,lambda,period,xzero !--sedov blast wave real :: rhosedov,esedov !--polytrope real :: polyk !--mhd shock solutions integer :: ishk real :: xshock !--density profiles integer :: iprofile,icolpoten,icolfgrav real, dimension(2) :: Msphere,rsoft !--from file integer :: iexactplotx(maxexact), iexactploty(maxexact) !--shock tube real :: rho_L, rho_R, pr_L, pr_R, v_L, v_R !--rho vs h real :: hfact !--read from file integer :: ixcolfile(maxexact),iycolfile(maxexact),nfiles character(len=120) :: filename_exact(maxexact) !--equilibrium torus real :: Mstar,Rtorus,distortion !--ring spreading real :: Mring,Rring,viscnu !--dusty waves real :: cs,Kdrag,rhozero,rdust_to_gas !--arbitrary function integer :: nfunc character(len=120), dimension(maxexact) :: funcstring !--Roche potential real :: mprim,msec real :: xprim(3),xsec(3) logical :: use_sink_data integer, parameter :: iexact_rochelobe = 15 !--C-shock real :: machs,macha !--gamma, for manual setting real :: gamma_exact logical :: use_gamma_exact ! !--sort these into a namelist for input/output ! namelist /exactopts/ iexactplotx,iexactploty,filename_exact,maxexactpts, & iExactLineColour,iExactLineStyle,iApplyTransExactFile,iCalculateExactErrors, & iPlotResiduals,fracinsetResiduals,residualmax,iPlotExactOnlyOnPanel,& iApplyUnitsExactFile namelist /exactparams/ ampl,lambda,period,iwaveploty,iwaveplotx,xzero, & htstar,atstar,ctstar,alphatstar,betatstar,ctstar1,ctstar2, & polyk,sigma0,norder,morder,rhosedov,esedov, & rho_L, rho_R, pr_L, pr_R, v_L, v_R,ishk,hfact, & iprofile,Msphere,rsoft,icolpoten,icolfgrav,Mstar,Rtorus,distortion, & Mring,Rring,viscnu,nfunc,funcstring,cs,Kdrag,rhozero,rdust_to_gas, & mprim,msec,ixcolfile,iycolfile,xshock,totmass,machs,macha,& use_sink_data,xprim,xsec,nfiles,gamma_exact,use_gamma_exact public :: defaults_set_exact,submenu_exact,options_exact,read_exactparams public :: exact_solution public :: exactopts,exactparams contains !---------------------------------------------------------------------- ! sets default values of the exact solution parameters !---------------------------------------------------------------------- subroutine defaults_set_exact lambda = 1.0 ! sound wave exact solution : wavelength ampl = 0.005 ! sound wave exact solution : amplitude period = 1.0 iwaveploty = 7 iwaveplotx = 1 xzero = 0. htstar = 1. ! toy star crap atstar = 1. ctstar = 1. alphatstar = 0. betatstar = 0. ctstar1 = 0. ctstar2 = 0. totmass = 1. norder = -1 morder = 0 sigma0 = 0. rhosedov = 1.0 ! sedov blast wave esedov = 1.0 ! blast wave energy polyk = 1.0 ! polytropic k ! shock tube (default is sod problem) rho_L = 1.0 rho_R = 0.125 pr_L = 1.0 pr_R = 0.1 v_L = 0.0 v_R = 0.0 ishk = 1 xshock = 0. hfact = 1.2 ! read from file nfiles = 1 filename_exact = ' ' ixcolfile = 1 iycolfile = 2 iexactplotx = 0 iexactploty = 0 ! density profile parameters iprofile = 1 rsoft(1) = 1.0 rsoft(2) = 0.1 Msphere(1) = 1.0 Msphere(2) = 0.0 icolpoten = 0 icolfgrav = 0 ! equilibrium torus Mstar = 1.0 Rtorus = 1.0 distortion = 1.1 ! ring spreading Mring = 1.0 Rring = 1.0 viscnu = 1.e-3 ! dusty waves Kdrag = 1.0 cs = 1.0 rhozero = 1.0 rdust_to_gas = 0.0 ! Roche lobes use_sink_data = .true. mprim = 1. msec = 1. xprim = 0. xsec = 0. xsec(1) = 1. ! C-shock machs = 50. ! sonic Mach number macha = 5. ! Alfvenic Mach number ! gamma, if not read from file gamma_exact = 5./3. use_gamma_exact = .false. ! arbitrary function nfunc = 1 funcstring = ' ' maxexactpts = 1001 ! points in exact solution plot iExactLineColour = 1 ! foreground iExactLineStyle = 1 ! solid iApplyTransExactFile = .true. ! false if exact from file is already logged iApplyUnitsExactFile = .false. iCalculateExactErrors = .true. iPlotResiduals = .false. fracinsetResiduals = 0.15 residualmax = 0.0 iPlotExactOnlyOnPanel = 0 return end subroutine defaults_set_exact !---------------------------------------------------------------------- ! sets which exact solution to calculate + parameters for this !---------------------------------------------------------------------- subroutine submenu_exact(iexact) use settings_data, only:ndim use prompting, only:prompt use filenames, only:rootname,ifileopen use exactfunction, only:check_function use mhdshock, only:nmhdshocksolns,mhdprob use asciiutils, only:get_ncolumns,get_nrows,string_replace integer, intent(inout) :: iexact integer :: ierr,itry,i,ncols,nheaderlines,nadjust,nrows logical :: ians,iexist,ltmp,prompt_for_gamma character(len=len(filename_exact)) :: filename_tmp character(len=4) :: str print 10 10 format(' 0) none ',/, & ' 1) ANY function f(x,t)',/, & ' 2) read from file ',/, & ' 3) shock tube ',/, & ' 4) sedov blast wave ',/, & ' 5) polytrope ',/, & ' 6) toy star ',/, & ' 7) gresho vortex ',/, & ' 8) mhd shock tubes (tabulated) ',/, & ' 9) h vs rho ',/, & '10) Plummer/Hernquist spheres ',/, & '11) torus ',/, & '12) ring spreading ',/, & '13) special relativistic shock tube', /, & '14) dusty waves', /, & '15) Roche lobes/potential ',/, & '16) C-shock ') call prompt('enter exact solution to plot',iexact,0,16) print "(a,i2)",'plotting exact solution number ',iexact ! !--enter parameters for various exact solutions ! prompt_for_gamma = .false. select case(iexact) case(1) call prompt('enter number of functions to plot ',nfunc,1,maxexact) print "(/,a,6(/,11x,a))",' Examples: sin(2*pi*x - 0.1*t)','sqrt(0.5*x)','x^2', & 'exp(-2*x**2 + 0.1*t)','log10(x/2)','exp(y),y=sin(pi*x)','cos(z/y),z=acos(y),y=x^2' overfunc: do i=1,nfunc ierr = 1 itry = 0 do while(ierr /= 0 .and. itry.lt.10) if (nfunc > 1) print "(/,a,i2,/,11('-'),/)",'Function ',i call prompt('enter function f(x,t) to plot ',funcstring(i),noblank=.true.) call check_function(funcstring(i),ierr) if (ierr /= 0 .and. len(funcstring(i)).eq.len_trim(funcstring(i))) then print "(a,i3,a)",& ' (errors are probably because string is too long, max length = ',& len(funcstring(i)),')' endif itry = itry + 1 enddo if (itry >= 10) then print "(a)",' *** too many tries, aborting ***' ierr = i-1 exit overfunc endif print* call prompt('enter y axis of exact solution (0=all plots)',iexactploty(i),0) if (iexactploty(i) > 0) then call prompt('enter x axis of exact solution ',iexactplotx(i),1) endif enddo overfunc if (ierr /= 0) nfunc = ierr case(2) call prompt('enter number of files to read per plot ',nfiles,1,maxexact) nadjust = -1 over_files: do i=1,nfiles iexist = .false. do while(.not.iexist) print "(/,a)",'Use %f to represent current dump file, e.g. %f.exact looks for dump_000.exact' write(str,"(i4)") i call prompt('enter filename #'//trim(adjustl(str)),filename_exact(i)) !--substitute %f for filename filename_tmp = filename_exact(i) call string_replace(filename_tmp,'%f',trim(rootname(ifileopen))) !--check the first file for errors inquire(file=filename_tmp,exist=iexist) if (iexist) then open(unit=33,file=filename_tmp,status='old',iostat=ierr) if (ierr.eq.0) then call get_ncolumns(33,ncols,nheaderlines) call get_nrows(33,nheaderlines,nrows) if (nrows < 100000) then print "(a,i5,a)",' got ',nrows,' lines in file' else print "(a,i10,a)",' got ',nrows,' lines in file' endif if (nrows > maxexactpts) maxexactpts = nrows if (ncols.gt.2) then print "(a,i2,a)",' File '//trim(filename_tmp)//' contains ',ncols,' columns of data' call prompt('Enter column containing x data ',ixcolfile(i),1,ncols) call prompt('Enter column containing y data ',iycolfile(i),1,ncols) elseif (ncols.eq.2) then print "(a,i2,a)",' OK: got ',ncols,' columns from '//trim(filename_tmp) else iexist = .false. call prompt('Error: file contains < 2 readable columns: try again?',ians) if (.not.ians) then nadjust = i-1 exit over_files endif endif close(33) else iexist = .false. call prompt('Error opening '//trim(filename_tmp)//': try again?',ians) if (.not.ians) then nadjust = i-1 exit over_files endif endif else ians = .true. call prompt('file does not exist: try again? ',ians) if (.not.ians) then nadjust = i-1 exit over_files endif endif enddo call prompt('enter x axis of exact solution ',iexactplotx(i),1) call prompt('enter y axis of exact solution ',iexactploty(i),1) enddo over_files if (nadjust >= 0) then nfiles = nadjust if (nfiles == 1) then print "(/,a)",'Using 1 file only' elseif (nfiles > 0) then write(str,"(i4)") nfiles print "(/,a)",'Using '//trim(adjustl(str))//' files' endif endif if (nfiles > 0) then ! only ask if filename was read OK ltmp = .not.iApplyTransExactFile call prompt(' are exact solutions already logged?',ltmp) iApplyTransExactFile = .not.ltmp ltmp = .not.iApplyUnitsExactFile call prompt(' are exact solutions in physical units?',ltmp) iApplyUnitsExactFile = .not.ltmp endif case(3,13) ! !--read shock parameters from the .shk file ! call read_exactparams(iexact,trim(rootname(1)),ierr) if (ierr.ne.0) then call prompt('enter density to left of shock ',rho_L,0.0) call prompt('enter density to right of shock ',rho_R,0.0) call prompt('enter pressure to left of shock ',pr_L,0.0) call prompt('enter pressure to right of shock ',pr_R,0.0) if (iexact.eq.13) then call prompt('enter velocity to left of shock ',v_L,max=1.0) call prompt('enter velocity to right of shock ',v_R,max=1.0) else call prompt('enter velocity to left of shock ',v_L) call prompt('enter velocity to right of shock ',v_R) call prompt('enter dust-to-gas ratio ',rdust_to_gas,0.) endif endif prompt_for_gamma = .true. case(4) call prompt('enter density of ambient medium ',rhosedov,0.0) call prompt('enter blast wave energy E ',esedov,0.0) prompt_for_gamma = .true. case(5) call prompt('enter polytropic k ',polyk) call prompt('enter total mass ',totmass) prompt_for_gamma = .true. case(6) print "(a)",' toy star: ' call read_exactparams(iexact,trim(rootname(1)),ierr) call prompt('enter polytropic k ',polyk) call prompt('enter total mass ',totmass) call prompt('enter central density rho_0 (rho = rho_0 - cr^2)',htstar) call prompt('enter parameter c (rho = rho_0 - cr^2)',ctstar,0.0) sigma = 0. call prompt('enter parameter sigma (By = sigma*rho)',sigma0) sigma = sigma0 ians = .false. call prompt('linear oscillations?',ians) if (ians) then call prompt('enter order of radial mode',norder,0) if (ndim.ge.2) call prompt('enter order of angular mode',morder,0) call prompt('enter velocity amplitude a (v = a*r) ',atstar) else print "(a)",'using exact non-linear solution:' ians = .true. if (norder.lt.0 .and. morder.lt.0) ians = .false. if (ndim.ge.2) call prompt('axisymmetric?',ians) if (ians .or. ndim.eq.1) then norder = -1 morder = 0 call prompt('enter v_r amplitude ',alphatstar) if (ndim.ge.2) call prompt('enter v_phi amplitude ',betatstar) else norder = -1 morder = -1 call prompt('enter vxx amplitude ',alphatstar) call prompt('enter vyy amplitude ',betatstar) call prompt('enter vxy amplitude ',ctstar1) call prompt('enter vyx amplitude ',ctstar2) endif endif prompt_for_gamma = .true. !case(7) ! call prompt('enter y-plot to place sine wave on',iwaveploty,1) ! call prompt('enter x-plot to place sine wave on',iwaveplotx,1) ! call prompt('enter starting x position',xzero) ! call prompt('enter wavelength lambda ',lambda,0.0) ! call prompt('enter amplitude ',ampl,0.0) ! call prompt('enter period ',period) case(8) print "(a)",' MHD shock tube tables: ' if (ishk.le.0) ishk = 1 do i=1,nmhdshocksolns print "(i2,') ',a)",i,trim(mhdprob(i)) enddo call prompt('enter solution to plot ',ishk,1,7) call prompt('enter initial x position of shock ',xshock) case(9) call prompt('enter hfact [h = hfact*(m/rho)**1/ndim]',hfact,0.) case(10) print 20 20 format(' 1) Plummer sphere [ rho = 3M r_s**2 /(4 pi (r**2 + r_s**2)**5/2) ]',/, & ' 2) Hernquist model [ rho = M r_s /(2 pi r (r_s + r)**3 ]') call prompt('enter density profile to plot',iprofile,1,2) call prompt('enter total mass of sphere M',Msphere(1),0.) call prompt('enter scale length length r_s,',rsoft(1),0.) ians = .false. if (icolpoten.gt.0) ians = .true. call prompt('Are the gravitational potential and/or force dumped?',ians) if (ians) then call prompt('enter column containing grav. potential',icolpoten,0) call prompt('enter column containing grav. force',icolfgrav,0) endif call prompt('enter mass of 2nd component',Msphere(2),0.) call prompt('enter scale length r_s for 2nd component,',rsoft(2),0.) case(11) call prompt('enter mass of central object',Mstar,0.) call prompt('enter radius of torus centre',Rtorus,0.) call prompt('enter distortion parameter ',distortion,1.,2.) if (abs(polyk-1.0).lt.tiny(polyk)) polyk = 0.0764 call prompt('enter K in P= K*rho^gamma',polyk,0.) prompt_for_gamma = .true. case(12) call prompt('enter mass of ring',Mring,0.) call prompt('enter radius of ring centre R0',Rring,0.) call prompt('enter viscosity parameter nu',viscnu,0.) case(14) call prompt('enter starting x position',xzero) call prompt('enter wavelength lambda ',lambda,0.) call prompt('enter amplitude of perturbation',ampl,0.) call prompt('enter sound speed in gas ',cs,0.) call prompt('enter initial gas density ',rhozero,0.) call prompt('enter dust-to-gas ratio ',rdust_to_gas,0.) call prompt('enter drag coefficient K ',Kdrag,0.) case(15) call prompt('use data from sink particles?',use_sink_data) if (.not.use_sink_data) then call prompt('enter mass of primary star ',mprim,0.) call prompt('enter mass of secondary star ',msec,0.,mprim) call prompt('enter x position of primary',xprim(1)) call prompt('enter y position of primary',xprim(2)) call prompt('enter x position of secondary',xsec(1)) call prompt('enter y position of secondary',xsec(2)) endif case(16) call prompt('enter sonic Mach number',machs,0.) call prompt('enter Alfvenic Mach number ',macha,0.) end select if (prompt_for_gamma) then call prompt('set adiabatic gamma manually? (no=read from dumps)',use_gamma_exact) if (use_gamma_exact) then call prompt('enter gamma',gamma_exact) endif endif return end subroutine submenu_exact !--------------------------------------------------- ! sets options relating to exact solution plotting !--------------------------------------------------- subroutine options_exact use prompting, only:prompt use plotlib, only:plotlib_maxlinestyle,plotlib_maxlinecolour implicit none call prompt('enter number of exact solution points ',maxexactpts,10,1000000) call prompt('enter line colour ',iExactLineColour,1,plotlib_maxlinecolour) call prompt('enter line style ',iExactLineStyle,1,plotlib_maxlinestyle) call prompt('calculate error norms? ',iCalculateExactErrors) if (iCalculateExactErrors) then call prompt('plot residuals (as inset in main plot)?',iPlotResiduals) if (iPlotResiduals) then call prompt('enter fraction of plot to use for inset', & fracinsetResiduals,0.1,0.9) call prompt('enter max residual (0 for adaptive)',residualmax,0.) endif endif print "(/,' 0 : plot exact solution (where available) on every panel ',/,"// & "' -1 : plot exact solution on first row only ',/,"// & "' -2 : plot exact solution on first column only ',/,"// & "' n : plot exact solution on nth panel only ')" call prompt('Enter selection ',iPlotExactOnlyOnPanel,-2) return end subroutine options_exact !----------------------------------------------------------------------- ! read exact solution parameters from files ! (in ndspmhd these files are used in the input to the code) ! ! called after main data read and if exact solution chosen from menu !----------------------------------------------------------------------- subroutine read_exactparams(iexact,rootname,ierr) use settings_data, only:ndim,iverbose use prompting, only:prompt use exactfunction, only:check_function use filenames, only:fileprefix use asciiutils, only:read_asciifile,get_line_containing integer, intent(in) :: iexact character(len=*), intent(in) :: rootname integer, intent(out) :: ierr integer :: idash,nf,i,j,idrag,idum,linenum,k,ieq,ierrs(6) character(len=len_trim(rootname)+8) :: filename character(len=120) :: line character(len=30) :: var logical :: iexist idash = index(rootname,'_') if (idash.eq.0) idash = len_trim(rootname)+1 select case(iexact) case(1) ! !--read functions from file ! ! filename=trim(rootname)//'.func' call read_asciifile(trim(filename),nf,funcstring,ierr) if (ierr.eq.-1) then if (iverbose > 0) write(*,"(a)",advance='no') ' no file '//trim(filename)//'; ' filename = trim(fileprefix)//'.func' call read_asciifile(trim(filename),nf,funcstring,ierr) if (ierr.eq.-1) then if (iverbose > 0) print "(a)",' no file '//trim(filename) return endif endif if (nf.gt.0) then i = 0 do while(i.lt.nf) i = i + 1 call check_function(funcstring(i),ierr,verbose=.false.) if (ierr /= 0) then print "(a)",' error parsing function '//trim(funcstring(i))//', skipping...' do j=i+1,nf funcstring(j-1) = funcstring(j) enddo funcstring(nf) = ' ' nf = nf - 1 i = i - 1 endif enddo nfunc = nf if (iverbose > 0) print "(a,i2,a)",' read ',nfunc,' functions from '//trim(filename) else print "(a)",' *** NO FUNCTIONS READ: none will be plotted ***' ierr = 2 endif case(3,13) ! !--shock tube parameters from .shk file ! filename = trim(rootname(1:idash-1))//'.shk' inquire(file=filename,exist=iexist) if (iexist) then open(unit=19,file=filename,status='old',iostat=ierr) if (ierr==0) then read(19,*,iostat=ierrs(1)) rho_L, rho_R read(19,*,iostat=ierrs(2)) pr_L, pr_R read(19,*,iostat=ierrs(3)) v_L, v_R if (any(ierrs(1:3)/=0)) then print*,'error reading ',filename ierr = 1 endif endif close(unit=19) else print*,'no file ',filename ! ! look for .setup file for Phantom ! filename= trim(rootname(1:idash-1))//'.setup' inquire(file=filename,exist=iexist) open(unit=19,file=filename,status='old',iostat=ierr) ierrs(:) = 0 do while(ierr==0) read(19,"(a)",iostat=ierr) line ieq = index(line,'=') if (ierr==0 .and. ieq > 1) then var = trim(adjustl(line(1:ieq-1))) select case(trim(var)) case('densleft') read(line(ieq+1:),*,iostat=ierrs(1)) rho_L case('densright') read(line(ieq+1:),*,iostat=ierrs(1)) rho_R case('prleft') read(line(ieq+1:),*,iostat=ierrs(1)) pr_L case('prright') read(line(ieq+1:),*,iostat=ierrs(1)) pr_R case('vxleft') read(line(ieq+1:),*,iostat=ierrs(1)) v_L case('vxright') read(line(ieq+1:),*,iostat=ierrs(1)) v_R end select endif enddo ierr = 0 if (.not.iexist .or. any(ierrs(1:6)/=0)) ierr = 1 endif if (iexist) then print*,'>> read ',filename print*,' rhoL, rho_R = ',rho_L,rho_R print*,' pr_L, pr_R = ',pr_L, pr_R print*,' v_L, v_R = ',v_L, v_R endif case(6) ! !--read toy star file for toy star solution ! select case(ndim) case(1) filename = trim(rootname(1:idash-1))//'.tstar' open(unit=20,ERR=8801,FILE=filename,STATUS='old') read(20,*,ERR=8888) Htstar,Ctstar,Atstar read(20,*,ERR=8888) sigma0 read(20,*,ERR=8888) norder close(UNIT=20) print*,' >> read ',filename print*,' H,C,A,sigma,n = ',Htstar,Ctstar,Atstar,sigma0,norder return 8801 continue print*,'no file ',filename ierr = 1 return 8888 print*,'error reading ',filename close(UNIT=20) ierr = 2 return case(2) filename = trim(rootname(1:idash-1))//'.tstar2D' open(unit=20,ERR=9901,FILE=filename,STATUS='old') read(20,*,ERR=9902) Htstar,Ctstar,Atstar read(20,*,ERR=9902) alphatstar,betatstar,ctstar1,ctstar2 read(20,*,ERR=9902) norder,morder close(UNIT=20) print*,' >> read ',filename print*,' j,m = ',norder,morder print*,' rho_0 = ',Htstar,' - ',Ctstar,' r^2' if (norder.ge.0 .and. morder.ge.0) then print*,' v = ',Atstar,' r' else print*,' vx = ',alphatstar,'x +',ctstar1,'y' print*,' vy = ',ctstar2,'x +',betatstar,'y' endif return 9901 continue print*,'no file ',filename ierr = 1 return 9902 print*,'error reading ',filename close(UNIT=20) ierr = 2 return end select case(8) ! !--attempt to guess which MHD shock tube has been done from filename ! !read(rootname(5:5),*,iostat=ios) ishk !if (ios.ne.0) ishk = 1 ! !--prompt for shock type if not set ! if (ishk.le.0) then ! prompt ishk = 1 call prompt('enter shock solution to plot',ishk,1,7) endif return case(14) ! !--dustywave parameters from ndspmhd input file ! filename = trim(rootname(1:idash-1))//'.in' linenum = get_line_containing(filename,'Kdrag') open(unit=19,file=filename,status='old',iostat=ierr) if (ierr.eq.0) then do i=1,linenum-1 read(19,*,iostat=ierr) enddo read(19,"(a)",iostat=ierr) line if (ierr.eq.0) then k = index(line,'Kdrag =') if (k > 0) then read(line(k+7:),*,iostat=ierr) Kdrag print*,'>> read Kdrag = ',Kdrag,' from '//trim(filename) elseif (ierr.eq.0) then read(line,*,iostat=ierr) idrag, idum, idum, Kdrag print*,'>> read Kdrag = ',Kdrag,' from '//trim(filename) endif else print*,'>> error reading Kdrag from '//trim(filename) endif endif close(unit=19) return end select return end subroutine read_exactparams !----------------------------------------------------------------------- ! this subroutine drives the exact solution plotting using the ! parameters which have been set ! ! acts as an interface between the main plotting loop and the ! exact solution calculation subroutines ! ! The exact solution is returned from the calculation via the arrays ! xexact and yexact. This means that the appropriate transformations ! can be applied (e.g. if the graph is logarithmic) and also ensures ! that the line style and colour settings are applied properly. ! ! Note that we attempt to space the solution evenly in the transformed ! space (ie. in the current plot window), but this can be overwritten ! in the subroutines (for example if an uneven sampling is desired or ! the plotting is via some similarity variable as in the Sedov solution). ! In these cases the resulting arrays are then transformed, possibly leading ! to poor sampling in some regions (e.g. an evenly spaced array will become ! highly uneven in logarithmic space). ! ! Note that any subroutine could in principle do its own plotting, ! provided that it returns ierr > 0 which means that the generic line ! is not plotted. Obviously transformations could not be applied in ! this case. ! !----------------------------------------------------------------------- subroutine exact_solution(iexact,iplotx,iploty,itransx,itransy,igeom, & ndim,ndimV,time,xmin,xmax,gamma,xplot,yplot,& itag,iamtype,noftype,iplot_type, & pmassmin,pmassmax,npart,imarker,unitsx,unitsy,irescale,iaxisy) use params, only:int1,maxparttypes use labels, only:ix,irad,iBfirst,ivx,irho,ike,iutherm,ih,ipr,iJfirst,& irhorestframe,is_coord,ideltav,idustfrac use filenames, only:ifileopen,rootname use asciiutils, only:string_replace use prompting, only:prompt use exactfromfile, only:exact_fromfile use mhdshock, only:exact_mhdshock use polytrope, only:exact_polytrope use rhoh, only:exact_rhoh use sedov, only:exact_sedov use shock, only:exact_shock use shock_sr, only:exact_shock_sr use torus, only:exact_torus use toystar1D, only:exact_toystar1D !, exact_toystar_ACplane use toystar2D, only:exact_toystar2D use wave, only:exact_wave use densityprofiles, only:exact_densityprofiles use exactfunction, only:exact_function use ringspread, only:exact_ringspread use dustywaves, only:exact_dustywave use rochelobe, only:exact_rochelobe use gresho, only:exact_gresho use Cshock, only:exact_Cshock use transforms, only:transform,transform_inverse use plotlib, only:plot_qci,plot_qls,plot_sci,plot_sls,plot_line,plotlib_maxlinestyle integer, intent(in) :: iexact,iplotx,iploty,itransx,itransy,igeom integer, intent(in) :: ndim,ndimV,npart,imarker,iaxisy real, intent(in) :: time,xmin,xmax,gamma,unitsx,unitsy real, intent(in) :: pmassmin,pmassmax real, intent(in) :: xplot(npart),yplot(npart) integer, intent(in) :: itag(npart) integer(int1), intent(in) :: iamtype(:) integer, intent(in) :: noftype(maxparttypes) logical, intent(in) :: iplot_type(maxparttypes) logical, intent(in) :: irescale real, parameter :: zero = 1.e-10 integer :: i,ierr,iexactpts,iCurrentColour,iCurrentLineStyle,LineStyle real, allocatable :: xexact(:),yexact(:),xtemp(:) real :: dx,timei,gammai character(len=len(filename_exact)) :: filename_tmp ! !--change line style and colour settings, but save old ones ! call plot_qci(iCurrentColour) call plot_qls(iCurrentLineStyle) call plot_sci(iExactLineColour) call plot_sls(iExactLineStyle) ! !--allocate memory ! allocate(xexact(maxexactpts),yexact(maxexactpts),xtemp(maxexactpts),stat=ierr) if (ierr /= 0) then print "(a)",'*** ERROR allocating memory for exact solution plotting, skipping ***' if (allocated(xexact)) deallocate(xexact) if (allocated(yexact)) deallocate(yexact) if (allocated(xtemp)) deallocate(xtemp) return endif ! !--set x axis (can be overwritten) ! Need to space x in transformed space (e.g. in log space) ! but send the values of x in *real* space to the calculation routines ! then need to plot x in transformed space ! ! Best solution is to set x grid initially, and inverse transform to get x values. ! These values can then be overwritten, if required in the exact subroutines ! We then re-transform the x array to plot it, which means that if spacing is ! overwritten the resulting array can still be transformed into log space ! but spacing will not be even ! !--note that xmin and xmax will already have been transformed prior to input ! as these were the limits used for plotting the particles ! dx = (xmax - xmin)/real(maxexactpts) do i=1,maxexactpts xexact(i) = xmin + (i-1)*dx enddo xtemp = xexact if (itransx.gt.0) call transform_inverse(xexact,itransx) iexactpts = maxexactpts ! !--exact solution plots must return a zero or negative value of ierr to be plotted ! (-ve ierr indicates a partial solution) ! ierr = 666 ! !--use time=0 if time has not been read from dump file (indicated by t < 0) ! if (time > 0) then timei = time else timei = 0. endif if (use_gamma_exact .and. gamma_exact >= 1.) then gammai = gamma_exact elseif (gamma >= 1.) then gammai = gamma else gammai = 5./3. endif select case(iexact) case(1) ! arbitrary function parsing do i=1,nfunc if ((iplotx.eq.iexactplotx(i) .and. iploty.eq.iexactploty(i)) .or. iexactploty(i).eq.0) then call exact_function(funcstring(i),xexact,yexact,timei,ierr) !--plot each solution separately and calculate errors call plot_exact_solution(itransx,itransy,iexactpts,npart,xexact,yexact,xplot,yplot, & itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy) ierr = 1 ! indicate that we have already plotted the solution endif enddo case(2) ! exact solution read from file do i=1,nfiles if (iplotx.eq.iexactplotx(i) .and. iploty.eq.iexactploty(i)) then !--substitute %f for filename filename_tmp = filename_exact(i) call string_replace(filename_tmp,'%f',trim(rootname(ifileopen))) !--read exact solution from file call exact_fromfile(filename_tmp,xexact,yexact,ixcolfile(i),iycolfile(i),iexactpts,ierr) !--plot this untransformed (as may already be in log space) if (ierr <= 0) then if (iApplyTransExactFile) then !--change into physical units if appropriate if (iRescale .and. iApplyUnitsExactFile) then xexact(1:iexactpts) = xexact(1:iexactpts)*unitsx yexact(1:iexactpts) = yexact(1:iexactpts)*unitsy endif endif !--change line style between files LineStyle = mod(iExactLineStyle+i-1,plotlib_maxlinestyle) !--plot each solution separately and calculate errors call plot_exact_solution(itransx,itransy,iexactpts,npart,xexact,yexact,xplot,yplot,& itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy,ls=LineStyle) ierr = 1 ! indicate that we have already plotted the solution endif endif enddo case(3)! shock tube if (iplotx.eq.ix(1) .and. igeom.le.1) then if (iploty.eq.irho) then call exact_shock(1,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R, & rdust_to_gas,xexact,yexact,ierr) elseif (iploty.eq.ipr) then call exact_shock(2,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R, & rdust_to_gas,xexact,yexact,ierr) elseif (iploty.eq.ivx) then call exact_shock(3,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R, & rdust_to_gas,xexact,yexact,ierr) elseif (iploty.eq.iutherm) then call exact_shock(4,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R, & rdust_to_gas,xexact,yexact,ierr) elseif (iploty.eq.ideltav) then call exact_shock(5,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R, & rdust_to_gas,xexact,yexact,ierr) elseif (iploty.eq.idustfrac) then call exact_shock(6,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R, & rdust_to_gas,xexact,yexact,ierr) endif endif case(4)! sedov blast wave ! this subroutine does change xexact if (iplotx.eq.irad .or. (igeom.eq.3 .and. iplotx.eq.ix(1))) then if (iploty.eq.irho) then call exact_sedov(1,timei,gammai,rhosedov,esedov,xmax,xexact,yexact,ierr) elseif (iploty.eq.ipr) then call exact_sedov(2,timei,gammai,rhosedov,esedov,xmax,xexact,yexact,ierr) elseif (iploty.eq.iutherm) then call exact_sedov(3,timei,gammai,rhosedov,esedov,xmax,xexact,yexact,ierr) elseif (iploty.eq.ike) then call exact_sedov(4,timei,gammai,rhosedov,esedov,xmax,xexact,yexact,ierr) elseif (iploty.eq.ivx .and. igeom.eq.3) then call exact_sedov(5,timei,gammai,rhosedov,esedov,xmax,xexact,yexact,ierr) endif elseif (igeom.le.1 .and. is_coord(iplotx,ndim) .and. is_coord(iploty,ndim)) then call exact_sedov(0,timei,gammai,rhosedov,esedov,xmax,xexact,yexact,ierr) endif case(5)! polytrope if (iploty.eq.irho .and. (iplotx.eq.irad .or.(igeom.eq.3 .and. iplotx.eq.ix(1)))) then call exact_polytrope(gammai,polyk,totmass,xexact,yexact,iexactpts,ierr) endif case(6)! toy star if (iBfirst.ne.0) then sigma = sigma0 else sigma = 0. endif if (ndim.eq.1) then ! !--1D toy star solutions ! if (iplotx.eq.ix(1) .or. iplotx.eq.irad) then! if x axis is x or r if (iploty.eq.irho) then call exact_toystar1D(1,timei,gammai,htstar,atstar,ctstar,sigma,norder, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.ipr) then call exact_toystar1D(2,timei,gammai,htstar,atstar,ctstar,sigma,norder, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.iutherm) then call exact_toystar1D(3,timei,gammai,htstar,atstar,ctstar,sigma,norder, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.ivx) then call exact_toystar1D(4,timei,gammai,htstar,atstar,ctstar,sigma,norder, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.iBfirst+1) then call exact_toystar1D(5,timei,gammai,htstar,atstar,ctstar,sigma,norder, & xexact,yexact,iexactpts,ierr) endif elseif (iplotx.eq.irho) then if (iploty.eq.iBfirst+1) then call exact_toystar1D(6,timei,gammai,htstar,atstar,ctstar,sigma,norder, & xexact,yexact,iexactpts,ierr) endif endif if (iploty.eq.iacplane) then! plot point on a-c plane call exact_toystar1D(7,timei,gammai,htstar,atstar,ctstar,sigma,norder, & xexact,yexact,iexactpts,ierr) endif else ! !--2D toy star solutions ! these routines change xexact ! if (igeom.eq.1 .and.((iplotx.eq.ix(1) .and. iploty.eq.ivx) & .or. (iplotx.eq.ix(2) .and. iploty.eq.ivx+1))) then call exact_toystar2D(4,timei,gammai,polyk,totmass, & atstar,htstar,ctstar,norder,morder, & alphatstar,betatstar,ctstar1,ctstar2,xexact,yexact,ierr) endif if (iplotx.eq.irad .or. (igeom.eq.2 .and. iplotx.eq.ix(1))) then if (iploty.eq.irho) then call exact_toystar2D(1,timei,gammai,polyk,totmass, & atstar,htstar,ctstar,norder,morder, & alphatstar,betatstar,ctstar1,ctstar2,xexact,yexact,ierr) elseif (iploty.eq.ipr) then call exact_toystar2D(2,timei,gammai,polyk,totmass, & atstar,htstar,ctstar,norder,morder, & alphatstar,betatstar,ctstar1,ctstar2,xexact,yexact,ierr) elseif (iploty.eq.iutherm) then call exact_toystar2D(3,timei,gammai,polyk,totmass, & atstar,htstar,ctstar,norder,morder, & alphatstar,betatstar,ctstar1,ctstar2,xexact,yexact,ierr) elseif (igeom.eq.2 .and. iploty.eq.ivx) then call exact_toystar2D(4,timei,gammai,polyk,totmass, & atstar,htstar,ctstar,norder,morder, & alphatstar,betatstar,ctstar1,ctstar2,xexact,yexact,ierr) elseif (iploty.eq.ike) then call exact_toystar2D(5,timei,gammai,polyk,totmass, & atstar,htstar,ctstar,norder,morder, & alphatstar,betatstar,ctstar1,ctstar2,xexact,yexact,ierr) endif elseif (is_coord(iplotx,ndim) .and. is_coord(iploty,ndim) .and. igeom.eq.1) then call exact_toystar2D(0,timei,gammai,polyk,totmass, & atstar,htstar,ctstar,norder,morder, & alphatstar,betatstar,ctstar1,ctstar2,xexact,yexact,ierr) endif endif case(7)! Gresho vortex !if ((iploty.eq.iwaveploty).and.(iplotx.eq.iwaveplotx)) then ! ymean = SUM(yplot(1:npart))/REAL(npart) ! call exact_wave(timei,ampl,period,lambda,xzero,ymean,xexact,yexact,ierr) !endif if (igeom.eq.2 .and. ndim.ge.2) then if (iploty.eq.ivx+1) then call exact_gresho(1,xexact,yexact,ierr) elseif (iploty.eq.ipr) then call exact_gresho(2,xexact,yexact,ierr) endif endif case(8) ! mhd shock tubes ! this subroutine modifies xexact if (iplotx.eq.ix(1) .and. igeom.le.1) then if (iploty.eq.irho) then call exact_mhdshock(1,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.ipr) then call exact_mhdshock(2,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.ivx) then call exact_mhdshock(3,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.ivx+1 .and. ndimV.gt.1) then call exact_mhdshock(4,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.ivx+ndimV-1 .and. ndimV.gt.2) then call exact_mhdshock(5,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.iBfirst+1 .and. ndimV.gt.1) then call exact_mhdshock(6,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.iBfirst+ndimV-1 .and. ndimV.gt.2) then call exact_mhdshock(7,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.iutherm) then call exact_mhdshock(8,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) elseif (iploty.eq.iBfirst) then call exact_mhdshock(9,ishk,timei,gammai,xmin,xmax,xshock, & xexact,yexact,iexactpts,ierr) endif endif case(9) !--h = (1/rho)^(1/ndim) if (((iploty.eq.ih).and.(iplotx.eq.irho)) .or. & ((iplotx.eq.ih).and.(iploty.eq.irho))) then if (iplotx.eq.ih) then call exact_rhoh(2,ndim,hfact,pmassmin,xexact,yexact,ierr) else call exact_rhoh(1,ndim,hfact,pmassmin,xexact,yexact,ierr) endif !--if variable particle masses, plot one for each pmass value if (abs(pmassmin-pmassmax).gt.zero .and. pmassmin.gt.zero) then !--plot first line if (ierr.le.0) then xtemp = xexact ! must not transform xexact as this is done again below if (itransx.gt.0) call transform(xtemp,itransx) if (itransy.gt.0) call transform(yexact,itransy) call plot_line(iexactpts,xtemp(1:iexactpts),yexact(1:iexactpts)) endif !--leave this one to be plotted below if (iplotx.eq.ih) then call exact_rhoh(2,ndim,hfact,pmassmax,xexact,yexact,ierr) else call exact_rhoh(1,ndim,hfact,pmassmax,xexact,yexact,ierr) endif endif endif case(10) ! density profiles if (iplotx.eq.irad .or.(igeom.eq.3 .and. iplotx.eq.ix(1))) then if (iploty.eq.irho) then call exact_densityprofiles(1,iprofile,Msphere,rsoft,xexact,yexact,ierr) elseif (iploty.eq.icolpoten) then call exact_densityprofiles(2,iprofile,Msphere,rsoft,xexact,yexact,ierr) elseif (iploty.eq.icolfgrav) then call exact_densityprofiles(3,iprofile,Msphere,rsoft,xexact,yexact,ierr) endif endif case(11) ! torus if (iplotx.eq.irad .or.(igeom.eq.3 .and. iplotx.eq.ix(1))) then if (iploty.eq.irho) then call exact_torus(1,1,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) elseif (iploty.eq.ipr) then call exact_torus(2,1,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) elseif (iploty.eq.iutherm) then call exact_torus(3,1,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) endif !--pr vs z at r=Rtorus elseif (igeom.eq.2 .and. iplotx.eq.ix(3) .and.iploty.eq.ipr) then call exact_torus(4,1,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) endif !--solutions for tokamak torus if (igeom.eq.4 .and. iplotx.eq.ix(1)) then if (iploty.eq.irho) then call exact_torus(1,2,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) elseif (iploty.eq.ipr) then call exact_torus(2,2,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) elseif (iploty.eq.iutherm) then call exact_torus(3,2,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) elseif (iploty.eq.iBfirst+1 .and. iBfirst.gt.0) then call exact_torus(4,2,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) elseif (iploty.eq.iJfirst+2 .and. iJfirst.gt.0) then call exact_torus(5,2,Mstar,Rtorus,polyk,distortion,gammai,xexact,yexact,ierr) endif endif case(12) if (iplotx.eq.irad .or.((igeom.eq.3 .or. igeom.eq.2) .and. iplotx.eq.ix(1))) then if (iploty.eq.irho) then call exact_ringspread(1,timei,Mring,Rring,viscnu,xexact,yexact,ierr) endif endif case(13) ! special relativistic shock tube if (iplotx.eq.ix(1) .and. igeom.le.1) then if (iploty.eq.irhorestframe) then call exact_shock_sr(1,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R,xexact,yexact,ierr) elseif (iploty.eq.ipr) then call exact_shock_sr(2,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R,xexact,yexact,ierr) elseif (iploty.eq.ivx) then call exact_shock_sr(3,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R,xexact,yexact,ierr) elseif (iploty.eq.iutherm) then call exact_shock_sr(4,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R,xexact,yexact,ierr) elseif (iploty.eq.irho) then call exact_shock_sr(5,timei,gammai,rho_L,rho_R,pr_L,pr_R,v_L,v_R,xexact,yexact,ierr) endif endif case(14) ! dusty wave exact solution if (iplotx.eq.ix(1) .and. igeom.le.1) then if (iploty.eq.ivx) then !--plot gas solution and calculate errors call exact_dustywave(1,timei,ampl,cs,Kdrag,lambda,xzero,rhozero,rhozero*rdust_to_gas,xexact,yexact,ierr) call plot_exact_solution(itransx,itransy,iexactpts,npart,xexact,yexact,xplot,yplot, & itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy,ls=1) !--plot dust solution if (Kdrag > 0.) then call exact_dustywave(2,timei,ampl,cs,Kdrag,lambda,xzero,rhozero,rhozero*rdust_to_gas,xexact,yexact,ierr) call plot_exact_solution(itransx,itransy,iexactpts,npart,xexact,yexact,xplot,yplot, & itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy,ls=2,err=.false.) endif ierr = 1 elseif (iploty.eq.irho) then !--plot gas solution and calculate errors call exact_dustywave(3,timei,ampl,cs,Kdrag,lambda,xzero,rhozero,rhozero*rdust_to_gas,xexact,yexact,ierr) call plot_exact_solution(itransx,itransy,iexactpts,npart,xexact,yexact,xplot,yplot,& itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy,ls=1) !--plot dust solution if (Kdrag > 0.) then call exact_dustywave(4,timei,ampl,cs,Kdrag,lambda,xzero,rhozero,rhozero*rdust_to_gas,xexact,yexact,ierr) call plot_exact_solution(itransx,itransy,iexactpts,npart,xexact,yexact,xplot,yplot,& itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy,ls=2,err=.false.) endif ierr = 1 endif endif case(15) ! Roche potential if (igeom.eq.1 .and. ndim.ge.2 .and. iplotx.eq.ix(1) .and. iploty.eq.ix(2)) then call exact_rochelobe(xprim(1),xprim(2),xsec(1),xsec(2),mprim,msec,xexact,yexact,ierr) endif case(16) ! C-shock if (ndim.ge.1 .and. iplotx.eq.ix(1) .and. igeom.le.1) then if (iploty.eq.irho) then call exact_Cshock(1,timei,gammai,machs,macha,xmin,xmax,xexact,yexact,ierr) elseif (iploty.eq.iBfirst+1 .and. iBfirst.gt.0) then call exact_Cshock(2,timei,gammai,machs,macha,xmin,xmax,xexact,yexact,ierr) elseif (iploty.eq.ivx) then call exact_Cshock(3,timei,gammai,machs,macha,xmin,xmax,xexact,yexact,ierr) elseif (iploty.eq.ivx+1 .and. ndimV > 1) then call exact_Cshock(4,timei,gammai,machs,macha,xmin,xmax,xexact,yexact,ierr) elseif (iploty.eq.iBfirst .and. iBfirst.gt.0) then call exact_Cshock(5,timei,gammai,machs,macha,xmin,xmax,xexact,yexact,ierr) endif endif end select !---------------------------------------------------------- ! plot this as a line on the current graph !---------------------------------------------------------- if (ierr <= 0) call plot_exact_solution(itransx,itransy,iexactpts,npart,xexact,yexact,xplot,yplot, & itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy) ! !--reset line and colour settings ! call plot_sci(iCurrentColour) call plot_sls(iCurrentLineStyle) ! !--deallocate memory ! if (allocated(xexact)) deallocate(xexact) if (allocated(yexact)) deallocate(yexact) if (allocated(xtemp)) deallocate(xtemp) return end subroutine exact_solution !------------------------------------------------------------------ ! Wrapper routine to plot the exact solution line on current graph ! and calculate errors with respect to the data !------------------------------------------------------------------ subroutine plot_exact_solution(itransx,itransy,iexactpts,np,xexact,yexact,xplot,yplot,& itag,iamtype,noftype,iplot_type,xmin,xmax,imarker,iaxisy,ls,err) use transforms, only:transform,transform_inverse use plotlib, only:plot_line,plot_sls,plot_sci,plot_qci use params, only:int1,maxparttypes integer, intent(in) :: itransx,itransy,iexactpts,np,imarker,iaxisy real, intent(inout) :: xexact(:),yexact(:) real, intent(in) :: xplot(:),yplot(:),xmin,xmax integer, intent(in) :: itag(:) integer(int1), intent(in) :: iamtype(:) integer, intent(in) :: noftype(maxparttypes) logical, intent(in) :: iplot_type(maxparttypes) integer, intent(in), optional :: ls logical, intent(in), optional :: err real :: residuals(np),ypart(np) real :: errL1,errL2,errLinf integer :: iused,ierr,iCurrentColour logical :: plot_err character(len=12) :: str1,str2 call plot_qci(iCurrentColour) call plot_sci(iExactLineColour) if (itransx > 0) call transform(xexact(1:iexactpts),itransx) if (itransy > 0) call transform(yexact(1:iexactpts),itransy) if (present(ls)) call plot_sls(ls) call plot_line(iexactpts,xexact(1:iexactpts),yexact(1:iexactpts)) ! !--calculate errors ! if (present(err)) then plot_err = err else plot_err = .true. endif if (iCalculateExactErrors .and. plot_err) then !--untransform y axis again for error calculation if (itransy > 0) call transform_inverse(yexact(1:iexactpts),itransy) !--untransform particle y axis also ypart(1:np) = yplot(1:np) if (itransy > 0) call transform_inverse(ypart(1:np),itransy) !--calculate errors call calculate_errors(xexact(1:iexactpts),yexact(1:iexactpts),xplot(1:np),ypart,& itag,iamtype,noftype,iplot_type,xmin,xmax,residuals, & errL1,errL2,errLinf,iused) if (iused.ne.np) then write(str1,"(i12)",iostat=ierr) iused write(str2,"(i12)",iostat=ierr) np print "(3(a,es12.5,1x),'(used ',a,'/',a,' parts)')",' L1 err = ',errL1,'L2 err = ',errL2, & 'L(inf) err = ',errLinf,trim(adjustl(str1)),trim(adjustl(str2)) else print "(3(a,es12.5,1x))",' L1 err = ',errL1,'L2 err = ',errL2, & 'L(inf) err = ',errLinf endif if (iPlotResiduals) then call plot_sci(1) call plot_residuals(xplot,residuals,imarker,iaxisy) endif endif call plot_sci(iCurrentColour) end subroutine plot_exact_solution !-------------------------------- ! Calculate various error norms !-------------------------------- subroutine calculate_errors(xexact,yexact,xpts,ypts,itag,iamtype,noftype,iplot_type,& xmin,xmax,residual,errL1,errL2,errLinf,iused) use part_utils, only:igettype use params, only:int1,maxparttypes real, intent(in) :: xexact(:),yexact(:),xpts(:),ypts(:),xmin,xmax integer, intent(in) :: itag(:) integer(int1), intent(in) :: iamtype(:) integer, intent(in) :: noftype(maxparttypes) logical, intent(in) :: iplot_type(maxparttypes) real, intent(out) :: residual(size(xpts)) real, intent(out) :: errL1,errL2,errLinf integer, intent(out) :: iused integer :: i,j,npart,nerr,nused,itype real :: xi,dy,dx,yexacti,err1,ymax logical :: mixedtypes errL1 = 0. errL2 = 0. errLinf = 0. residual = 0. npart = size(xpts) iused = 0 ymax = 0. nerr = 0 nused = 0 mixedtypes = size(iamtype).gt.1 do i=1,npart xi = xpts(i) yexacti = 0. if (xi >= xmin .and. xi <= xmax .and. itag(i) > 0) then if (mixedtypes) then itype = min(max(int(iamtype(i)),1),maxparttypes) else itype = igettype(i,noftype) endif if (iplot_type(itype)) then ! !--find nearest point in exact solution table ! do j=1,size(xexact)-1 if (xexact(j).lt.xi .and. xexact(j+1).gt.xi) then if (abs(residual(i)).gt.tiny(residual)) nerr = nerr + 1 !--linear interpolation from tabulated exact solution dy = yexact(j+1) - yexact(j) dx = xexact(j+1) - xexact(j) if (dx.gt.0.) then yexacti = yexact(j) + dy/dx*(xi - xexact(j)) residual(i) = ypts(i) - yexacti elseif (dy.gt.0.) then yexacti = yexact(j) residual(i) = ypts(i) - yexacti else nerr = nerr + 1 residual(i) = 0. endif iused = iused + 1 ymax = max(ymax,abs(yexacti)) endif enddo err1 = abs(residual(i)) errL1 = errL1 + err1 errL2 = errL2 + err1**2 errLinf = max(errLinf,err1) if (yexacti.gt.tiny(yexacti)) residual(i) = residual(i)/abs(yexacti) nused = nused + 1 endif endif enddo ! !--normalise errors (use maximum y value) ! if (ymax.gt.tiny(ymax) .and. nused > 0) then errL1 = errL1/(nused*ymax) errL2 = sqrt(errL2/(nused*ymax**2)) errLinf = errLinf/ymax else print "(a)",' error normalising errors' errL1 = 0. errL2 = 0. errLinf = 0. endif if (nerr.gt.0) print*,'WARNING: ',nerr,' errors in residual calculation' return end subroutine calculate_errors !------------------------------------ ! Plot residual errors as inset plot !------------------------------------ subroutine plot_residuals(xpts,residuals,imarker,iaxisy) use plotlib, only:plot_qvp,plot_qwin,plot_svp,plot_qci,plot_qfs, & plot_qcs,plot_sci,plot_sfs,plot_svp,plot_box, & plot_pt,plot_swin,plot_rect real, intent(in) :: xpts(:),residuals(:) integer, intent(in) :: imarker,iaxisy real :: vptxminold,vptxmaxold,vptyminold,vptymaxold real :: vptxmin,vptxmax,vptymin,vptymax real :: xminold,xmaxold,yminold,ymaxold,ymin,ymax real :: xch,ych integer :: ioldcolour,ioldfill !--query old viewport and window size call plot_qvp(0,vptxminold,vptxmaxold,vptyminold,vptymaxold) call plot_qwin(xminold,xmaxold,yminold,ymaxold) !--use specified bottom % of viewport vptxmin = vptxminold vptxmax = vptxmaxold vptymin = vptyminold vptymax = vptyminold + FracinsetResiduals*(vptymaxold - vptyminold) call plot_svp(vptxmin,vptxmax,vptymin,vptymax) !--set window if (residualmax.lt.tiny(residualmax)) then ymax = maxval(abs(residuals)) print*,'max residual = ',ymax else ymax = residualmax endif ymin = -ymax !--erase space for residual plot call plot_qci(ioldcolour) call plot_qfs(ioldfill) call plot_qcs(0,xch,ych) call plot_sci(0) call plot_sfs(1) if (iaxisy.lt.0) then call plot_svp(vptxmin,vptxmax,vptymin,vptymax) else call plot_svp(vptxmin - 3.*xch,vptxmax,vptymin,vptymax) endif call plot_swin(xminold,xmaxold,ymin,ymax) call plot_rect(xminold,xmaxold,ymin,ymax) !--restore fill style call plot_sfs(ioldfill) call plot_sci(1) !--set window and draw axes call plot_svp(vptxmin,vptxmax,vptymin,vptymax) call plot_swin(xminold,xmaxold,ymin,ymax) if (iaxisy.lt.0) then call plot_box('ABCST',0.0,0,'BCST',0.0,0) else call plot_box('ABCST',0.0,0,'BVNCST',0.0,0) endif !--plot residuals call plot_sci(ioldcolour) call plot_pt(size(xpts),xpts,residuals,imarker) !--restore old viewport, window and colour index call plot_svp(vptxminold,vptxmaxold,vptyminold,vptymaxold) call plot_swin(xminold,xmaxold,yminold,ymaxold) end subroutine plot_residuals end module exact splash/src/exact_Cshock.f90000644 000770 000000 00000013212 12370535231 016455 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! Plot exact solution for a magnetohydrodynamic oblique C-shock ! (ie. one dimensional MHD shock problem with ambipolar diffusion) ! ! Solution from Mac-Low, Norman, Konigl & Wardle (1995), ApJ 442, 726 ! http://adsabs.harvard.edu/abs/1995ApJ...442..726M ! ! ---------------------------------------------------------------------- module Cshock implicit none public :: exact_Cshock contains subroutine exact_Cshock(iplot,time,gamma,machs,macha,xmin,xmax,xpts,ypts,ierr) integer, intent(in) :: iplot integer, intent(out) :: ierr real, intent(in) :: time,gamma,machs,macha,xmin,xmax real, dimension(:), intent(inout) :: xpts real, dimension(size(xpts)), intent(out) :: ypts real, dimension(size(xpts)) :: D real, parameter :: pi = 3.1415926536 real :: theta,xshock,ambi_gamma,ambi_rhoi,vx0,vy0,Bx,By,rhon_pre real :: cs,rhon0,Bfield0,b0,shockl,vs,va,K1,K2,By_post,P_post,rhon_post,By0,Pr0 real :: sintheta,costheta,vx2,vx,vy,rhon,dvx,vxin integer :: npts,i logical printout printout = .false. npts = size(xpts) theta = pi/4. costheta = cos(theta) sintheta = sin(theta) D(npts) = 1. + 1.e-6 ! upstream cs = 0.1 rhon0 = 1. Bfield0 = 1. ! this gives Bx0 = By0 = 1/sqrt(2) as in Choi et al. (2009) ambi_gamma = 1. ambi_rhoi = 1.e-5 b0 = sintheta shockl = Bfield0/(ambi_gamma*ambi_rhoi*sqrt(rhon0)) va = Bfield0/sqrt(rhon0) xshock = 6./8.*va*time if ( printout ) open(unit = 625,file="Cshock_splash.dat") print "(4(a,g8.2))",& ' Plotting exact C-shock at t = ',time,' M = ',machs,' M_A = ',macha,' theta = ',theta print "(4(a,es10.3))",' shock length L = ',shockL,' shock is at x = ',xshock call integrate(xmin,xmax,xshock,xpts,macha,machs,theta,shockl,D,npts) ! ! compute velocity jump across shock: See Mac-Low et al. (1995). This is the difference ! in the velocity across the shock front since we assume that the ! post-shock gas is at rest ! ! !--post-shock, assume vx = 0 By_post = Bfield0*get_b(b0,macha,machs,D(1)) rhon_post = D(1)*rhon0 P_post = rhon_post*cs**2 ! K1 = P_post + 0.5*By_post*By_post ! print*,' K1 is ',K1 !--pre-shock vx0 = -5.0 vxin = -4.45 dvx = vxin-vx0 vy0 = 0. Bx = Bfield0*costheta By0 = Bfield0*get_b(b0,macha,machs,D(npts)) rhon_pre = D(npts)*rhon0 Pr0 = rhon_pre*cs**2 K1 = Pr0 + 0.5*By0*By0 + rhon_pre*vx0**2 K2 = rhon_pre*vx0*vy0 - Bx*By0 vx2 = (K1 - 0.5*By_post**2 - P_post)/rhon_post if (vx2 > 0.) then vx = -sqrt(vx2) print "(1x,a,g10.3)",'vx post-shock = ',vx else vx = 0. print*,'error, post-shock vx is imaginary' endif vs = vx0 - vx !print*,'vs = ',vs ! !--determine which parameter to plot ! do i=1,npts rhon = D(i)*rhon0 By = Bfield0*get_b(b0,macha,machs,D(i)) vx2 = (K1 - 0.5*By**2 - rhon*cs**2)/rhon if (vx2 > epsilon(vx2)) then vx = -sqrt(vx2) vy = (K2 + Bx*By)/(rhon*vx) else vx = 0. vy = 0. endif vx = vx + dvx select case(iplot) case(1) ypts(i) = rhon ! rho (neutrals) case(2) ypts(i) = By case(3) ! vx (neutrals) ypts(i) = vx case(4) ! vy (neutrals) ypts(i) = vy case(5) ! Bx ypts(i) = Bx case default ypts(i) = 0. end select if ( printout ) write(625,*) i,xpts(i),rhon,Bx,By,vx,vy enddo ierr = 0 if ( printout ) close(625) return end subroutine exact_Cshock real function rhs(D,macha,machs,theta,shockl) real, intent(in) :: D,macha,machs,theta,shockl real :: term,sintheta,costheta2,b0,b term = (1./D**2 - 1./machs**2)*shockl sintheta = sin(theta) costheta2 = cos(theta)**2 b0 = sintheta b = get_b(b0,macha,machs,D) rhs = b/macha*(b - D*((b - b0)/macha**2*costheta2 + sintheta))/(b**2 + costheta2)/term end function rhs real function get_b(b0,macha,machs,D) real, intent(in) :: b0,macha,machs,D get_b = sqrt(b0**2 + 2.*macha**2*(D-1.)*(1./D - 1./machs**2)) end function get_b subroutine integrate(xmin,xmax,xshock,xpts,macha,machs,theta,shockl,D,npts) integer, intent(in) :: npts real, intent(in) :: xmin,xmax,xshock,macha,machs,theta,shockl real, dimension(npts), intent(inout) :: xpts real, dimension(npts), intent(inout) :: D real :: Dhalf,dx,xminshock integer :: i ! ! set up grid to have good resolution around the shock ! and just two points extending to xmin and xmax ! xminshock = min(xshock - 100.*shockl,xmin) dx = (xshock - xminshock)/real(npts-1) xpts(npts) = xmax xpts(1) = xmin do i=2,npts-1 xpts(i) = xmin + (i-1)*dx enddo do i=npts-1,1,-1 if (xpts(i) > xshock) then D(i) = D(i+1) else !--mid-point rule Dhalf = D(i+1) - 0.5*dx*rhs(D(i+1),macha,machs,theta,-shockl) D(i) = D(i+1) - dx*rhs(Dhalf,macha,machs,theta,-shockl) endif enddo end subroutine integrate end module Cshock splash/src/exact_densityprofiles.f90000644 000770 000000 00000006644 11622211702 020472 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! Plots various analytic density profiles ! ! Currently implemented: ! ! 1) Plummer sphere ! 2) Hernquist sphere ! ! Added by D. Price 5/9/05 ! ---------------------------------------------------------------------- module densityprofiles implicit none contains subroutine exact_densityprofiles(iplot,iprofile,Msphere,rsoft,xplot,yplot,ierr) implicit none real, parameter :: pi = 3.1415926536 integer, intent(in) :: iplot,iprofile real, intent(in), dimension(2) :: Msphere,rsoft real, intent(in), dimension(:) :: xplot real, intent(out), dimension(size(xplot)) :: yplot integer, intent(out) :: ierr integer :: i ! ! check for errors ! ierr = 0 if (all(Msphere.le.0.)) then print*,'error: mass <= 0 in exact_densityprofile' ierr = 2 return endif if (any(rsoft.lt.0.)) then print*,'error: rsoft < 0 in exact_densityprofile' ierr = 3 return endif select case(iprofile) case(1) ! !--Plummer sphere ! select case(iplot) case(2) !--potential do i=1,size(xplot) yplot(i) = -Msphere(1)/sqrt(rsoft(1)**2 + xplot(i)**2) & -Msphere(2)/sqrt(rsoft(2)**2 + xplot(i)**2) enddo !--force case(3) do i=1,size(xplot) yplot(i) = Msphere(1)*xplot(i)/((rsoft(1)**2 + xplot(i)**2)**1.5) & + Msphere(2)*xplot(i)/((rsoft(2)**2 + xplot(i)**2)**1.5) enddo !--density case default do i=1,size(xplot) yplot(i) = 3.*Msphere(1)*rsoft(1)**2/(4.*pi*(rsoft(1)**2 + xplot(i)**2)**2.5) & + 3.*Msphere(2)*rsoft(2)**2/(4.*pi*(rsoft(2)**2 + xplot(i)**2)**2.5) enddo end select case(2) ! !--Hernquist model (use tiny to prevent divergences in cusp) ! select case(iplot) case(2) !--potential do i=1,size(xplot) yplot(i) = -Msphere(1)/(rsoft(1) + xplot(i)) & -Msphere(2)/(rsoft(2) + xplot(i)) enddo !--force case(3) do i=1,size(xplot) yplot(i) = Msphere(1)/(rsoft(1) + xplot(i))**2 & + Msphere(2)/(rsoft(2) + xplot(i))**2 enddo !--density case default do i=1,size(xplot) yplot(i) = Msphere(1)*rsoft(1)/ & ((2.*pi*xplot(i)*(rsoft(1) + xplot(i))**3)) & + Msphere(2)*rsoft(2)/ & ((2.*pi*xplot(i)*(rsoft(2) + xplot(i))**3)) enddo end select case default ierr = 1 end select return end subroutine exact_densityprofiles end module densityprofiles splash/src/exact_dustywaves.f90000644 000770 000000 00000675314 12336513215 017502 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! compute exact solution for a linear wave ! plots a sine function with a given amplitude, period and wavelength ! ---------------------------------------------------------------------- module dustywaves implicit none contains subroutine exact_dustywave(iplot,time,ampl,cs,Kdragin,lambda,x0,rhog0,rhod0,xplot,yplot,ierr) use cubic, only:cubicsolve_complex implicit none integer :: i real, parameter :: pi = 3.1415926536 integer, intent(in) :: iplot real, intent(in) :: time, ampl, cs, Kdragin, lambda, x0, rhog0, rhod0 real, intent(in) :: xplot(:) real, intent(out) :: yplot(size(xplot)) integer, intent(out) :: ierr real :: rhodeq,rhogeq,rhodsol,rhogsol,vdeq,vgeq,vgsol,vdsol real :: aa,bb,cc,w1r,w2r,w3r,w1i,w2i,w3i real :: k,xk,arg1,arg2,arg3,vgas,vdust,rhogas,rhodust real :: vd1r,vd1i,vd2r,vd2i,vd3r,vd3i real :: vg1r,vg1i,vg2r,vg2i,vg3r,vg3i real :: rhod1r,rhod1i,rhod2r,rhod2i,rhod3r,rhod3i real :: rhog1r,rhog1i,rhog2r,rhog2i,rhog3r,rhog3i real :: tgas1,tdust1,Kdrag complex :: xc(3) Kdrag = Kdragin if (mod(iplot,2).eq.1) then print*,'plotting two-fluid gas/dust linear wave solution ... ' print*,' lambda = ',lambda,' ampl = ',ampl,' cs = ',cs,' Kdrag = ',Kdrag endif ! ! check for errors ! ierr = 0 if (ampl.lt.0.) then print*,'error: amplitude < 0 on input' ierr = 1 return endif if (lambda <= 0.) then print*,'error: lambda <= 0 on input' ierr = 2 return endif if (cs <= 0) then print*,'error: sound speed <= 0 on input' ierr = 3 return endif if (rhog0 < 0) then print*,'error: gas density < 0 on input' ierr = 4 return endif if (rhod0 < 0) then print*,'error: dust density < 0 on input' ierr = 4 return endif if (Kdrag < 0) then print*,'error: drag coefficient < 0 on input' ierr = 5 return elseif (abs(Kdrag).lt.1.e-8) then print*,' WARNING: Kdrag = 0 on input; using tiny to avoid divergence ' Kdrag = 0. endif rhodeq = rhod0 ! initial dust density rhogeq = rhog0 ! initial gas density if (mod(iplot,2).eq.1) print*,' rho(dust),0 = ',rhod0,' rho(gas),0 = ',rhog0 select case(iplot) case(4) print*,'(dust density)' case(3) print*,'(gas density)' case(2) print*,'(dust velocity)' case default print*,'(gas velocity)' end select rhodsol = ampl*rhod0 ! amplitude of dust density perturbation rhogsol = ampl*rhog0 ! amplitude of gas density perturbation vdeq = 0. vgeq = 0. vgsol = ampl ! amplitude of gas velocity perturbation vdsol = ampl ! amplitude of dust velocity perturbation k = 2.*pi/lambda ! wavenumber vd1r = 0. vd1i = 0. vd2r = 0. vd2i = 0. vd3r = 0. vd3i = 0. rhod1r = 0. rhod1i = 0. rhod2r = 0. rhod2i = 0. rhod3r = 0. rhod3i = 0. ! !--solve cubic to get the 3 solutions for omega ! (these each have both real and imaginary components, ! labelled w1r, w1i etc.) ! tdust1 = Kdrag/rhodeq tgas1 = Kdrag/rhogeq aa = (tdust1 + tgas1) bb = k**2*cs**2 cc = bb*tdust1 call cubicsolve_complex(aa,bb,cc,xc) !--get solutions for (w = iy instead of y) xc = xc*cmplx(0.,1.) !print*,' roots are ',xc w1r = real(xc(1)) w2r = real(xc(2)) w3r = real(xc(3)) w1i = aimag(xc(1)) w2i = aimag(xc(2)) w3i = aimag(xc(3)) !------------------------------- ! G A S V E L O C I T I E S !------------------------------- vg3r =(k*Kdrag*vdsol*w3r**2*w2r + k*Kdrag*vdsol*w3r**2*w1r - k*Kdrag*vdsol*w3r*w2r*w1r - k*Kdrag*vdsol*w3r*w3i**2 +& k*Kdrag*vdsol*w2i*w1i*w3r - k*Kdrag*vdsol*w2r*w1i*w3i + k*Kdrag*vdsol*w2r*w3i**2 - k*Kdrag*vdsol*w2i*w3i*w1r +& k*Kdrag*vdsol*w3i**2*w1r - k*Kdrag*vgsol*w3r**2*w2r - k*Kdrag*vgsol*w3r**2*w1r + k*Kdrag*vgsol*w3r*w2r*w1r +& k*Kdrag*vgsol*w3r*w3i**2 - k*Kdrag*vgsol*w2i*w1i*w3r + k*Kdrag*vgsol*w2r*w1i*w3i - k*Kdrag*vgsol*w2r*w3i**2 +& k*Kdrag*vgsol*w2i*w3i*w1r - k*Kdrag*vgsol*w3i**2*w1r - rhogsol*w3r*w3i**2*w2r*w1i - rhogsol*w3r*w3i**2*w2i*w1r& + k*rhogeq*vgsol*w3r**3*w1i + k*rhogeq*vgsol*w3r**3*w2i - k*rhogeq*vgsol*w3r**2*w2r*w3i -& k*rhogeq*vgsol*w3r**2*w3i*w1r - k*rhogeq*vgsol*w3r*w2r**2*w1i - k*rhogeq*vgsol*w3r*w1i*w2i**2 +& k*rhogeq*vgsol*w3r*w3i**2*w2i - k*rhogeq*vgsol*w2r*w3i**3 - rhogsol*w3r**3*w1i*w2r - rhogsol*w3r**3*w2i*w1r +& rhogsol*w3r**2*w2r**2*w1i + rhogsol*w3r**2*w1i*w2i**2 + rhogsol*w3r**2*w2i*w1r**2 + rhogsol*w3r**2*w2i*w1i**2 -& rhogsol*w2r**2*w1i**2*w3i + rhogsol*w2r**2*w1i*w3i**2 - rhogsol*w3i*w1r**2*w2r**2 + rhogsol*w3i**3*w1r*w2r +& rhogsol*w3i**2*w2i*w1r**2 + rhogsol*w2i*w1i**2*w3i**2 - rhogsol*w1i**2*w2i**2*w3i - rhogsol*w2i**2*w1r**2*w3i +& rhogsol*w2i**2*w3i**2*w1i - rhogsol*w2i*w3i**3*w1i - rhogsol*k**2*cs**2*w3r**2*w2i -& rhogsol*k**2*cs**2*w3r**2*w1i + rhogsol*k**2*cs**2*w3r*w1i*w2r + rhogsol*k**2*cs**2*w3r*w2i*w1r -& rhogsol*k**2*cs**2*w3i*w2r*w1r + rhogsol*k**2*cs**2*w2i*w3i*w1i - rhogsol*k**2*cs**2*w3i**2*w1i -& rhogsol*k**2*cs**2*w3i**2*w2i + rhogsol*k**2*cs**2*w3r**2*w3i - k*rhogeq*vgsol*w3r*w2i*w1r**2 +& k*rhogeq*vgsol*w3r*w3i**2*w1i - k*rhogeq*vgsol*w3r*w2i*w1i**2 + k*rhogeq*vgsol*w3i*w1r*w2r**2 +& k*rhogeq*vgsol*w3i*w2r*w1r**2 + k*rhogeq*vgsol*w3i*w2r*w1i**2 + k*rhogeq*vgsol*w3i*w1r*w2i**2 -& k*rhogeq*vgsol*w3i**3*w1r - k*Kdrag*vdsol*w3r**3 + k*Kdrag*vgsol*w3r**3 + rhogsol*k**2*cs**2*w3i**3 +& rhogsol*w3r**2*w3i*w2r*w1r - rhogsol*w3r**2*w2i*w3i*w1i)/rhogeq/k/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 -& 2*w2i*w3i + w3r**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r) vg3i = - 1/rhogeq/k*( - w3r*w3i**2*cs**2*k**2*rhogsol - w3r**3*rhogsol*k**2*cs**2 + w3r**3*w2i*rhogsol*w1i +& w3r**2*w3i*w2i*rhogeq*k*vgsol - w3r**2*w2i*w3i*w1r*rhogsol - w2r*w3r**2*w3i*rhogsol*w1i -& w2r*w1i*w3i**3*rhogsol - w2r*w3r**3*w1r*rhogsol - w3r**2*w1i*k*Kdrag*vgsol + w3r**2*w2i*k*Kdrag*vdsol +& w3r*w3i**2*k*rhogeq*w1r*vgsol + w3r*w1i*w3i**2*rhogsol*w2i - w3r**2*w2i*k*Kdrag*vgsol +& w3r**2*w1i*k*Kdrag*vdsol - w3r**2*w1i**2*k*rhogeq*vgsol + w3r**3*k*rhogeq*w1r*vgsol +& w3r**2*w3i*w1i*rhogeq*k*vgsol - w3r**2*w1r**2*rhogeq*k*vgsol + w3r**2*w1r*cs**2*k**2*rhogsol +& w3r**2*w3i*k*Kdrag*vgsol - w3r**2*w3i*k*Kdrag*vdsol + w2r*w3r*rhogeq*k*vgsol*w3i**2 +& w2r*w3r**2*cs**2*k**2*rhogsol + w2r*w3r**3*vgsol*k*rhogeq + w2r*w3i**2*cs**2*k**2*rhogsol -& w3i**2*k*rhogeq*w1r**2*vgsol + w3i**2*cs**2*k**2*rhogsol*w1r - 2*w3r**2*k*w2i*rhogeq*w1i*vgsol -& w1i**2*rhogeq*k*vgsol*w3i**2 - 2*w3i**2*k*w2i*rhogeq*w1i*vgsol - w3r**2*w2i**2*rhogeq*k*vgsol +& w2i*w1i**2*w3i*rhogeq*k*vgsol - w2i*w3i*w1i*k*Kdrag*vdsol + w2i*w3i*w1i*k*Kdrag*vgsol -& w2i*w3i*w1r*cs**2*k**2*rhogsol + w2i*rhogeq*k*vgsol*w3i*w1r**2 + w2r*w3i*w1r*k*Kdrag*vdsol -& w2i*w3i**2*k*Kdrag*vgsol - w2r*w3i*w1r*k*Kdrag*vgsol + w2i*w3i**2*k*Kdrag*vdsol -& 2*w2r*w3i**2*k*rhogeq*w1r*vgsol + w2i*w3i**3*rhogeq*k*vgsol + w3r*w2i**2*w1r*rhogeq*k*vgsol +& w2r**2*w3i**2*w1r*rhogsol - w1i*w3i**2*k*Kdrag*vgsol + w1i*rhogeq*k*vgsol*w3i**3 + w1i*w3i**2*k*Kdrag*vdsol -& w2r*w3r*w3i**2*w1r*rhogsol - w3i**3*k*Kdrag*vdsol + w3i**3*k*Kdrag*vgsol - w2r*w1i*w3i*cs**2*k**2*rhogsol -& w1r*w2i*w3i**3*rhogsol + w3i*w2r**2*w1i*rhogeq*k*vgsol + w1i**2*w3i**2*w2r*rhogsol -& w3i**2*w2i**2*rhogeq*k*vgsol + w2i**2*w3i*w1i*rhogeq*k*vgsol + w3r*w2i*w1i*cs**2*k**2*rhogsol -& w3r*w1i**2*w2r**2*rhogsol - w3r*w2i**2*w1i**2*rhogsol + w3r**2*w1i**2*w2r*rhogsol + w3r**2*w2i**2*w1r*rhogsol -& w2r**2*w3i**2*k*rhogeq*vgsol + w3r**2*w2r*w1r**2*rhogsol - w3r**2*w2r**2*rhogeq*k*vgsol +& w3r**2*w2r**2*w1r*rhogsol - w3r*w1r**2*w2i**2*rhogsol - w3r*w2r**2*w1r**2*rhogsol - w3r*w2i*w1r*k*Kdrag*vdsol +& w3r*w2i*w1r*k*Kdrag*vgsol - w3r*w2r*w1r*cs**2*k**2*rhogsol - 2*w3r**2*w2r*k*rhogeq*w1r*vgsol +& w3r*w2r**2*k*rhogeq*w1r*vgsol + w3r*w2r*w1i*k*Kdrag*vgsol + w3r*w2r*w1i**2*k*rhogeq*vgsol -& w3r*w2r*w1i*k*Kdrag*vdsol + w3r*w2r*w1r**2*rhogeq*k*vgsol + w2i**2*w3i**2*w1r*rhogsol +& w2r*w3i**2*w1r**2*rhogsol)/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i + w3r**2)/(w1i**2 - 2*w3i*w1i +& w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r) vg2r = - (w2r**2*rhogsol*w2i*w3i*w1i + w2r**2*rhogsol*k**2*cs**2*w1i + k*Kdrag*vdsol*w3r*w2r*w1r +& k*Kdrag*vdsol*w2i*w1i*w3r - k*Kdrag*vdsol*w2r*w1i*w3i + k*Kdrag*vdsol*w2i*w3i*w1r - k*Kdrag*vgsol*w3r*w2r*w1r -& k*Kdrag*vgsol*w2i*w1i*w3r + k*Kdrag*vgsol*w2r*w1i*w3i - k*Kdrag*vgsol*w2i*w3i*w1r - rhogsol*w3r**2*w2r**2*w1i -& rhogsol*w3r**2*w1i*w2i**2 + rhogsol*w3r**2*w2i*w1r**2 + rhogsol*w3r**2*w2i*w1i**2 - rhogsol*w2r**2*w1i**2*w3i -& rhogsol*w2r**2*w1i*w3i**2 - rhogsol*w3i*w1r**2*w2r**2 + rhogsol*w3i**2*w2i*w1r**2 + rhogsol*w2i*w1i**2*w3i**2 -& rhogsol*w1i**2*w2i**2*w3i - rhogsol*w2i**2*w1r**2*w3i - rhogsol*w2i**2*w3i**2*w1i + w2r**3*rhogsol*w3i*w1r -& rhogsol*k**2*cs**2*w3r*w1i*w2r + rhogsol*k**2*cs**2*w3r*w2i*w1r - rhogsol*k**2*cs**2*w3i*w2r*w1r -& rhogsol*k**2*cs**2*w2i*w3i*w1i - k*rhogeq*vgsol*w3r*w2i*w1r**2 - k*rhogeq*vgsol*w3r*w2i*w1i**2 +& k*rhogeq*vgsol*w3i*w2r*w1r**2 + k*rhogeq*vgsol*w3i*w2r*w1i**2 + w2r**2*rhogsol*k**2*cs**2*w3i +& w2i**3*rhogsol*w3i*w1i - w2r**3*k*Kdrag*vgsol + w2r**3*k*Kdrag*vdsol - w2r**3*vgsol*k*rhogeq*w1i +& w2i*vgsol*k*rhogeq*w1r*w2r**2 + w2i**3*vgsol*k*rhogeq*w1r - w2i**2*w2r*vgsol*k*rhogeq*w1i -& w3r*w2i**3*rhogsol*w1r + w3r*w2r**3*rhogsol*w1i - w3r*w2r**2*rhogsol*w2i*w1r - w3r*w2i**2*k*Kdrag*vdsol +& w3r*w2i**2*rhogsol*w1i*w2r + w3r*w2i**2*k*Kdrag*vgsol - w3r**2*vgsol*k*rhogeq*w2i*w1r +& w3r**2*w2r*k*rhogeq*vgsol*w1i + w3r*w2r**2*k*Kdrag*vgsol - w3r*w2r**2*k*Kdrag*vdsol +& w3r*w2r**2*k*rhogeq*vgsol*w2i + w3r*w2i**3*k*rhogeq*vgsol - w2r**3*k*rhogeq*vgsol*w3i -& w2i**3*rhogsol*k**2*cs**2 - vgsol*k*rhogeq*w2i*w1r*w3i**2 + w2i**2*k*Kdrag*vgsol*w1r - w2i**2*k*Kdrag*vgsol*w2r& - w2i**2*k*Kdrag*vdsol*w1r + w2i**2*rhogsol*k**2*cs**2*w3i - w2i**2*k*rhogeq*vgsol*w2r*w3i +& w2i**2*rhogsol*k**2*cs**2*w1i + w2i**2*rhogsol*w3i*w2r*w1r - w2r**2*k*Kdrag*vdsol*w1r +& w2r**2*k*Kdrag*vgsol*w1r + w2r*vgsol*k*rhogeq*w1i*w3i**2 + w2i**2*k*Kdrag*vdsol*w2r -& w2r**2*rhogsol*k**2*cs**2*w2i)/rhogeq/k/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i + w3r**2)/(w2r**2 +& w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2) vg2i =(w1r**2*w2i**2*k*rhogeq*vgsol - w2r**2*w2i*k*Kdrag*vgsol + w2i**2*w1i**2*k*rhogeq*vgsol -& w1i*w2i**3*rhogeq*k*vgsol - w2i**3*w3i*rhogeq*k*vgsol - w3r**2*k*w2i*rhogeq*w1i*vgsol -& w3i**2*k*w2i*rhogeq*w1i*vgsol + w3r*w2i*w1i*w2r**2*rhogsol + w3r**2*w2i**2*rhogeq*k*vgsol -& w2i**2*w1r*cs**2*k**2*rhogsol - w2i*w1i**2*w3i*rhogeq*k*vgsol + w2i*w3i*w1i*k*Kdrag*vdsol -& w2i*w3i*w1i*k*Kdrag*vgsol - w2r**2*w3i*w2i*rhogeq*k*vgsol + w2i*w3i*w1r*cs**2*k**2*rhogsol -& w2i*rhogeq*k*vgsol*w3i*w1r**2 + w2r**3*cs**2*k**2*rhogsol - w2r**2*w1i*w2i*rhogeq*k*vgsol +& w2r**2*w2i*w3i*w1r*rhogsol + w2r*w3i*w1r*k*Kdrag*vdsol - w2i**2*w1i*k*Kdrag*vdsol - w2r*w3i*w1r*k*Kdrag*vgsol -& w2r*w3i**2*k*rhogeq*w1r*vgsol - w2r*w1r*w2i**2*rhogeq*k*vgsol + 2*w3r*w2i**2*w1r*rhogeq*k*vgsol +& w2r**2*w1i*k*Kdrag*vgsol - w2r**2*w3i**2*w1r*rhogsol + w3r*w2i**3*w1i*rhogsol + w2i**2*w1i*k*Kdrag*vgsol -& w2r*w1i*w3i*cs**2*k**2*rhogsol + 2*w3i*w2r**2*w1i*rhogeq*k*vgsol + w1i**2*w3i**2*w2r*rhogsol +& w3i**2*w2i**2*rhogeq*k*vgsol + 2*w2i**2*w3i*w1i*rhogeq*k*vgsol + w3r*w2i*w1i*cs**2*k**2*rhogsol -& w3r*w1i**2*w2r**2*rhogsol - w3r*w2i**2*w1i**2*rhogsol + w3r**2*w1i**2*w2r*rhogsol - w3r**2*w2i**2*w1r*rhogsol +& w2r**2*w2i*k*Kdrag*vdsol - w2r**3*k*rhogeq*w1r*vgsol + w2i**2*w3i*k*Kdrag*vgsol - w2i**2*w3i*k*Kdrag*vdsol +& w2r*w2i**2*cs**2*k**2*rhogsol - w2r*w2i**2*w3i*rhogsol*w1i + w2r**2*w3i**2*k*rhogeq*vgsol +& w2r**2*w1r**2*rhogeq*k*vgsol - w2r**2*w1r*cs**2*k**2*rhogsol + w3r**2*w2r*w1r**2*rhogsol +& w2r**2*w3i*k*Kdrag*vgsol - w2r**2*w3i*k*Kdrag*vdsol - w2r**2*w1i*k*Kdrag*vdsol + w2r**2*w1i**2*k*rhogeq*vgsol -& w3r*w2r**2*cs**2*k**2*rhogsol + w3r*w2r*w2i**2*w1r*rhogsol - w3r*w2i**2*cs**2*k**2*rhogsol -& w3r*w2r**3*rhogeq*k*vgsol + w3r**2*w2r**2*rhogeq*k*vgsol - w3r**2*w2r**2*w1r*rhogsol - w2r**3*w3i*rhogsol*w1i -& w3r*w1r**2*w2i**2*rhogsol - w3r*w2r**2*w1r**2*rhogsol - w3r*w2i*w1r*k*Kdrag*vdsol + w3r*w2i*w1r*k*Kdrag*vgsol +& w3r*w2r**3*w1r*rhogsol + w3r*w2r*w1r*cs**2*k**2*rhogsol - w3r**2*w2r*k*rhogeq*w1r*vgsol +& 2*w3r*w2r**2*k*rhogeq*w1r*vgsol - w3r*w2r*w2i**2*rhogeq*k*vgsol - w3r*w2r*w1i*k*Kdrag*vgsol -& w3r*w2r*w1i**2*k*rhogeq*vgsol + w3r*w2r*w1i*k*Kdrag*vdsol - w3r*w2r*w1r**2*rhogeq*k*vgsol +& w2i**3*w3i*w1r*rhogsol - w2i**3*k*Kdrag*vgsol - w2i**2*w3i**2*w1r*rhogsol + w2i**3*k*Kdrag*vdsol +& w2r*w3i**2*w1r**2*rhogsol)/rhogeq/k/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i + w3r**2)/(w2r**2 +& w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2) vg1r =( - rhogsol*w1i**3*w3i*w2i + rhogsol*k**2*cs**2*w1i**3 - rhogsol*w3i*w2r*w1r**3 - k*Kdrag*vgsol*w2r*w1r**2 +& k*Kdrag*vdsol*w2r*w1r**2 - k*Kdrag*vdsol*w1r*w1i**2 - k*Kdrag*vgsol*w2r*w1i**2 + k*Kdrag*vdsol*w2r*w1i**2 +& k*Kdrag*vgsol*w1r*w1i**2 - k*Kdrag*vdsol*w1r**3 + k*Kdrag*vgsol*w1r**3 - w3r*rhogsol*w2i*w1r**3 -& w3r*Kdrag*w1i**2*k*vgsol + w3r*k*Kdrag*vdsol*w1r**2 + w3r*k*Kdrag*vdsol*w1i**2 - w3r*Kdrag*w1r**2*k*vgsol -& k*Kdrag*vdsol*w3r*w2r*w1r - k*Kdrag*vdsol*w2i*w1i*w3r - k*Kdrag*vdsol*w2r*w1i*w3i + k*Kdrag*vdsol*w2i*w3i*w1r +& k*Kdrag*vgsol*w3r*w2r*w1r + k*Kdrag*vgsol*w2i*w1i*w3r + k*Kdrag*vgsol*w2r*w1i*w3i - k*Kdrag*vgsol*w2i*w3i*w1r +& k*rhogeq*vgsol*w3r*w2r**2*w1i + k*rhogeq*vgsol*w3r*w1i*w2i**2 - rhogsol*w3r**2*w2r**2*w1i -& rhogsol*w3r**2*w1i*w2i**2 + rhogsol*w3r**2*w2i*w1r**2 + rhogsol*w3r**2*w2i*w1i**2 + rhogsol*w2r**2*w1i**2*w3i -& rhogsol*w2r**2*w1i*w3i**2 + rhogsol*w3i*w1r**2*w2r**2 + rhogsol*w3i**2*w2i*w1r**2 + rhogsol*w2i*w1i**2*w3i**2 +& rhogsol*w1i**2*w2i**2*w3i + rhogsol*w2i**2*w1r**2*w3i - rhogsol*w2i**2*w3i**2*w1i -& rhogsol*k**2*cs**2*w3r*w1i*w2r + rhogsol*k**2*cs**2*w3r*w2i*w1r + rhogsol*k**2*cs**2*w3i*w2r*w1r +& rhogsol*k**2*cs**2*w2i*w3i*w1i - k*rhogeq*vgsol*w3i*w1r*w2r**2 - k*rhogeq*vgsol*w3i*w1r*w2i**2 -& w3r**2*vgsol*k*rhogeq*w2i*w1r + w3r**2*w2r*k*rhogeq*vgsol*w1i + w3r*rhogsol*w1i**3*w2r -& vgsol*k*rhogeq*w2i*w1r*w3i**2 - w3r*w1r**2*k*rhogeq*vgsol*w1i - w3r*w1i**3*k*rhogeq*vgsol -& w3r*w1r*rhogsol*w2i*w1i**2 + w3r*rhogsol*w1i*w2r*w1r**2 + w2r*vgsol*k*rhogeq*w1i*w3i**2 -& rhogsol*w3i*w2r*w1r*w1i**2 - rhogeq*w2r*w1i*k*vgsol*w1r**2 - rhogeq*w2r*w1i**3*k*vgsol +& k*rhogeq*vgsol*w2i*w1r**3 - rhogsol*k**2*cs**2*w2i*w1r**2 + k*rhogeq*vgsol*w3i*w1r*w1i**2 +& rhogsol*k**2*cs**2*w1i*w1r**2 - rhogsol*k**2*cs**2*w3i*w1i**2 + k*rhogeq*vgsol*w3i*w1r**3 -& rhogsol*k**2*cs**2*w1i**2*w2i - rhogsol*k**2*cs**2*w3i*w1r**2 - rhogsol*w3i*w1r**2*w2i*w1i +& w1r*k*rhogeq*vgsol*w2i*w1i**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r)/(w2r**2 + w1r**2 +& w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2)/rhogeq/k vg1i = - ( - w1r**2*w2i**2*k*rhogeq*vgsol - w2i**2*w1i**2*k*rhogeq*vgsol - w3r**2*w1i**2*k*rhogeq*vgsol -& w3r**2*w1r**2*rhogeq*k*vgsol - w3r*w2r*w1r**3*rhogsol - w3r*w1i**2*w2r*rhogsol*w1r -& w3i**2*k*rhogeq*w1r**2*vgsol + w3r**2*k*w2i*rhogeq*w1i*vgsol - w1i**2*rhogeq*k*vgsol*w3i**2 +& w3i**2*k*w2i*rhogeq*w1i*vgsol + w1i**3*k*rhogeq*vgsol*w3i - w3r*w2i*w1i*rhogsol*w1r**2 - w1i**3*k*Kdrag*vdsol -& 2*w2i*w1i**2*w3i*rhogeq*k*vgsol + w2i*w3i*w1r*rhogsol*w1i**2 - w1i**2*k*Kdrag*vgsol*w3i -& w1i*k*Kdrag*vdsol*w1r**2 + w1i**2*k*rhogeq*vgsol*w3r*w1r + w1i*k*Kdrag*vgsol*w1r**2 - w1r**3*cs**2*k**2*rhogsol& + cs**2*k**2*rhogsol*w3r*w1r**2 + w3i*k*Kdrag*vdsol*w1r**2 - w2i*w3i*w1i*k*Kdrag*vdsol +& w2i*w3i*w1i*k*Kdrag*vgsol + cs**2*k**2*rhogsol*w3r*w1i**2 + w3i*k*Kdrag*vdsol*w1i**2 +& w1i**3*w2i*rhogeq*k*vgsol + w2r*k*rhogeq*w1r*vgsol*w1i**2 - w2i*k*Kdrag*vgsol*w1i**2 + w2i*k*Kdrag*vdsol*w1i**2& + w1r**2*rhogeq*k*vgsol*w3i*w1i + w1r**3*rhogeq*k*vgsol*w3r + w2i*k*Kdrag*vdsol*w1r**2 +& w2i*w3i*w1r*cs**2*k**2*rhogsol - 2*w2i*rhogeq*k*vgsol*w3i*w1r**2 - w3i*k*Kdrag*vgsol*w1r**2 -& w2r*w3i*w1r*k*Kdrag*vdsol + w2r*w3i*w1r*k*Kdrag*vgsol + w2r*w3i**2*k*rhogeq*w1r*vgsol +& w3r*w2i**2*w1r*rhogeq*k*vgsol - w2r**2*w3i**2*w1r*rhogsol - w1i**3*w2r*rhogsol*w3i - w2r*w1r**2*rhogsol*w3i*w1i& - w2i*k*Kdrag*vgsol*w1r**2 - w2r*w1i*w3i*cs**2*k**2*rhogsol + w2i*w3i*w1r**3*rhogsol +& w3i*w2r**2*w1i*rhogeq*k*vgsol + w1i**2*w3i**2*w2r*rhogsol + w1i*w2i*rhogeq*k*vgsol*w1r**2 +& w2i**2*w3i*w1i*rhogeq*k*vgsol - w3r*w2i*w1i*cs**2*k**2*rhogsol + w3r*w1i**2*w2r**2*rhogsol +& w3r*w2i**2*w1i**2*rhogsol + w3r**2*w1i**2*w2r*rhogsol - w3r**2*w2i**2*w1r*rhogsol -& w2r**2*w1r**2*rhogeq*k*vgsol + w3r**2*w2r*w1r**2*rhogsol - w2r**2*w1i**2*k*rhogeq*vgsol -& w1r*cs**2*k**2*rhogsol*w1i**2 - w3r**2*w2r**2*w1r*rhogsol + w3r*w1r**2*w2i**2*rhogsol +& w3r*w2r**2*w1r**2*rhogsol - w3r*w2i*w1i**3*rhogsol + w1i**3*k*Kdrag*vgsol - w3r*w2i*w1r*k*Kdrag*vdsol +& w3r*w2i*w1r*k*Kdrag*vgsol - w3r*w2r*w1r*cs**2*k**2*rhogsol + w3r**2*w2r*k*rhogeq*w1r*vgsol +& w3r*w2r**2*k*rhogeq*w1r*vgsol - w3r*w2r*w1i*k*Kdrag*vgsol - 2*w3r*w2r*w1i**2*k*rhogeq*vgsol +& w3r*w2r*w1i*k*Kdrag*vdsol - 2*w3r*w2r*w1r**2*rhogeq*k*vgsol + w2r*k*rhogeq*w1r**3*vgsol +& w2r*w1r**2*cs**2*k**2*rhogsol - w2i**2*w3i**2*w1r*rhogsol + rhogsol*k**2*cs**2*w1i**2*w2r +& w2r*w3i**2*w1r**2*rhogsol)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r)/(w2r**2 + w1r**2 +& w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2)/rhogeq/k !------------------------------- ! D U S T V E L O C I T I E S !------------------------------- if (Kdrag.gt.0.) then vd3r = - (rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol + rhogeq**2*w3i**4*k*w1r*vgsol -& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r - w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r + w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r -& rhogeq**2*cs**2*k**3*w2i**2*w1r*vgsol + rhogeq*cs**4*k**4*w2r*w1r*rhogsol -& rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol - rhogeq*cs**2*k**3*w2r*w1i*Kdrag*vgsol -& rhogeq**2*cs**2*k**3*w2r*w1i**2*vgsol + rhogeq*cs**2*k**3*w2r*w1i*Kdrag*vdsol -& rhogeq**2*cs**2*k**3*w2r*w1r**2*vgsol - rhogeq*w3i**4*cs**2*k**2*rhogsol - rhogeq*cs**4*k**4*w2i*w1i*rhogsol +& rhogeq*cs**2*k**2*w1i**2*w2r**2*rhogsol + rhogeq**2*w3i**4*w2r*k*vgsol - rhogeq*w3i**3*k*Kdrag*vdsol*w1r +& 2*rhogeq*w3i**3*k*Kdrag*vgsol*w2r + rhogeq*w2i**2*w1i**2*cs**2*k**2*rhogsol +& rhogeq*w2i**2*w1r**2*cs**2*k**2*rhogsol - rhogeq*w3i**4*w2r*w1r*rhogsol + rhogeq*w3i**4*w1i*rhogsol*w2i +& w3i*cs**4*k**4*rhogeq*rhogsol*w2i + w3i*cs**4*k**4*rhogeq*rhogsol*w1i + w3i**2*Kdrag**2*k*vgsol*w1r -& w3i**3*Kdrag*rhogsol*k**2*cs**2 - w3i**3*Kdrag*rhogsol*w2r*w1r + w3i**3*Kdrag*rhogsol*w2i*w1i -& w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1i - w3i*cs**2*k**2*rhogeq*rhogsol*w1i*w2i**2 +& rhogeq*w3i**3*rhogsol*k**2*cs**2*w2i + rhogeq*w3i**3*rhogsol*k**2*cs**2*w1i - rhogeq*w3i**3*rhogsol*w2r**2*w1i& - rhogeq*w3i**3*rhogsol*w1i*w2i**2 - rhogeq*w3i**3*rhogsol*w2i*w1r**2 -& w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w1r**2 - w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w1i**2 -& rhogeq*w3i**3*rhogsol*w2i*w1i**2 - rhogeq*w3i**3*k*Kdrag*vdsol*w2r + 2*rhogeq*w3i**3*k*Kdrag*vgsol*w1r +& w3r*rhogeq**2*cs**2*k**3*w2i**2*vgsol + w3r*rhogeq*w2r*w3i**2*cs**2*k**2*rhogsol -& w3r*rhogeq**2*w3i**2*k*w1r**2*vgsol + w3r*rhogeq*w3i**2*cs**2*k**2*rhogsol*w1r +& 2*w3r*rhogeq*cs**2*k**3*w3i*Kdrag*vdsol - w3r*rhogeq*cs**4*k**4*w2r*rhogsol +& w3r*rhogeq**2*cs**2*k**3*w2r**2*vgsol + w3r**4*rhogeq**2*w2r*vgsol*k - w3r**4*rhogeq*w2r*w1r*rhogsol +& w3r**4*rhogeq**2*k*w1r*vgsol - w3r**4*rhogeq*rhogsol*k**2*cs**2 + w3r**4*rhogeq*w2i*rhogsol*w1i +& 2*w3r*rhogeq*w2i*w3i*w1i*k*Kdrag*vgsol + 2*w3r*rhogeq**2*w2i*k*vgsol*w3i*w1r**2 +& 2*w3r*rhogeq*w2r*w3i*w1r*k*Kdrag*vdsol - 2*w3r*rhogeq*w2i*w3i**2*k*Kdrag*vgsol - w3r*w3i**2*Kdrag**2*k*vgsol +& w3r*w3i**2*Kdrag**2*k*vdsol - w3r*rhogeq**2*w1i**2*k*vgsol*w3i**2 - 2*w3r*rhogeq**2*w3i**2*k*w2i*w1i*vgsol +& 2*w3r*rhogeq**2*w2i*w1i**2*w3i*k*vgsol + w3r*w3i**2*Kdrag*rhogsol*w1i*w2r + w3r*w3i**2*Kdrag*rhogsol*w2i*w1r -& w3r*Kdrag*rhogsol*k**2*cs**2*w1i*w2r - w3r*Kdrag*rhogsol*k**2*cs**2*w2i*w1r +& w3r*Kdrag*k*rhogeq*vgsol*w2i*w1r**2 + w3r*Kdrag*k*rhogeq*vgsol*w2i*w1i**2 + w3r*Kdrag**2*k*vdsol*w2r*w1r -& w3r*Kdrag**2*k*vdsol*w2i*w1i - w3r*Kdrag**2*k*vgsol*w2r*w1r + w3r*Kdrag**2*k*vgsol*w2i*w1i +& w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1i + w3r*Kdrag*k*rhogeq*vgsol*w1i*w2i**2 - w3r*rhogeq**2*w2r**2*w3i**2*k*vgsol& - 2*w3r*rhogeq*w2r*w3i*w1r*k*Kdrag*vgsol + w3r*rhogeq*w2i*w3i**2*k*Kdrag*vdsol -& 2*w3r*rhogeq**2*w2r*w3i**2*k*w1r*vgsol + w3r*rhogeq*w2r**2*w3i**2*w1r*rhogsol -& 2*w3r*rhogeq*w1i*w3i**2*k*Kdrag*vgsol + w3r*rhogeq*w1i*w3i**2*k*Kdrag*vdsol +& 2*w3r*rhogeq**2*w3i*w2r**2*w1i*k*vgsol + w3r*rhogeq*w1i**2*w3i**2*w2r*rhogsol -& w3r*rhogeq**2*w3i**2*w2i**2*k*vgsol - w3r*rhogeq*cs**2*k**2*w1i**2*w2r*rhogsol -& w3r*rhogeq*cs**2*k**2*w2r*w1r**2*rhogsol - w3r*rhogeq*cs**2*k**2*w2r**2*w1r*rhogsol +& w3r*rhogeq*w2i**2*w3i**2*w1r*rhogsol + w3r*rhogeq*w2r*w3i**2*w1r**2*rhogsol -& 2*w3r*rhogeq**2*cs**2*k**3*w3i*w2i*vgsol - w3r*rhogeq*w2i**2*w1r*cs**2*k**2*rhogsol +& 2*w3r*rhogeq**2*w2i**2*w3i*w1i*k*vgsol + w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol -& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol + w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol -& w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol + w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol -& 2*w3r*rhogeq**2*cs**2*k**3*w3i*w1i*vgsol + w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol -& w3r*rhogeq*cs**4*k**4*w1r*rhogsol - 2*w3r*rhogeq*cs**2*k**3*w3i*Kdrag*vgsol +& 2*w3r*rhogeq**2*cs**2*k**3*w2r*w1r*vgsol - 2*w3r*rhogeq*w2i*w3i*w1i*k*Kdrag*vdsol +& 2*w3r*rhogeq**2*cs**2*k**3*w2i*w1i*vgsol + w3r**2*w3i*rhogeq*rhogsol*k**2*cs**2*w1i -& w3r**2*w3i*rhogeq*rhogsol*w2r**2*w1i - w3r**2*w3i*rhogeq*rhogsol*w1i*w2i**2 -& w3r**2*w3i*rhogeq*rhogsol*w2i*w1r**2 - w3r**2*w3i*rhogeq*rhogsol*w2i*w1i**2 -& w3r**2*w3i*rhogeq*k*Kdrag*vdsol*w2r - w3r**2*Kdrag*rhogsol*w3i*w2r*w1r + w3r**2*Kdrag*rhogsol*w2i*w3i*w1i -& w3r**2*w3i*rhogeq*k*Kdrag*vdsol*w1r + w3r**2*w3i*rhogeq*rhogsol*k**2*cs**2*w2i -& w3r**2*Kdrag*rhogsol*k**2*cs**2*w3i + w3r**2*Kdrag*rhogsol*k**2*cs**2*w2i + w3r**2*Kdrag*rhogsol*k**2*cs**2*w1i& + 2*w3r**2*Kdrag*k*rhogeq*vgsol*w2r*w3i + 2*w3r**2*Kdrag*k*rhogeq*vgsol*w3i*w1r +& 2*w3r**2*rhogeq**2*w2r*k*vgsol*w3i**2 - w3r**2*rhogeq**2*cs**2*k**3*w2r*vgsol +& w3r**2*rhogeq*w2r*w1i*k*Kdrag*vgsol + w3r**2*rhogeq**2*w2r*w1i**2*k*vgsol - w3r**2*rhogeq*w2r*w1i*k*Kdrag*vdsol& + w3r**2*rhogeq**2*w2r*w1r**2*k*vgsol - w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol - w3r**2*Kdrag**2*k*vdsol*w2r -& w3r**2*rhogeq*w2i**2*w1i**2*rhogsol - w3r**2*rhogeq*w1r**2*w2i**2*rhogsol - w3r**2*rhogeq*w2r**2*w1r**2*rhogsol& + w3r**2*rhogeq*cs**4*k**4*rhogsol - w3r**2*rhogeq*w1i**2*w2r**2*rhogsol - w3r**2*Kdrag*rhogsol*w1i*w2i**2 -& w3r**2*Kdrag*rhogsol*w2i*w1r**2 - w3r**2*Kdrag*rhogsol*w2i*w1i**2 - w3r**2*Kdrag*rhogsol*w2r**2*w1i -& w3r**2*Kdrag**2*k*vdsol*w1r + w3r**2*Kdrag**2*k*vgsol*w2r + w3r**2*Kdrag**2*k*vgsol*w1r +& w3r**3*Kdrag*rhogsol*w2i*w1r + w3r**3*rhogeq*w2i*k*Kdrag*vdsol - w3r**3*rhogeq**2*w2i**2*k*vgsol +& w3r**2*rhogeq**2*w2i**2*w1r*k*vgsol - 2*w3r**2*rhogeq*w2r*w3i**2*w1r*rhogsol +& 2*w3r**2*rhogeq**2*w3i**2*k*w1r*vgsol + 2*w3r**2*rhogeq*w1i*w3i**2*rhogsol*w2i -& w3r**2*rhogeq*w2i*w1r*k*Kdrag*vdsol + w3r**2*rhogeq*w2i*w1r*k*Kdrag*vgsol - w3r**3*rhogeq**2*w1i**2*k*vgsol -& 2*w3r**3*rhogeq**2*w2r*k*w1r*vgsol + w3r**3*rhogeq*w2r**2*w1r*rhogsol + w3r**3*rhogeq*w2r*cs**2*k**2*rhogsol -& 2*w3r**3*rhogeq*w2i*k*Kdrag*vgsol - w3r**3*rhogeq**2*w1r**2*k*vgsol + w3r**3*rhogeq*w1r*cs**2*k**2*rhogsol -& w3r**3*rhogeq**2*w2r**2*k*vgsol + w3r**3*rhogeq*w1i*k*Kdrag*vdsol - 2*w3r**3*rhogeq**2*k*w2i*w1i*vgsol +& w3r**3*rhogeq*w2r*w1r**2*rhogsol + w3r**3*rhogeq*w1i**2*w2r*rhogsol + w3r**3*rhogeq*w2i**2*w1r*rhogsol -& 2*w3r**3*rhogeq*w1i*k*Kdrag*vgsol + w3r**3*Kdrag*rhogsol*w1i*w2r + w3r**2*rhogeq**2*w2r**2*k*w1r*vgsol -& 2*w3r**2*rhogeq*w3i**2*cs**2*k**2*rhogsol + w3r**3*Kdrag**2*k*vdsol + w3i**2*rhogeq**2*cs**2*k**3*w2r*vgsol -& w3r**3*Kdrag**2*k*vgsol + w3i**2*rhogeq*w2i*w1r*k*Kdrag*vdsol - w3i**2*Kdrag**2*k*vdsol*w2r +& w3i**2*Kdrag**2*k*vgsol*w2r - w3i**2*Kdrag*rhogsol*w2r**2*w1i - w3i**2*Kdrag*rhogsol*w1i*w2i**2 -& w3i**2*Kdrag*rhogsol*w2i*w1r**2 - w3i**2*Kdrag*rhogsol*w2i*w1i**2 + w3i**2*Kdrag*rhogsol*k**2*cs**2*w2i +& w3i**2*Kdrag*rhogsol*k**2*cs**2*w1i - Kdrag*k*rhogeq*vgsol*w3i*w1r*w2r**2 - Kdrag*k*rhogeq*vgsol*w3i*w2r*w1r**2& - Kdrag*k*rhogeq*vgsol*w3i*w2r*w1i**2 - Kdrag*k*rhogeq*vgsol*w3i*w1r*w2i**2 +& Kdrag*rhogsol*k**2*cs**2*w3i*w2r*w1r - Kdrag*rhogsol*k**2*cs**2*w2i*w3i*w1i + Kdrag*rhogsol*w2r**2*w1i**2*w3i +& Kdrag*rhogsol*w3i*w1r**2*w2r**2 + Kdrag*rhogsol*w1i**2*w2i**2*w3i + Kdrag*rhogsol*w2i**2*w1r**2*w3i +& Kdrag**2*k*vdsol*w2r*w1i*w3i + Kdrag**2*k*vdsol*w2i*w3i*w1r - Kdrag**2*k*vgsol*w2r*w1i*w3i -& Kdrag**2*k*vgsol*w2i*w3i*w1r - w3i**2*Kdrag**2*k*vdsol*w1r + rhogeq*cs**2*k**3*w2i*w1r*Kdrag*vdsol -& rhogeq*cs**2*k**3*w2i*w1r*Kdrag*vgsol - w3i**2*rhogeq**2*w2i**2*w1r*k*vgsol -& w3i**2*rhogeq**2*w2r**2*k*w1r*vgsol - w3i**2*rhogeq*w2i*w1r*k*Kdrag*vgsol - w3i**2*rhogeq*w2r*w1i*k*Kdrag*vgsol& - w3i**2*rhogeq**2*w2r*w1i**2*k*vgsol + w3i**2*rhogeq*w2r*w1i*k*Kdrag*vdsol -& w3i**2*rhogeq**2*w2r*w1r**2*k*vgsol + w3i**2*rhogeq**2*cs**2*k**3*w1r*vgsol +& w3i**2*rhogeq*w2i**2*w1i**2*rhogsol + w3i**2*rhogeq*w1r**2*w2i**2*rhogsol + w3i**2*rhogeq*w2r**2*w1r**2*rhogsol& - w3i**2*rhogeq*cs**4*k**4*rhogsol + w3i**2*rhogeq*w1i**2*w2r**2*rhogsol)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2& + w3i**2 - 2*w3r*w1r)/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i + w3r**2)/k/rhogeq/Kdrag vd3i = - (cs**2*k**3*rhogeq*w3i**2*Kdrag*vgsol - cs**2*k**3*rhogeq*w3i**2*Kdrag*vdsol -& 2*cs**4*k**4*rhogeq*w3r*w3i*rhogsol - 4*cs**2*k**2*rhogeq*w3r*w3i*w2r*w1r*rhogsol +& 4*cs**2*k**2*rhogeq*w3r*w3i*w2i*rhogsol*w1i - cs**2*k**3*rhogeq*w3r**2*Kdrag*vgsol +& cs**2*k**3*rhogeq*w3r**2*Kdrag*vdsol - 2*cs**2*k**3*rhogeq**2*w3i*w2r*w1r*vgsol +& 2*cs**2*k**3*rhogeq**2*w3r*w3i*w2r*vgsol + 2*cs**2*k**3*rhogeq**2*w3r*w3i*w1r*vgsol -& w3r**2*w1i*k*Kdrag**2*vgsol + w3r**2*w1i*k*Kdrag**2*vdsol + rhogeq*w3i*w3r**2*w1i*k*Kdrag*vdsol -& rhogeq**2*w3i*w3r**2*w1i**2*k*vgsol + 2*rhogeq**2*w3i**2*w3r**2*w1i*k*vgsol -& rhogeq**2*w3i*w3r**2*w1r**2*k*vgsol + rhogeq*w3i*w3r**2*w1r*cs**2*k**2*rhogsol +& 2*rhogeq*w3i**2*w3r**2*k*Kdrag*vgsol - 2*rhogeq*w3i**2*w3r**2*k*Kdrag*vdsol +& rhogeq*w3i*w2r*w3r**2*cs**2*k**2*rhogsol + rhogeq*w3i**3*w2r*cs**2*k**2*rhogsol -& rhogeq**2*w3i**3*k*w1r**2*vgsol + rhogeq*w3i**3*cs**2*k**2*rhogsol*w1r - 2*rhogeq**2*w3i*w3r**2*k*w2i*w1i*vgsol& - rhogeq**2*w3i**3*w1i**2*k*vgsol - 2*rhogeq**2*w3i**3*k*w2i*w1i*vgsol - rhogeq**2*w3i*w3r**2*w2i**2*k*vgsol +& rhogeq**2*w3i**2*w2i*w1i**2*k*vgsol - rhogeq*w3i**2*w2i*w1i*k*Kdrag*vdsol +& 2*rhogeq**2*w3i**2*w3r**2*w2i*k*vgsol - 2*rhogeq*w3i**2*w3r**2*w2i*w1r*rhogsol -& 2*rhogeq*w3i**2*w2r*w3r**2*rhogsol*w1i - rhogeq*w3i**4*w2r*w1i*rhogsol + rhogeq*w3i*w3r**2*w2i*k*Kdrag*vdsol +& w3r**2*w3i*k*Kdrag**2*vgsol - w3r**2*w3i*k*Kdrag**2*vdsol - w2i*w3i**2*k*Kdrag**2*vgsol +& w2i*w3i**2*k*Kdrag**2*vdsol - w1i*w3i**2*k*Kdrag**2*vgsol + w1i*w3i**2*k*Kdrag**2*vdsol +& rhogeq**2*w3i**2*w2i*k*vgsol*w1r**2 + rhogeq*w3i**2*w2r*w1r*k*Kdrag*vdsol + rhogeq*w3i**3*w2i*k*Kdrag*vdsol -& 2*rhogeq**2*w3i**3*w2r*k*w1r*vgsol + rhogeq**2*w3i**4*w2i*k*vgsol + 2*rhogeq**2*w3i*w3r*w2i**2*w1r*k*vgsol +& rhogeq*w3i**3*w1i**2*w2r*rhogsol - rhogeq**2*w3i**3*w2i**2*k*vgsol - 2*rhogeq*w3i*w3r*w1i**2*w2r**2*rhogsol -& 2*rhogeq*w3i*w3r*w2i**2*w1i**2*rhogsol + rhogeq*w3i*w3r**2*w1i**2*w2r*rhogsol +& rhogeq*w3i*w3r**2*w2i**2*w1r*rhogsol - rhogeq**2*w3i**3*w2r**2*k*vgsol + rhogeq*w3i*w3r**2*w2r*w1r**2*rhogsol -& 2*rhogeq**2*w3i*w3r**2*w2r*k*w1r*vgsol + rhogeq*w3i**3*w2r**2*w1r*rhogsol + rhogeq**2*w3i**4*w1i*k*vgsol +& rhogeq*w3i**3*w1i*k*Kdrag*vdsol - rhogeq*w3i**4*k*Kdrag*vdsol + rhogeq*w3i**4*k*Kdrag*vgsol -& rhogeq*w3i**4*w1r*w2i*rhogsol - Kdrag*w2r*w3r*w3i**2*w1r*rhogsol - Kdrag*w1r*w2i*w3i**3*rhogsol +& Kdrag*w2r*w3i**2*cs**2*k**2*rhogsol - Kdrag*w3i**2*k*rhogeq*w1r**2*vgsol + Kdrag*w3i**2*cs**2*k**2*rhogsol*w1r& - Kdrag*w1i**2*rhogeq*k*vgsol*w3i**2 + Kdrag*w3r*w1i*w3i**2*rhogsol*w2i - Kdrag*w3r**2*w1i**2*k*rhogeq*vgsol -& Kdrag*w3r**2*w1r**2*rhogeq*k*vgsol + Kdrag*w3r**2*w1r*cs**2*k**2*rhogsol + Kdrag*w2r*w3r**2*cs**2*k**2*rhogsol& - 2*rhogeq*w3i*w3r*w2r*w1i*k*Kdrag*vdsol + 2*rhogeq**2*w3i*w3r*w2r*w1r**2*k*vgsol +& rhogeq*w3i**3*w2i**2*w1r*rhogsol + rhogeq*w3i**3*w2r*w1r**2*rhogsol - Kdrag*w3r*w3i**2*cs**2*k**2*rhogsol -& Kdrag*w3r**3*rhogsol*k**2*cs**2 + Kdrag*w3r**3*w2i*rhogsol*w1i - Kdrag*w3r**2*w2i*w3i*w1r*rhogsol -& Kdrag*w2r*w3r**2*w3i*rhogsol*w1i - Kdrag*w2r*w1i*w3i**3*rhogsol + 2*rhogeq**2*w3i*w3r*w2r*w1i**2*k*vgsol -& Kdrag*w2r*w3r**3*w1r*rhogsol + rhogeq*w3r**3*k*Kdrag*vdsol*w2r - rhogeq**2*w3i*w3r**2*w2r**2*k*vgsol +& rhogeq*w3i*w3r**2*w2r**2*w1r*rhogsol - 2*rhogeq*w3i*w3r*w1r**2*w2i**2*rhogsol -& 2*rhogeq*w3i*w3r*w2r**2*w1r**2*rhogsol - 2*rhogeq*w3i*w3r*w2i*w1r*k*Kdrag*vdsol +& 2*rhogeq*w3i*w3r*w2i*w1r*k*Kdrag*vgsol + 2*rhogeq**2*w3i*w3r*w2r**2*k*w1r*vgsol +& 2*rhogeq*w3i*w3r*w2r*w1i*k*Kdrag*vgsol + rhogeq**2*w3r**4*k*vgsol*w2i - rhogeq*w3r**4*rhogsol*w1i*w2r -& rhogeq*w3r**4*rhogsol*w2i*w1r + rhogeq*w3r**3*rhogsol*w2r**2*w1i + rhogeq*w3r**3*rhogsol*w1i*w2i**2 +& rhogeq*w3r**3*rhogsol*w2i*w1r**2 + rhogeq*w3r**3*rhogsol*w2i*w1i**2 + rhogeq*w3r*rhogsol*w2r**2*w1i*w3i**2 -& rhogeq*w3r**4*k*Kdrag*vdsol - rhogeq*w3r**2*k*Kdrag*vdsol*w2r*w1r + rhogeq*w3r**2*k*Kdrag*vdsol*w2i*w1i +& rhogeq*w3r*k*Kdrag*vdsol*w2r*w3i**2 + rhogeq*w3r*k*Kdrag*vdsol*w3i**2*w1r -& rhogeq*w3r*rhogsol*k**2*cs**2*w3i**2*w1i - rhogeq*w3r*rhogsol*k**2*cs**2*w3i**2*w2i -& rhogeq**2*w3r**2*k*vgsol*w2i*w1r**2 - rhogeq**2*w3r**2*k*vgsol*w2i*w1i**2 + rhogeq**2*w3r**4*k*vgsol*w1i +& rhogeq*w3r**4*k*Kdrag*vgsol + rhogeq*w3r*rhogsol*w3i**2*w2i*w1r**2 + rhogeq*w3r*rhogsol*w2i*w1i**2*w3i**2 +& rhogeq*w3r*rhogsol*w2i**2*w3i**2*w1i - rhogeq*w3r**3*rhogsol*k**2*cs**2*w2i -& rhogeq*w3r**3*rhogsol*k**2*cs**2*w1i + rhogeq*w3r**3*k*Kdrag*vdsol*w1r + w3r**2*w2i*k*Kdrag**2*vdsol -& w3r**2*w2i*k*Kdrag**2*vgsol - w3i**3*k*Kdrag**2*vdsol + w3i**3*k*Kdrag**2*vgsol -& w3r*Kdrag*rhogsol*w2r**2*w1r**2 - w3r*Kdrag*rhogsol*w2r**2*w1i**2 + w3r*Kdrag*k*rhogeq*vgsol*w2r*w1i**2 +& w3r*Kdrag*k*rhogeq*vgsol*w2r*w1r**2 - w3r*rhogeq*cs**2*k**2*rhogsol*w2r**2*w1i +& w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r - w3r*Kdrag*cs**2*k**2*rhogsol*w2r*w1r -& w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r + w3r**2*Kdrag*rhogsol*w2r*w1r**2 +& 2*w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i - w3r**2*rhogeq**2*k*vgsol*w2r**2*w1i -& w3r**2*Kdrag*rhogeq*k*vgsol*w2r*w1r - w3r**2*Kdrag*rhogeq*k*vgsol*w2r**2 - w3r**2*Kdrag*rhogeq*k*vgsol*w2i**2 -& w3r**2*rhogeq**2*cs**2*k**3*vgsol*w1i + w3r*Kdrag**2*k*vgsol*w2r*w1i + w3i**2*rhogeq**2*k*vgsol*w2r**2*w1i +& rhogeq*cs**2*k**3*vdsol*Kdrag*w2r*w1r + w3i*Kdrag*k*rhogeq*vgsol*w2r**2*w1i +& w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1r + w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w1r**2 +& w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w1i**2 - 3*w3i**2*Kdrag*rhogeq*k*vgsol*w2r*w1r -& w3i**2*Kdrag*rhogeq*k*vgsol*w2i**2 - w3i*rhogeq**2*cs**2*k**3*vgsol*w2r**2 -& 2*w3i**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i - w3i**2*Kdrag*rhogeq*k*vgsol*w2r**2 -& rhogeq*cs**4*k**4*rhogsol*w2r*w1i + w3i*rhogeq*cs**4*k**4*rhogsol*w2r - w3i*Kdrag*cs**2*k**2*rhogsol*w2r*w1i -& cs**2*k**3*rhogeq*Kdrag*vgsol*w2r*w1r + w3i**2*cs**2*k**3*rhogeq**2*vgsol*w1i + w3i**2*Kdrag*rhogsol*w2r**2*w1r& + w3i*Kdrag**2*k*vdsol*w2r*w1r + w3i**2*Kdrag*rhogsol*w2r*w1r**2 + w3i**2*Kdrag*rhogsol*w2r*w1i**2 -& w3i*Kdrag**2*k*vgsol*w2r*w1r + w3r**2*Kdrag*rhogsol*w2r*w1i**2 + w3r**2*Kdrag*rhogsol*w2r**2*w1r +& rhogeq**2*cs**2*k**3*vgsol*w1i*w2r**2 + w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1r - w3r*Kdrag**2*k*vdsol*w2r*w1i -& w3r*rhogeq*cs**2*k**2*rhogsol*w2i*w1r**2 + w3r*cs**4*k**4*rhogeq*rhogsol*w1i +& w3r*Kdrag*cs**2*k**2*rhogsol*w1i*w2i - w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r - w3i*Kdrag**2*k*vdsol*w1i*w2i +& w3i*Kdrag**2*k*vgsol*w1i*w2i + w3r*Kdrag**2*k*vgsol*w2i*w1r - cs**2*k**3*rhogeq*Kdrag*vdsol*w1i*w2i -& w3i**2*Kdrag*rhogeq*k*vgsol*w1i*w2i + w3r*Kdrag*k*rhogeq*vgsol*w2i**2*w1r + w3i*rhogeq*k*Kdrag*vgsol*w2i**2*w1i& + w3i*rhogeq*k*Kdrag*vgsol*w2i*w1r**2 + w3i*rhogeq*k*Kdrag*vgsol*w1i**2*w2i -& w3i*rhogeq**2*cs**2*k**3*vgsol*w1r**2 - w3i*rhogeq**2*cs**2*k**3*vgsol*w1i**2 -& 3*w3r**2*Kdrag*k*rhogeq*vgsol*w1i*w2i + w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r -& w3i*Kdrag*cs**2*k**2*rhogsol*w2i*w1r - rhogeq*cs**4*k**4*rhogsol*w2i*w1r +& 2*w3r**2*rhogeq*cs**2*k**2*rhogsol*w2i*w1r - w3r**2*vgsol*rhogeq**2*k**3*cs**2*w2i +& w3i*rhogeq*cs**2*k**3*vdsol*Kdrag*w2i + w3i*rhogeq*cs**2*k**3*vdsol*Kdrag*w1i +& cs**2*k**3*rhogeq*Kdrag*vgsol*w1i*w2i - w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1i -& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i + w3i*rhogeq*cs**4*k**4*rhogsol*w1r +& w3i**2*vgsol*rhogeq**2*k**3*cs**2*w2i + w3i**2*vgsol*k*rhogeq**2*w2i**2*w1i -& 2*w3i**2*rhogeq*cs**2*k**2*rhogsol*w2i*w1r - w3r**2*vgsol*k*rhogeq**2*w2i**2*w1i -& w3i*rhogeq**2*cs**2*k**3*vgsol*w2i**2 - 2*w3i*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i -& w3r*Kdrag*rhogsol*w2i**2*w1r**2 + rhogeq**2*cs**2*k**3*vgsol*w1i**2*w2i + rhogeq**2*cs**2*k**3*vgsol*w2i*w1r**2& - w3r*Kdrag**2*k*vdsol*w2i*w1r + w3r*cs**4*k**4*rhogeq*rhogsol*w2i - w3r*rhogeq*cs**2*k**2*rhogsol*w1i**2*w2i -& w3r*rhogeq*cs**2*k**2*rhogsol*w2i**2*w1i - w3r*Kdrag*rhogsol*w2i**2*w1i**2 +& w3i*rhogeq*cs**2*k**2*rhogsol*w2i**2*w1r + w3i**2*Kdrag*rhogsol*w2i**2*w1r + w3r**2*Kdrag*rhogsol*w2i**2*w1r +& rhogeq**2*cs**2*k**3*vgsol*w1i*w2i**2)/Kdrag/rhogeq/k/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i +& w3r**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r) vd2r = - ( - rhogeq*w1i*rhogsol*k**2*cs**2*w3i**2*w2i + rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r**2 +& rhogeq*w1i**2*rhogsol*k**2*cs**2*w3i**2 - rhogeq*w1i*rhogsol*k**2*cs**2*w3r**2*w2i +& rhogeq**2*w1i**2*k*vgsol*w3r*w2r**2 - rhogeq**2*w1i**2*k*vgsol*w3r*w2i**2 - rhogeq**2*w2r**3*k*vgsol*w3i**2 +& rhogeq*w2r**3*w3i**2*w1r*rhogsol + 2*rhogeq**2*w1r*w2r**2*w2i**2*k*vgsol - rhogeq**2*w1r**2*w2r*k*vgsol*w2i**2& - 2*cs**2*k**3*rhogeq**2*w2r*vgsol*w2i*w1i + cs**2*k**2*rhogeq*w2r*w1r*rhogsol*w2i**2 +& cs**2*k**2*rhogeq*w2r**3*w1r*rhogsol - w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r +& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r + w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r -& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r + rhogeq**2*cs**2*k**3*w2i**2*w1r*vgsol -& rhogeq*cs**4*k**4*w2r*w1r*rhogsol - rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol +& rhogeq*cs**2*k**3*w2r*w1i*Kdrag*vgsol + rhogeq**2*cs**2*k**3*w2r*w1i**2*vgsol -& rhogeq*cs**2*k**3*w2r*w1i*Kdrag*vdsol + rhogeq**2*cs**2*k**3*w2r*w1r**2*vgsol +& rhogeq*cs**4*k**4*w2i*w1i*rhogsol + w3i*cs**4*k**4*rhogeq*rhogsol*w2i - w3i*cs**4*k**4*rhogeq*rhogsol*w1i -& w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w1r**2 - w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w1i**2 +& w3r*rhogeq**2*cs**2*k**3*w2i**2*vgsol - w3r*rhogeq*cs**4*k**4*w2r*rhogsol -& w3r*rhogeq**2*cs**2*k**3*w2r**2*vgsol - w3r*Kdrag*rhogsol*k**2*cs**2*w1i*w2r +& w3r*Kdrag*rhogsol*k**2*cs**2*w2i*w1r - w3r*Kdrag*k*rhogeq*vgsol*w2i*w1r**2 -& w3r*Kdrag*k*rhogeq*vgsol*w2i*w1i**2 + w3r*Kdrag**2*k*vdsol*w2r*w1r + w3r*Kdrag**2*k*vdsol*w2i*w1i -& w3r*Kdrag**2*k*vgsol*w2r*w1r - w3r*Kdrag**2*k*vgsol*w2i*w1i + w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1i -& w3r*Kdrag*k*rhogeq*vgsol*w1i*w2i**2 - w3r*rhogeq*cs**2*k**2*w1i**2*w2r*rhogsol -& w3r*rhogeq*cs**2*k**2*w2r*w1r**2*rhogsol - w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol -& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol + w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol +& w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol - w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol -& w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol + w3r*rhogeq*cs**4*k**4*w1r*rhogsol +& 2*w3r*rhogeq**2*cs**2*k**3*w2r*w1r*vgsol + w3r**2*rhogeq**2*cs**2*k**3*w2r*vgsol +& w3r**2*rhogeq*w2r*w1i*k*Kdrag*vgsol - w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol +& w3r**2*rhogeq*w2i**2*w1i**2*rhogsol + w3r**2*rhogeq*w1r**2*w2i**2*rhogsol - w3r**2*rhogeq*w2r**2*w1r**2*rhogsol& - w3r**2*rhogeq*w1i**2*w2r**2*rhogsol - w3r**2*Kdrag*rhogsol*w1i*w2i**2 + w3r**2*Kdrag*rhogsol*w2i*w1r**2 +& w3r**2*Kdrag*rhogsol*w2i*w1i**2 - w3r**2*Kdrag*rhogsol*w2r**2*w1i - w3r**2*rhogeq**2*w2i**2*w1r*k*vgsol -& w3r**2*rhogeq*w2i*w1r*k*Kdrag*vgsol + w3r**2*rhogeq**2*w2r**2*k*w1r*vgsol +& w3i**2*rhogeq**2*cs**2*k**3*w2r*vgsol - w3i**2*Kdrag*rhogsol*w2r**2*w1i - w3i**2*Kdrag*rhogsol*w1i*w2i**2 +& w3i**2*Kdrag*rhogsol*w2i*w1r**2 + w3i**2*Kdrag*rhogsol*w2i*w1i**2 + Kdrag*k*rhogeq*vgsol*w3i*w1r*w2r**2 +& Kdrag*k*rhogeq*vgsol*w3i*w2r*w1r**2 + Kdrag*k*rhogeq*vgsol*w3i*w2r*w1i**2 - Kdrag*k*rhogeq*vgsol*w3i*w1r*w2i**2& - Kdrag*rhogsol*k**2*cs**2*w3i*w2r*w1r - Kdrag*rhogsol*k**2*cs**2*w2i*w3i*w1i - Kdrag*rhogsol*w2r**2*w1i**2*w3i& - Kdrag*rhogsol*w3i*w1r**2*w2r**2 - Kdrag*rhogsol*w1i**2*w2i**2*w3i - Kdrag*rhogsol*w2i**2*w1r**2*w3i -& Kdrag**2*k*vdsol*w2r*w1i*w3i + Kdrag**2*k*vdsol*w2i*w3i*w1r + Kdrag**2*k*vgsol*w2r*w1i*w3i -& Kdrag**2*k*vgsol*w2i*w3i*w1r - rhogeq*cs**2*k**3*w2i*w1r*Kdrag*vdsol + rhogeq*cs**2*k**3*w2i*w1r*Kdrag*vgsol -& w3i**2*rhogeq**2*w2i**2*w1r*k*vgsol + w3i**2*rhogeq**2*w2r**2*k*w1r*vgsol - w3i**2*rhogeq*w2i*w1r*k*Kdrag*vgsol& + w3i**2*rhogeq*w2r*w1i*k*Kdrag*vgsol - w3i**2*rhogeq**2*cs**2*k**3*w1r*vgsol +& w3i**2*rhogeq*w2i**2*w1i**2*rhogsol + w3i**2*rhogeq*w1r**2*w2i**2*rhogsol - w3i**2*rhogeq*w2r**2*w1r**2*rhogsol& - w3i**2*rhogeq*w1i**2*w2r**2*rhogsol - 2*w3i*rhogeq*k*Kdrag*vdsol*w2r*w2i*w1i +& w3i*rhogeq*rhogsol*k**2*cs**2*w2i*w2r**2 + 2*rhogeq**2*w1i**2*k*vgsol*w2r*w3i*w2i -& rhogeq*w2i*w1r*k*Kdrag*vdsol*w2r**2 - 2*vgsol*Kdrag*rhogeq*k**3*cs**2*w2r*w2i -& 2*cs**2*k**2*rhogeq*rhogsol*w2i**2*w2r**2 + 2*vdsol*Kdrag*rhogeq*k**3*cs**2*w2r*w2i -& cs**2*k**2*rhogeq*rhogsol*w2r**4 - rhogeq**2*w2r*k*vgsol*w3i**2*w2i**2 - w3i*rhogeq*k*Kdrag*vdsol*w1r*w2r**2 +& w3i*rhogeq*k*Kdrag*vdsol*w2r*w2i**2 - w3i*rhogeq*rhogsol*w2i*w1r**2*w2r**2 +& 2*w3i*rhogeq*rhogsol*w2r**2*w1i*w2i**2 + rhogeq*cs**4*k**4*rhogsol*w2r**2 + w3i*rhogeq*k*Kdrag*vdsol*w2r**3 +& w3i*rhogeq*rhogsol*w2r**4*w1i - rhogeq*w1i*w3i**2*rhogsol*w2i*w2r**2 + rhogeq*w2r*w3i**2*w1r*rhogsol*w2i**2 +& 2*w3i*rhogeq**2*k*vgsol*w2i*w2r*w1r**2 - 2*w3i*cs**2*k**3*rhogeq**2*vgsol*w2r*w2i +& 2*w3i*cs**2*k**3*rhogeq**2*vgsol*w2r*w1i - rhogeq*w3i**2*cs**2*k**2*rhogsol*w2r*w1r +& 2*rhogeq**2*w2r*k*vgsol*w3i**2*w2i*w1i + 2*rhogeq*w2r*w1i*k*Kdrag*vgsol*w2i*w3i +& w3r*rhogeq*w2r**3*cs**2*k**2*rhogsol + w3r*rhogeq*w2r**3*w1r**2*rhogsol + w3r*rhogeq**2*w2r**4*k*vgsol +& w3r*rhogeq**2*k*vgsol*w2i**4 - w3r*vdsol*Kdrag*k*rhogeq*w2i**3 - w3i*rhogeq*rhogsol*w2i**3*w1r**2 +& w3i*rhogeq*rhogsol*w2i**4*w1i - w3r**2*rhogeq*rhogsol*w2i**3*w1i - w3i**2*rhogeq*rhogsol*w2i**3*w1i -& w3r*rhogeq**2*k*vgsol*w2i**2*w1r**2 + w3i*vdsol*Kdrag*k*rhogeq*w2i**2*w1r - rhogeq*rhogsol*k**2*cs**2*w2i**4 +& w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2 - rhogeq*k*Kdrag*vdsol*w2i**3*w1r +& w3i**2*cs**2*k**2*rhogeq*rhogsol*w1r**2 + w3i*cs**2*k**2*rhogeq*rhogsol*w2i**3 - w3r*rhogeq*rhogsol*w2i**4*w1r& - rhogeq**2*w1i**2*w2r**3*vgsol*k - rhogeq*w1i**2*w2i**3*rhogsol*w3i - cs**4*k**4*rhogeq*rhogsol*w2i**2 +& w2i**2*k*Kdrag**2*vdsol*w2r + w2r**2*k*Kdrag**2*vgsol*w1r - w2r**2*k*Kdrag**2*vdsol*w1r -& w2i**2*k*Kdrag**2*vgsol*w2r - w2i**2*k*Kdrag**2*vdsol*w1r + w2r**3*k*Kdrag**2*vdsol +& w3r*w2r**2*k*Kdrag**2*vgsol - w3r*w2r**2*k*Kdrag**2*vdsol + w2i**2*k*Kdrag**2*vgsol*w1r +& w3r*w2i**2*k*Kdrag**2*vgsol - w3r*w2i**2*k*Kdrag**2*vdsol - w2r**3*k*Kdrag**2*vgsol -& 2*Kdrag*w2r**3*k*rhogeq*vgsol*w3i + Kdrag*w2i**2*rhogsol*k**2*cs**2*w3i - 2*Kdrag*w2i**2*k*rhogeq*vgsol*w2r*w3i& - 2*Kdrag*w2r**3*vgsol*k*rhogeq*w1i + 2*Kdrag*w2i*vgsol*k*rhogeq*w1r*w2r**2 + 2*Kdrag*w2i**3*vgsol*k*rhogeq*w1r& - 2*Kdrag*w2i**2*w2r*vgsol*k*rhogeq*w1i + Kdrag*w2i**3*rhogsol*w3i*w1i - Kdrag*w3r*w2i**3*rhogsol*w1r +& Kdrag*w3r*w2r**3*rhogsol*w1i - Kdrag*w3r*w2r**2*rhogsol*w2i*w1r + Kdrag*w3r*w2i**2*rhogsol*w1i*w2r +& Kdrag*w2r**3*rhogsol*w3i*w1r + rhogeq*w1i*w2i**2*k*Kdrag*vdsol*w2r + rhogeq*w1i*w2r**2*rhogsol*k**2*cs**2*w2i +& Kdrag*w2r**2*rhogsol*w2i*w3i*w1i + Kdrag*w2r**2*rhogsol*k**2*cs**2*w1i + Kdrag*w2r**2*rhogsol*k**2*cs**2*w3i -& 2*rhogeq**2*w1i*w2i**2*k*vgsol*w2r*w3i - rhogeq*w1i*w3r*w2r**2*k*Kdrag*vdsol -& 2*rhogeq**2*w1i*w2r**3*k*vgsol*w3i + rhogeq*w1i*w2i**3*rhogsol*k**2*cs**2 + rhogeq*w1i*w3r*w2i**2*k*Kdrag*vdsol& + rhogeq*w1i**2*w3r*w2i**2*rhogsol*w2r + rhogeq*w1i*w2r**3*k*Kdrag*vdsol + rhogeq*w1i**2*w3r*w2r**3*rhogsol -& rhogeq*w1i**2*w2r**2*rhogsol*w2i*w3i - rhogeq**2*w1i**2*w2i**2*w2r*vgsol*k +& Kdrag*w2i**2*rhogsol*k**2*cs**2*w1i + Kdrag*w2i**2*rhogsol*w3i*w2r*w1r - Kdrag*w2r**2*rhogsol*k**2*cs**2*w2i -& Kdrag*w2i**3*rhogsol*k**2*cs**2 + 2*Kdrag*w3r*w2r**2*k*rhogeq*vgsol*w2i + 2*Kdrag*w3r*w2i**3*k*rhogeq*vgsol -& 2*w3r*w2r*Kdrag*k*rhogeq*vgsol*w2i*w1r + 2*w3r*rhogeq*w2i*k*Kdrag*vdsol*w2r*w1r -& 2*w3r*w2r*rhogeq**2*vgsol*k*w2i**2*w1r + w3r*rhogeq**2*w1r**2*k*vgsol*w2r**2 +& w3r*rhogeq*w2r*cs**2*k**2*rhogsol*w2i**2 - w3r*rhogeq*w2r**4*w1r*rhogsol + w3r*rhogeq*w2r*w1r**2*rhogsol*w2i**2& - 2*w3r*rhogeq**2*w2r**3*k*w1r*vgsol - 2*w3r*rhogeq*w2r**2*w1r*rhogsol*w2i**2 -& w3r*rhogeq*w2i*k*Kdrag*vdsol*w2r**2 + 2*w3r*rhogeq**2*w2i**2*k*vgsol*w2r**2 +& w3r**2*rhogeq*w2r*w1r*rhogsol*w2i**2 - w3r**2*rhogeq**2*w2r*vgsol*k*w2i**2 -& w3r**2*rhogeq*w2i*rhogsol*w1i*w2r**2 - w3r**2*rhogeq**2*w2r**3*vgsol*k + 2*w3r**2*rhogeq**2*w2r*vgsol*k*w2i*w1i& - w3r**2*rhogeq*rhogsol*k**2*cs**2*w2r*w1r + w3r**2*rhogeq*w2r**3*w1r*rhogsol + rhogeq**2*w1r*w2i**4*k*vgsol +& rhogeq**2*w1r*w2r**4*k*vgsol - rhogeq**2*w1r**2*w2r**3*k*vgsol)/k/rhogeq/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2& - 2*w2i*w3i + w3r**2)/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2)/Kdrag vd2i =1/k*(w3r*rhogeq*k*Kdrag*vdsol*w2r**2*w1r - w3r*rhogeq*k*Kdrag*vdsol*w2r*w2i**2 -& w3r*rhogeq*k*Kdrag*vdsol*w2r**3 - w3r*Kdrag*rhogsol*w2r**2*w1r**2 - w3r*Kdrag*rhogsol*w2r**2*w1i**2 +& w3r*rhogeq*rhogsol*w2r**4*w1i - w3r*Kdrag*k*rhogeq*vgsol*w2r*w1i**2 - w3r*Kdrag*k*rhogeq*vgsol*w2r*w1r**2 -& 2*w3r*rhogeq*cs**2*k**2*rhogsol*w2r**2*w1i - w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r -& 2*w3r*rhogeq**2*k*vgsol*w2r*w2i*w1i**2 - 2*w3r*rhogeq**2*k*vgsol*w2r*w2i*w1r**2 +& 2*w3r*rhogeq**2*k*vgsol*w2r**2*w2i*w1r - w3r*rhogeq*cs**2*k**2*rhogsol*w2i*w2r**2 +& w3r*Kdrag*cs**2*k**2*rhogsol*w2r*w1r - w3r*Kdrag*cs**2*k**2*rhogsol*w2r**2 + w3r*Kdrag*rhogsol*w2r**2*w1i*w2i -& 2*w3r*cs**2*k**3*rhogeq**2*vgsol*w2i*w2r + w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r +& 4*w3r*rhogeq*cs**2*k**2*rhogsol*w2r*w2i*w1r + w3r*Kdrag*rhogsol*w2r*w1r*w2i**2 +& 2*w3r*rhogeq*rhogsol*w2i**2*w2r**2*w1i + w3r**2*Kdrag*rhogsol*w2r*w1r**2 +& 2*w3r**2*rhogeq*rhogsol*w2r*w2i*w1i**2 - w3r*rhogeq*rhogsol*w1i**2*w2r**2*w2i -& w3r*rhogeq*rhogsol*w2i*w1r**2*w2r**2 - 2*w3r*w2r*Kdrag*rhogeq*k*vgsol*w2i*w1i +& w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i + w3r**2*rhogeq**2*k*vgsol*w2i*w2r**2 +& w3r**2*rhogeq**2*k*vgsol*w2r**2*w1i - w3r**2*Kdrag*rhogeq*k*vgsol*w2r*w1r + w3r**2*Kdrag*rhogeq*k*vgsol*w2r**2& - w3r**2*rhogeq*rhogsol*w2r*w2i**2*w1i - w3r**2*rhogeq*rhogsol*w2r**2*w2i*w1r +& w3r**2*Kdrag*rhogeq*k*vgsol*w2i**2 - w3r**2*rhogeq**2*cs**2*k**3*vgsol*w1i +& 2*w3r**2*rhogeq*rhogsol*w2r*w2i*w1r**2 - 2*w3r**2*rhogeq**2*k*vgsol*w2r*w2i*w1r - w3r*Kdrag**2*k*vgsol*w2r*w1i& + rhogeq*k*Kdrag*vdsol*w2r**4 - w3i*rhogeq*rhogsol*w2r**3*w1i**2 + Kdrag**2*k*vdsol*w2i*w2r**2 -& 2*vgsol*k*rhogeq**2*w2i**2*w2r**2*w1i + vgsol*k*rhogeq**2*w2i*w1r**2*w2r**2 -& 2*vgsol*rhogeq**2*k**3*cs**2*w2r*w2i*w1r - rhogeq*cs**2*k**2*rhogsol*w2r**2*w2i*w1r +& rhogeq*cs**2*k**2*rhogsol*w2r**3*w1i + rhogeq*cs**2*k**2*rhogsol*w2r*w2i**2*w1i +& w3i*rhogeq**2*k*vgsol*w2r**2*w1r**2 - w3i*rhogeq**2*k*vgsol*w2r**4 + w3i**2*rhogeq**2*k*vgsol*w2i*w2r**2 -& 2*w3i**2*rhogeq**2*k*vgsol*w2r*w2i*w1r + w3i**2*rhogeq**2*k*vgsol*w2r**2*w1i -& rhogeq*cs**2*k**3*vdsol*Kdrag*w2r**2 + rhogeq*cs**2*k**3*vdsol*Kdrag*w2r*w1r - Kdrag**2*k*vdsol*w2r**2*w1i +& 3*w3i*Kdrag*k*rhogeq*vgsol*w2r**2*w1i - 2*w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1r +& w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w2i**2 + w3i*cs**2*k**2*rhogeq*rhogsol*w2r**3 +& w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w1r**2 - 4*w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w2i*w1i +& w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w1i**2 + w3i*rhogeq**2*k*vgsol*w2r**2*w1i**2 -& 2*w3i*rhogeq**2*k*vgsol*w2i**2*w2r**2 - w3i**2*Kdrag*rhogeq*k*vgsol*w2r*w1r +& w3i**2*Kdrag*rhogeq*k*vgsol*w2i**2 + Kdrag**2*k*vgsol*w2r**2*w1i + w3i*rhogeq**2*cs**2*k**3*vgsol*w2r**2 +& Kdrag*k*rhogeq*vgsol*w2r**2*w1r**2 + Kdrag*k*rhogeq*vgsol*w2r**2*w1i**2 +& w3i**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i - Kdrag**2*k*vgsol*w2i*w2r**2 + 2*rhogeq*cs**4*k**4*rhogsol*w2i*w2r +& 2*w3i*rhogeq*rhogsol*w2i**2*w2r**2*w1r + w3i**2*Kdrag*rhogeq*k*vgsol*w2r**2 + w3i*rhogeq*rhogsol*w2r**4*w1r -& w3i*rhogeq*rhogsol*w2r**3*w1r**2 - rhogeq*cs**4*k**4*rhogsol*w2r*w1i - w3i*rhogeq*cs**4*k**4*rhogsol*w2r -& rhogeq*k*Kdrag*vdsol*w2r**2*w1i*w2i + Kdrag*cs**2*k**2*rhogsol*w2r**3 + 2*rhogeq*k*Kdrag*vdsol*w2i**2*w2r**2 -& rhogeq*k*Kdrag*vdsol*w2r**3*w1r + Kdrag*cs**2*k**2*rhogsol*w2r*w2i**2 - rhogeq*k*Kdrag*vdsol*w2r*w1r*w2i**2 -& Kdrag*cs**2*k**2*rhogsol*w2r**2*w1r + w3i*Kdrag*rhogsol*w2r**2*w2i*w1r - w3i*Kdrag*rhogsol*w2r*w2i**2*w1i -& w3i*Kdrag*rhogsol*w2r**3*w1i - w3i*Kdrag*cs**2*k**2*rhogsol*w2r*w1i - w3i**2*rhogeq*rhogsol*w2r**2*w2i*w1r -& w3i**2*rhogeq*rhogsol*w2r*w2i**2*w1i - w3i*rhogeq*rhogsol*w2r*w2i**2*w1r**2 +& 2*w3i**2*rhogeq*rhogsol*w2r*w2i*w1r**2 - w3i**2*rhogeq*rhogsol*w2r**3*w1i +& 2*w3i**2*rhogeq*rhogsol*w2r*w2i*w1i**2 - w3i*rhogeq*rhogsol*w2r*w2i**2*w1i**2 -& cs**2*k**3*rhogeq*Kdrag*vgsol*w2r*w1r + cs**2*k**3*rhogeq*Kdrag*vgsol*w2r**2 -& w3i**2*cs**2*k**3*rhogeq**2*vgsol*w1i - w3i**2*Kdrag*rhogsol*w2r**2*w1r + w3i*Kdrag**2*k*vdsol*w2r*w1r +& w3i**2*Kdrag*rhogsol*w2r*w1r**2 + w3i**2*Kdrag*rhogsol*w2r*w1i**2 - w3i*Kdrag**2*k*vdsol*w2r**2 +& w3i*Kdrag**2*k*vgsol*w2r**2 - w3i*Kdrag**2*k*vgsol*w2r*w1r + 2*w3i*rhogeq*k*Kdrag*vdsol*w2r*w2i*w1r -& w3i*rhogeq*k*Kdrag*vdsol*w2r**2*w1i - w3i*rhogeq*k*Kdrag*vdsol*w2i*w2r**2 + w3r**2*Kdrag*rhogsol*w2r*w1i**2 -& w3r**2*Kdrag*rhogsol*w2r**2*w1r + w3r*Kdrag*rhogsol*w2r**3*w1r - w3r**2*rhogeq*rhogsol*w2r**3*w1i +& Kdrag**2*k*vdsol*w2i**3 - Kdrag**2*k*vgsol*w2i**3 - Kdrag*rhogeq*k*vgsol*w2r**4 +& rhogeq**2*cs**2*k**3*vgsol*w1i*w2r**2 - 2*Kdrag*rhogeq*k*vgsol*w2i**2*w2r**2 -& 2*Kdrag*rhogeq*k*vgsol*w2r*w1r*w2i*w3i + 2*rhogeq**2*k*vgsol*w2r**2*w1i*w2i*w3i +& 2*w3r*rhogeq*k*Kdrag*vdsol*w2r*w2i*w1i + w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1r + w3r*Kdrag**2*k*vdsol*w2r*w1i -& rhogeq**2*k*vgsol*w2r**4*w1i - w3r*rhogeq*k*Kdrag*vdsol*w2i**2*w1r - w3r*rhogeq*cs**2*k**2*rhogsol*w2i*w1r**2 -& w3r*rhogeq*cs**2*k**2*rhogsol*w2i**3 + 2*w3r*vgsol*k**3*cs**2*rhogeq**2*w2i*w1r +& w3r*cs**4*k**4*rhogeq*rhogsol*w1i + w3r*Kdrag*cs**2*k**2*rhogsol*w1i*w2i -& w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r + w3i*Kdrag**2*k*vdsol*w1i*w2i - w3i*Kdrag**2*k*vdsol*w2i**2 +& rhogeq*k*Kdrag*vdsol*w2i**4 - w3i*Kdrag**2*k*vgsol*w1i*w2i + w3i*Kdrag**2*k*vgsol*w2i**2 +& w3r*Kdrag**2*k*vgsol*w2i*w1r + 2*w3r*rhogeq**2*k*vgsol*w2i**3*w1r - cs**2*k**3*rhogeq*Kdrag*vdsol*w1i*w2i -& w3i**2*Kdrag*rhogeq*k*vgsol*w1i*w2i - Kdrag*rhogeq*k*vgsol*w2i**4 + Kdrag*rhogeq*k*vgsol*w2i**2*w1r**2 +& Kdrag*rhogeq*k*vgsol*w2i**2*w1i**2 + 3*w3r*Kdrag*k*rhogeq*vgsol*w2i**2*w1r +& w3i*rhogeq*k*Kdrag*vgsol*w2i**2*w1i - w3i*rhogeq*k*Kdrag*vgsol*w2i*w1r**2 - w3i*rhogeq*k*Kdrag*vgsol*w1i**2*w2i& - w3i*rhogeq*k*Kdrag*vdsol*w2i**3 + w3i*rhogeq*k*Kdrag*vdsol*w2i**2*w1i - w3i*rhogeq**2*k*vgsol*w2i**2*w1i**2 +& 2*w3i*rhogeq**2*k*vgsol*w2i**3*w1i - w3i*rhogeq**2*k*vgsol*w2i**4 - w3i*rhogeq**2*cs**2*k**3*vgsol*w1r**2 -& w3i*rhogeq**2*cs**2*k**3*vgsol*w1i**2 - w3r**2*Kdrag*k*rhogeq*vgsol*w1i*w2i +& w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r - rhogeq*cs**2*k**2*rhogsol*w2i**3*w1r +& w3i*Kdrag*cs**2*k**2*rhogsol*w2i*w1r - rhogeq*cs**4*k**4*rhogsol*w2i*w1r -& w3r**2*rhogeq*cs**2*k**2*rhogsol*w2i*w1r + w3r**2*vgsol*rhogeq**2*k**3*cs**2*w2i -& w3i*rhogeq*cs**2*k**3*vdsol*Kdrag*w2i + w3i*rhogeq*cs**2*k**3*vdsol*Kdrag*w1i +& cs**2*k**3*rhogeq*Kdrag*vgsol*w1i*w2i - w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1i +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i + w3i*rhogeq*cs**4*k**4*rhogsol*w1r +& w3i**2*vgsol*rhogeq**2*k**3*cs**2*w2i - w3i**2*vgsol*k*rhogeq**2*w2i**2*w1i -& w3i**2*rhogeq*cs**2*k**2*rhogsol*w2i*w1r + w3i**2*vgsol*k*rhogeq**2*w2i**3 -& w3r**2*vgsol*k*rhogeq**2*w2i**2*w1i + w3r**2*vgsol*k*rhogeq**2*w2i**3 - w3i*rhogeq**2*cs**2*k**3*vgsol*w2i**2 +& 2*w3i*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i - cs**2*k**3*rhogeq*Kdrag*vgsol*w2i**2 +& cs**2*k**3*rhogeq*Kdrag*vdsol*w2i**2 - w3i*rhogeq**2*k*vgsol*w2i**2*w1r**2 - rhogeq*k*Kdrag*vdsol*w2i**3*w1i -& Kdrag*cs**2*k**2*rhogsol*w2i**2*w1r + w3r*Kdrag*rhogsol*w2i**3*w1i - w3r*Kdrag*rhogsol*w2i**2*w1r**2 +& w3i*Kdrag*rhogsol*w2i**3*w1r + rhogeq**2*cs**2*k**3*vgsol*w1i**2*w2i + rhogeq**2*cs**2*k**3*vgsol*w2i*w1r**2 -& w3r*Kdrag**2*k*vdsol*w2i*w1r + vgsol*k*rhogeq**2*w1i**2*w2r**2*w2i - w3r*cs**4*k**4*rhogeq*rhogsol*w2i -& w3r*rhogeq*cs**2*k**2*rhogsol*w1i**2*w2i + 2*w3r*rhogeq*cs**2*k**2*rhogsol*w2i**2*w1i -& w3r*Kdrag*rhogsol*w2i**2*w1i**2 + 2*w3i*rhogeq*cs**2*k**2*rhogsol*w2i**2*w1r - w3r**2*rhogeq*rhogsol*w2i**3*w1r& - w3i**2*rhogeq*rhogsol*w2i**3*w1r - w3i**2*Kdrag*rhogsol*w2i**2*w1r - w3r**2*Kdrag*rhogsol*w2i**2*w1r -& rhogeq**2*k*vgsol*w2i**4*w1i + rhogeq**2*k*vgsol*w2i**3*w1r**2 - w3r*rhogeq*rhogsol*w2i**3*w1i**2 +& w3r*rhogeq*rhogsol*w2i**4*w1i - w3r*rhogeq*rhogsol*w2i**3*w1r**2 + rhogeq**2*k*vgsol*w2i**3*w1i**2 -& Kdrag**2*k*vdsol*w2i**2*w1i + w3i*rhogeq*rhogsol*w2i**4*w1r + Kdrag**2*k*vgsol*w2i**2*w1i -& w3r*Kdrag*cs**2*k**2*rhogsol*w2i**2 - rhogeq**2*cs**2*k**3*vgsol*w1i*w2i**2)/(w2r**2 - 2*w3r*w2r + w2i**2 +& w3i**2 - 2*w2i*w3i + w3r**2)/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2)/rhogeq/Kdrag vd1r =(w3r*Kdrag*rhogsol*w1i**3*w2r - w3r*w1r**2*k*Kdrag**2*vgsol - w3r*w1r**3*rhogeq*rhogsol*w2i**2 -& w3r*rhogeq*w2r**2*w1r**3*rhogsol - w3r*w1i**2*k*Kdrag**2*vgsol + w3r*rhogeq*w1i**4*w2r*rhogsol +& w3r*Kdrag*rhogsol*w1i*w2r*w1r**2 - 2*w3r*rhogeq*w1i*k*Kdrag*vdsol*w2r*w1r +& 2*w3r*rhogeq*w2r*w1i*k*Kdrag*vgsol*w1r - w3r*rhogeq*w1i**2*w2r**2*rhogsol*w1r + w3r*w1i**2*k*Kdrag**2*vdsol +& w3r*rhogeq*w2i*w1r**2*k*Kdrag*vdsol + w3r*w1r**2*k*Kdrag**2*vdsol - w3r*Kdrag*rhogsol*w2i*w1r**3 +& w3r**2*w1i**2*rhogeq**2*k*w1r*vgsol + w3r**2*w1r**3*rhogeq**2*k*vgsol - 2*w3r**2*w2i*w1i*rhogeq**2*k*w1r*vgsol& - w3r**2*rhogeq*rhogsol*k**2*cs**2*w2r**2 - w3r**2*rhogeq*rhogsol*k**2*cs**2*w2i**2 -& w3r**2*rhogeq*w2r*w1r*rhogsol*w1i**2 + w3r**2*w2i*w1i*rhogeq*w1r**2*rhogsol +& 2*w3r*w2r*w1i**2*rhogeq**2*k*w1r*vgsol + 2*w3r*w2r*w1r**3*rhogeq**2*k*vgsol -& w3r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w1r - w3r*cs**2*k**2*rhogeq*rhogsol*w1r**3 -& 2*w3r*w1i**2*rhogeq**2*w1r**2*k*vgsol + w3r*w1i**3*rhogeq*k*Kdrag*vdsol - 2*w3r*w1i**3*Kdrag*k*rhogeq*vgsol -& w3r*w1i**2*rhogeq*w1r*rhogsol*w2i**2 + w3r*w1r**2*rhogeq*w1i*k*Kdrag*vdsol - w3r*w1r*Kdrag*rhogsol*w2i*w1i**2 -& w3r*w2i*w1i**2*rhogeq*k*Kdrag*vdsol - 2*w3r*w1r**2*Kdrag*k*rhogeq*vgsol*w1i +& 2*w3r*rhogeq*w1i**2*w2r*rhogsol*w1r**2 + rhogeq*w1i*rhogsol*k**2*cs**2*w3i**2*w2i +& rhogeq*w1i*rhogsol*k**2*cs**2*w3r**2*w2i + rhogeq**2*w1i**2*k*vgsol*w3r*w2r**2 +& rhogeq**2*w1i**2*k*vgsol*w3r*w2i**2 - w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r +& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r + w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r -& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r - rhogeq**2*cs**2*k**3*w2i**2*w1r*vgsol +& rhogeq*cs**4*k**4*w2r*w1r*rhogsol - rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol -& rhogeq*cs**2*k**3*w2r*w1i*Kdrag*vgsol - rhogeq**2*cs**2*k**3*w2r*w1i**2*vgsol +& rhogeq*cs**2*k**3*w2r*w1i*Kdrag*vdsol + rhogeq**2*cs**2*k**3*w2r*w1r**2*vgsol -& rhogeq*cs**4*k**4*w2i*w1i*rhogsol + w3i*cs**4*k**4*rhogeq*rhogsol*w2i - w3i*cs**4*k**4*rhogeq*rhogsol*w1i +& w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1i + w3i*cs**2*k**2*rhogeq*rhogsol*w1i*w2i**2 +& w3r*rhogeq**2*cs**2*k**3*w2i**2*vgsol - w3r*rhogeq*cs**4*k**4*w2r*rhogsol +& w3r*rhogeq**2*cs**2*k**3*w2r**2*vgsol - w3r*Kdrag*rhogsol*k**2*cs**2*w1i*w2r +& w3r*Kdrag*rhogsol*k**2*cs**2*w2i*w1r - w3r*Kdrag*k*rhogeq*vgsol*w2i*w1r**2 +& w3r*Kdrag*k*rhogeq*vgsol*w2i*w1i**2 - w3r*Kdrag**2*k*vdsol*w2r*w1r - w3r*Kdrag**2*k*vdsol*w2i*w1i +& w3r*Kdrag**2*k*vgsol*w2r*w1r + w3r*Kdrag**2*k*vgsol*w2i*w1i + w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1i +& w3r*Kdrag*k*rhogeq*vgsol*w1i*w2i**2 + w3r*rhogeq*cs**2*k**2*w2r**2*w1r*rhogsol +& w3r*rhogeq*w2i**2*w1r*cs**2*k**2*rhogsol - w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol -& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol + w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol +& w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol - w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol +& w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol + w3r*rhogeq*cs**4*k**4*w1r*rhogsol -& 2*w3r*rhogeq**2*cs**2*k**3*w2r*w1r*vgsol + w3r**2*rhogeq**2*cs**2*k**3*w2r*vgsol +& w3r**2*rhogeq*w2r*w1i*k*Kdrag*vgsol + w3r**2*rhogeq**2*w2r*w1i**2*k*vgsol - w3r**2*rhogeq**2*w2r*w1r**2*k*vgsol& - w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol - w3r**2*rhogeq*w2i**2*w1i**2*rhogsol +& w3r**2*rhogeq*w1r**2*w2i**2*rhogsol + w3r**2*rhogeq*w2r**2*w1r**2*rhogsol - w3r**2*rhogeq*w1i**2*w2r**2*rhogsol& - w3r**2*Kdrag*rhogsol*w1i*w2i**2 + w3r**2*Kdrag*rhogsol*w2i*w1r**2 + w3r**2*Kdrag*rhogsol*w2i*w1i**2 -& w3r**2*Kdrag*rhogsol*w2r**2*w1i - w3r**2*rhogeq*w2i*w1r*k*Kdrag*vgsol + w3i**2*rhogeq**2*cs**2*k**3*w2r*vgsol -& w3i**2*Kdrag*rhogsol*w2r**2*w1i - w3i**2*Kdrag*rhogsol*w1i*w2i**2 + w3i**2*Kdrag*rhogsol*w2i*w1r**2 +& w3i**2*Kdrag*rhogsol*w2i*w1i**2 - Kdrag*k*rhogeq*vgsol*w3i*w1r*w2r**2 - Kdrag*k*rhogeq*vgsol*w3i*w2r*w1r**2 +& Kdrag*k*rhogeq*vgsol*w3i*w2r*w1i**2 - Kdrag*k*rhogeq*vgsol*w3i*w1r*w2i**2 +& Kdrag*rhogsol*k**2*cs**2*w3i*w2r*w1r + Kdrag*rhogsol*k**2*cs**2*w2i*w3i*w1i + Kdrag*rhogsol*w2r**2*w1i**2*w3i +& Kdrag*rhogsol*w3i*w1r**2*w2r**2 + Kdrag*rhogsol*w1i**2*w2i**2*w3i + Kdrag*rhogsol*w2i**2*w1r**2*w3i -& Kdrag**2*k*vdsol*w2r*w1i*w3i + Kdrag**2*k*vdsol*w2i*w3i*w1r + Kdrag**2*k*vgsol*w2r*w1i*w3i -& Kdrag**2*k*vgsol*w2i*w3i*w1r + rhogeq*cs**2*k**3*w2i*w1r*Kdrag*vdsol - rhogeq*cs**2*k**3*w2i*w1r*Kdrag*vgsol -& w1r**3*vdsol*Kdrag*k*rhogeq*w2i - Kdrag*rhogsol*k**2*cs**2*w2i*w1r**2 + 2*Kdrag*k*rhogeq*vgsol*w2i*w1r**3 -& w3i**2*rhogeq*w2i*w1r*k*Kdrag*vgsol + w3i**2*rhogeq*w2r*w1i*k*Kdrag*vgsol + w3i**2*rhogeq**2*w2r*w1i**2*k*vgsol& - w3i**2*rhogeq**2*w2r*w1r**2*k*vgsol - w3i**2*rhogeq**2*cs**2*k**3*w1r*vgsol -& w3i**2*rhogeq*w2i**2*w1i**2*rhogsol + w3i**2*rhogeq*w1r**2*w2i**2*rhogsol + w3i**2*rhogeq*w2r**2*w1r**2*rhogsol& - w3i**2*rhogeq*w1i**2*w2r**2*rhogsol + rhogeq*w1i**3*w2r**2*rhogsol*w3i - 2*rhogeq*w2r*w1i**3*k*Kdrag*vgsol +& rhogeq*w2r**2*w1r**2*rhogsol*w3i*w1i + rhogeq**2*w2r**2*k*w1r*vgsol*w1i**2 + Kdrag**2*k*vdsol*w2r*w1r**2 -& Kdrag**2*k*vgsol*w2r*w1r**2 - rhogeq*cs**2*k**2*w2r*w1r**3*rhogsol + Kdrag**2*k*vgsol*w1r**3 -& Kdrag**2*k*vdsol*w1r**3 + rhogeq**2*w2r**2*k*w1r**3*vgsol - 2*rhogeq**2*w2r**2*k*w1r*vgsol*w3i*w1i +& rhogeq*w3i**2*cs**2*k**2*rhogsol*w2r*w1r - 2*rhogeq*w2r*w1i*k*Kdrag*vgsol*w1r**2 -& rhogeq*cs**2*k**2*w1i**2*w2r*rhogsol*w1r - w3r*rhogeq**2*k*vgsol*w2i**2*w1r**2 - rhogeq**2*w2r*w1r**4*k*vgsol -& rhogeq*w2r*w3i**2*w1r**3*rhogsol + w3i*rhogeq*k*Kdrag*vdsol*w2r*w1r**2 + rhogeq*w2r*w1i*k*Kdrag*vdsol*w1r**2 -& Kdrag*rhogsol*w3i*w2r*w1r**3 - 2*rhogeq**2*w2r*w1i**2*k*vgsol*w1r**2 - rhogeq*w3i**2*cs**2*k**2*rhogsol*w2r**2& - rhogeq*w3i**2*cs**2*k**2*rhogsol*w2i**2 - Kdrag*rhogsol*w3i*w2r*w1r*w1i**2 -& w3i*rhogeq*k*Kdrag*vdsol*w2r*w1i**2 + Kdrag**2*k*vdsol*w2r*w1i**2 - rhogeq*w2r*w3i**2*w1r*rhogsol*w1i**2 -& Kdrag**2*k*vgsol*w2r*w1i**2 + rhogeq*w2r*w1i**3*k*Kdrag*vdsol - rhogeq**2*w2r*w1i**4*k*vgsol +& cs**2*k**2*rhogeq*rhogsol*w1r**4 + w1r**2*w3i*rhogeq*rhogsol*w2i**2*w1i +& 2*rhogeq*w1i**2*rhogsol*k**2*cs**2*w1r**2 + rhogeq*w1i**4*rhogsol*k**2*cs**2 -& w2i*w1i**3*rhogeq*rhogsol*k**2*cs**2 - w1r**4*w3i*rhogeq*rhogsol*w2i - w1r**2*rhogeq*cs**4*k**4*rhogsol +& w2i*w1i**3*rhogeq*rhogsol*w3i**2 - w3i*cs**2*k**2*rhogeq*rhogsol*w1i*w1r**2 +& w2i*w1i*rhogeq*w1r**2*rhogsol*w3i**2 - w3i*cs**2*k**2*rhogeq*rhogsol*w1i**3 + w1i**3*w3i*rhogeq*rhogsol*w2i**2& - w2i*w1i*cs**2*k**2*rhogeq*rhogsol*w1r**2 + w1i**2*rhogeq**2*k*vgsol*w2i**2*w1r -& 2*w2i*w1i*rhogeq**2*k*w1r*vgsol*w3i**2 - 2*vgsol*k*rhogeq*Kdrag*w2i*w1r*w3i*w1i +& w1r**3*rhogeq**2*k*vgsol*w2i**2 - w1i**4*w3i*rhogeq*rhogsol*w2i + 2*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w1r +& rhogeq*cs**4*k**4*rhogsol*w1i**2 - 2*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w1r + Kdrag*rhogsol*k**2*cs**2*w1i**3 -& Kdrag**2*k*vdsol*w1r*w1i**2 + rhogeq**2*w3i**2*k*w1r**3*vgsol + Kdrag**2*k*vgsol*w1r*w1i**2 -& Kdrag*rhogsol*w1i**3*w3i*w2i + 2*w1r*Kdrag*k*rhogeq*vgsol*w2i*w1i**2 + 2*w2i*w1i*rhogeq**2*cs**2*k**3*w1r*vgsol& - Kdrag*rhogsol*w3i*w1r**2*w2i*w1i + rhogeq**2*w3i**2*k*w1r*vgsol*w1i**2 +& 2*w3i*rhogeq*k*Kdrag*vdsol*w1r*w2i*w1i - Kdrag*rhogsol*k**2*cs**2*w3i*w1r**2 - w3i*rhogeq*k*Kdrag*vdsol*w1r**3& + 2*rhogeq**2*cs**2*k**3*w1r*vgsol*w3i*w1i + 2*Kdrag*k*rhogeq*vgsol*w3i*w1r**3 -& Kdrag*rhogsol*k**2*cs**2*w1i**2*w2i - Kdrag*rhogsol*k**2*cs**2*w3i*w1i**2 + Kdrag*rhogsol*k**2*cs**2*w1i*w1r**2& - 2*rhogeq**2*k*vgsol*w2i**2*w1r*w3i*w1i - 2*w1r**2*w3i*rhogeq*rhogsol*w1i**2*w2i -& w1r*w1i**2*vdsol*Kdrag*k*rhogeq*w2i - 2*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i*w3i -& w3i*rhogeq*k*Kdrag*vdsol*w1r*w1i**2 + 2*Kdrag*k*rhogeq*vgsol*w3i*w1r*w1i**2 - w3r**2*rhogeq*w2r*w1r**3*rhogsol& - w3r*w1i**4*rhogeq**2*k*vgsol + w3r*rhogeq*w2r*w1r**4*rhogsol - w3r*rhogeq**2*w1r**4*k*vgsol +& 2*w1i**2*rhogeq**2*k*w1r*vgsol*w2i*w3i + w3r**2*w2i*w1i**3*rhogeq*rhogsol - w3r*rhogeq**2*w1r**2*k*vgsol*w2r**2& + 2*w1r**3*rhogeq**2*k*vgsol*w2i*w3i + w3r**2*rhogeq*rhogsol*k**2*cs**2*w2r*w1r)/(w1i**2 - 2*w3i*w1i + w3r**2 +& w1r**2 + w3i**2 - 2*w3r*w1r)/Kdrag/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2)/rhogeq/k vd1i = - (w3r**2*rhogeq*rhogsol*w1i**3*w2r + w3r*Kdrag*rhogsol*k**2*cs**2*w1i**2 +& w3r*rhogeq*rhogsol*k**2*cs**2*w1i**3 - 2*w3r*rhogeq*rhogsol*w2i*w1i**2*w1r**2 +& w3r*rhogeq*rhogsol*w1i*w2i**2*w1r**2 + w3r*rhogeq*rhogsol*w2r**2*w1i*w1r**2 -& 2*w3r*w2r*rhogeq**2*k*vgsol*w1i*w1r**2 - 2*w3r*w2r*rhogeq**2*cs**2*k**3*vgsol*w1i -& 2*w3r*w2r*rhogeq**2*k*vgsol*w1i**3 - w3r*Kdrag*rhogsol*w2r*w1i**2*w1r +& w3r*rhogeq*rhogsol*k**2*cs**2*w1i*w1r**2 + w3r*rhogeq*k*Kdrag*vdsol*w2r*w1i**2 +& w3r*Kdrag*rhogsol*k**2*cs**2*w1r**2 - w3r*Kdrag*w2i*rhogsol*w1i*w1r**2 - w3r*rhogeq*k*Kdrag*vdsol*w2r*w1r**2 +& w3r*rhogeq*k*Kdrag*vdsol*w1r**3 - 2*w3r*rhogeq*k*Kdrag*vdsol*w1r*w2i*w1i + w3r*rhogeq*k*Kdrag*vdsol*w1r*w1i**2& + 2*w3r*vgsol*k*rhogeq**2*w2i**2*w1i*w1r + 2*w3r*Kdrag*k*rhogeq*vgsol*w1i*w2i*w1r +& 2*w3r*rhogeq**2*cs**2*k**3*vgsol*w1i*w1r - 2*w3r**2*rhogeq*rhogsol*w1i*w2r**2*w1r -& w3r**2*rhogeq**2*k*vgsol*w1i*w1r**2 - 2*w3r**2*rhogeq*rhogsol*w2i**2*w1r*w1i +& 2*w3r**2*rhogeq**2*k*vgsol*w1i*w2r*w1r + w3r**2*rhogeq*rhogsol*w1i*w2r*w1r**2 +& rhogeq**2*w3i**2*w2i*w1i**2*k*vgsol - rhogeq**2*w3i**2*w2i*k*vgsol*w1r**2 - Kdrag*w3i**2*k*rhogeq*w1r**2*vgsol& - Kdrag*w1i**2*rhogeq*k*vgsol*w3i**2 - Kdrag*w3r**2*w1i**2*k*rhogeq*vgsol - Kdrag*w3r**2*w1r**2*rhogeq*k*vgsol& - rhogeq**2*w3r**2*k*vgsol*w2i*w1r**2 + rhogeq**2*w3r**2*k*vgsol*w2i*w1i**2 + w3r*Kdrag*rhogsol*w2r**2*w1r**2 +& w3r*Kdrag*rhogsol*w2r**2*w1i**2 - 3*w3r*Kdrag*k*rhogeq*vgsol*w2r*w1i**2 - w3r*Kdrag*k*rhogeq*vgsol*w2r*w1r**2 +& w3r*rhogeq*cs**2*k**2*rhogsol*w2r**2*w1i - w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r -& w3r*Kdrag*cs**2*k**2*rhogsol*w2r*w1r + w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r + w3r**2*Kdrag*rhogsol*w2r*w1r**2& + w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i + w3r**2*Kdrag*rhogeq*k*vgsol*w2r*w1r -& w3r**2*rhogeq**2*cs**2*k**3*vgsol*w1i - w3r*Kdrag**2*k*vgsol*w2r*w1i -& 4*w3r*cs**2*k**2*rhogeq*rhogsol*w2r*w1i*w1r + 2*w3r*rhogeq**2*k*vgsol*w2r**2*w1i*w1r -& Kdrag*rhogsol*w2r*w1i**3*w3i + cs**2*k**2*rhogeq*rhogsol*w2r*w1i**3 + 2*Kdrag*rhogeq*k*vgsol*w2r*w1r*w3i*w1i -& rhogeq**2*k*vgsol*w2r**2*w1i**3 - 2*rhogeq*k*Kdrag*vdsol*w1r**2*w1i**2 - rhogeq*k*Kdrag*vdsol*w1r**4 -& Kdrag*rhogsol*w2r*w1r**2*w3i*w1i + Kdrag*cs**2*k**2*rhogsol*w2r*w1r**2 +& cs**2*k**2*rhogeq*rhogsol*w2r*w1i*w1r**2 - rhogeq**2*k*vgsol*w2r**2*w1i*w1r**2 -& vgsol*k*rhogeq**2*w2i**2*w1i**3 - rhogeq*k*Kdrag*vdsol*w1i**4 - 2*rhogeq**2*k*vgsol*w1i**3*w2i*w3i -& cs**2*k**3*rhogeq*Kdrag*vgsol*w1r**2 + 4*rhogeq*cs**2*k**2*rhogsol*w2i*w1r*w3i*w1i -& rhogeq*cs**2*k**2*rhogsol*w2i*w1r*w1i**2 + w3r**2*rhogeq*rhogsol*w2i*w1r*w1i**2 -& rhogeq*cs**2*k**2*rhogsol*w2i*w1r**3 + cs**2*k**3*rhogeq*Kdrag*vdsol*w1r**2 -& 2*cs**4*k**4*rhogeq*rhogsol*w1i*w1r + w1i**3*k*Kdrag**2*vgsol - vgsol*k*rhogeq**2*w2i**2*w1i*w1r**2 -& Kdrag**2*k*vgsol*w2i*w1r**2 + rhogeq*k*Kdrag*vdsol*w2r*w1r**3 + rhogeq*k*Kdrag*vdsol*w2i*w1i*w1r**2 +& cs**2*k**3*rhogeq*Kdrag*vgsol*w1i**2 - cs**2*k**3*rhogeq*Kdrag*vdsol*w1i**2 + w1i*k*Kdrag**2*vgsol*w1r**2 +& rhogeq*w3i*w1i*k*Kdrag*vdsol*w1r**2 + 2*rhogeq**2*w3i*w1i**2*k*vgsol*w1r**2 -& rhogeq**2*w3i**2*w1i*k*vgsol*w1r**2 - rhogeq*w3i*w1r**3*cs**2*k**2*rhogsol +& rhogeq*w3i*w2i*k*Kdrag*vdsol*w1r**2 + rhogeq*w3i**2*w2r*rhogsol*w1i*w1r**2 + rhogeq*w3i**2*w2i*w1r**3*rhogsol +& rhogeq*k*Kdrag*vdsol*w2r*w1r*w1i**2 + rhogeq*w3i*w2i**2*w1r*rhogsol*w1i**2 -& Kdrag*w1r*cs**2*k**2*rhogsol*w1i**2 + Kdrag*w2i*w3i*w1r*rhogsol*w1i**2 + Kdrag*w2r*cs**2*k**2*rhogsol*w1i**2 +& rhogeq*w3i**2*w2i*w1r*rhogsol*w1i**2 + rhogeq*w3i*w1i**2*w2r**2*rhogsol*w1r +& 2*rhogeq**2*w3i**2*w1i*k*vgsol*w2r*w1r - 2*rhogeq*w3i*w1i*k*Kdrag*vdsol*w2r*w1r +& rhogeq*w3i*w1i**3*k*Kdrag*vdsol - rhogeq*w3i*w1i**2*k*Kdrag*vdsol*w2i -& rhogeq*w3i*w1r*cs**2*k**2*rhogsol*w1i**2 - 2*rhogeq*w3i**2*w2r**2*rhogsol*w1i*w1r +& rhogeq*w3i**2*w2r*rhogsol*w1i**3 - 2*rhogeq*w3i**2*w2i**2*w1r*rhogsol*w1i -& 2*rhogeq*w3i*w1i**2*w2r*rhogsol*w1r**2 + 2*Kdrag*w1i**2*k*rhogeq*vgsol*w1r**2 - w1i**3*k*Kdrag**2*vdsol +& Kdrag*w1r**4*rhogeq*k*vgsol + rhogeq*k*Kdrag*vdsol*w2i*w1i**3 + 2*rhogeq**2*k*vgsol*w2i*w1i**2*w1r**2 +& 2*rhogeq**2*cs**2*k**3*vgsol*w1i*w2r*w1r + Kdrag**2*k*vdsol*w2i*w1r**2 - 2*rhogeq**2*k*vgsol*w1i*w1r**2*w2i*w3i& + w3i*k*Kdrag**2*vdsol*w1r**2 + rhogeq*w3i*w2i**2*w1r**3*rhogsol - w3i*k*Kdrag**2*vgsol*w1r**2 +& rhogeq**2*w3i*w1r**4*k*vgsol - w1i*k*Kdrag**2*vdsol*w1r**2 - w3i*rhogeq**2*k*vgsol*w2r**2*w1r**2 -& rhogeq*cs**2*k**3*vdsol*Kdrag*w2r*w1r + w3i*Kdrag*k*rhogeq*vgsol*w2r**2*w1i -& w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1r + 2*w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w1r**2 -& 2*w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w1i**2 + w3i*rhogeq**2*k*vgsol*w2r**2*w1i**2 +& w3i**2*Kdrag*rhogeq*k*vgsol*w2r*w1r - w1i**2*k*Kdrag**2*vgsol*w2i + w3i*rhogeq**2*cs**2*k**3*vgsol*w2r**2 -& Kdrag*k*rhogeq*vgsol*w2r**2*w1r**2 - Kdrag*k*rhogeq*vgsol*w2r**2*w1i**2 +& w3i**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i + rhogeq*cs**4*k**4*rhogsol*w2r*w1i -& w3i*rhogeq*cs**4*k**4*rhogsol*w2r - w3i*Kdrag*cs**2*k**2*rhogsol*w2r*w1i + w1i**2*k*Kdrag**2*vdsol*w2i -& rhogeq**2*w3i**2*w1i**3*k*vgsol + rhogeq**2*w3i*w1i**4*k*vgsol - rhogeq*w3i*w2r*w1r**4*rhogsol -& Kdrag*w1r**3*cs**2*k**2*rhogsol + Kdrag*w2i*w3i*w1r**3*rhogsol + rhogeq*w3i*w2r**2*w1r**3*rhogsol -& w3i*k*Kdrag**2*vgsol*w1i**2 + w3i*k*Kdrag**2*vdsol*w1i**2 + rhogeq**2*k*vgsol*w2i*w1r**4 -& rhogeq*w3i*w1i**4*w2r*rhogsol + Kdrag*w1i**4*k*rhogeq*vgsol + cs**2*k**3*rhogeq*Kdrag*vgsol*w2r*w1r -& w3i**2*cs**2*k**3*rhogeq**2*vgsol*w1i - w3i**2*Kdrag*rhogsol*w2r**2*w1r - w3i*Kdrag**2*k*vdsol*w2r*w1r +& w3i**2*Kdrag*rhogsol*w2r*w1r**2 + w3i**2*Kdrag*rhogsol*w2r*w1i**2 + w3i*Kdrag**2*k*vgsol*w2r*w1r +& rhogeq**2*k*vgsol*w2i*w1i**4 - w3r*Kdrag*rhogsol*w2r*w1r**3 + w3r*rhogeq*rhogsol*w2r**2*w1i**3 -& w3r**2*rhogeq**2*k*vgsol*w1i**3 + w3r**2*rhogeq*rhogsol*w2i*w1r**3 + w3r**2*Kdrag*rhogsol*w2r*w1i**2 -& w3r**2*Kdrag*rhogsol*w2r**2*w1r - w3r*rhogeq*rhogsol*w2i*w1i**4 + w3r*rhogeq*rhogsol*w1i**3*w2i**2 -& w3r*Kdrag*w2i*rhogsol*w1i**3 - w3r*rhogeq*rhogsol*w2i*w1r**4 - rhogeq**2*cs**2*k**3*vgsol*w1i*w2r**2 +& w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1r + w3r*Kdrag**2*k*vdsol*w2r*w1i + 2*w3r*rhogeq*cs**2*k**2*rhogsol*w2i*w1r**2& + w3r*cs**4*k**4*rhogeq*rhogsol*w1i - w3r*Kdrag*cs**2*k**2*rhogsol*w1i*w2i -& w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r - w3i*Kdrag**2*k*vdsol*w1i*w2i + w3i*Kdrag**2*k*vgsol*w1i*w2i +& w3r*Kdrag**2*k*vgsol*w2i*w1r + cs**2*k**3*rhogeq*Kdrag*vdsol*w1i*w2i + w3i**2*Kdrag*rhogeq*k*vgsol*w1i*w2i -& Kdrag*rhogeq*k*vgsol*w2i**2*w1r**2 - Kdrag*rhogeq*k*vgsol*w2i**2*w1i**2 + w3r*Kdrag*k*rhogeq*vgsol*w2i**2*w1r +& w3i*rhogeq*k*Kdrag*vgsol*w2i**2*w1i - 3*w3i*rhogeq*k*Kdrag*vgsol*w2i*w1r**2 -& w3i*rhogeq*k*Kdrag*vgsol*w1i**2*w2i + w3i*rhogeq**2*k*vgsol*w2i**2*w1i**2 -& w3i*rhogeq**2*cs**2*k**3*vgsol*w1r**2 + w3i*rhogeq**2*cs**2*k**3*vgsol*w1i**2 +& w3r**2*Kdrag*k*rhogeq*vgsol*w1i*w2i + w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r +& w3i*Kdrag*cs**2*k**2*rhogsol*w2i*w1r + rhogeq*cs**4*k**4*rhogsol*w2i*w1r -& w3r**2*rhogeq*cs**2*k**2*rhogsol*w2i*w1r + w3r**2*vgsol*rhogeq**2*k**3*cs**2*w2i -& w3i*rhogeq*cs**2*k**3*vdsol*Kdrag*w2i + w3i*rhogeq*cs**2*k**3*vdsol*Kdrag*w1i -& cs**2*k**3*rhogeq*Kdrag*vgsol*w1i*w2i - w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1i +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i + w3i*rhogeq*cs**4*k**4*rhogsol*w1r +& w3i**2*vgsol*rhogeq**2*k**3*cs**2*w2i - w3i**2*rhogeq*cs**2*k**2*rhogsol*w2i*w1r +& w3i*rhogeq**2*cs**2*k**3*vgsol*w2i**2 - 2*w3i*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i -& w3i*rhogeq**2*k*vgsol*w2i**2*w1r**2 + w3r*Kdrag*rhogsol*w2i**2*w1r**2 + rhogeq**2*cs**2*k**3*vgsol*w1i**2*w2i -& rhogeq**2*cs**2*k**3*vgsol*w2i*w1r**2 - w3r*Kdrag**2*k*vdsol*w2i*w1r - w3r*cs**4*k**4*rhogeq*rhogsol*w2i -& 2*w3r*rhogeq*cs**2*k**2*rhogsol*w1i**2*w2i + w3r*rhogeq*cs**2*k**2*rhogsol*w2i**2*w1i +& w3r*Kdrag*rhogsol*w2i**2*w1i**2 - w3i*rhogeq*cs**2*k**2*rhogsol*w2i**2*w1r - w3i**2*Kdrag*rhogsol*w2i**2*w1r -& w3r**2*Kdrag*rhogsol*w2i**2*w1r - rhogeq**2*cs**2*k**3*vgsol*w1i*w2i**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2& + w3i**2 - 2*w3r*w1r)/Kdrag/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2)/rhogeq/k endif !------------------------------- ! G A S D E N S I T I E S !------------------------------- rhog3r =(w3r**2*k*rhogeq*vgsol*w1i + w3r**2*w2i*rhogeq*k*vgsol - w3r**2*w2r*w1i*rhogsol - w3i**2*w2i*rhogeq*k*vgsol +& w3i**2*w2r*w1i*rhogsol - w3i*w1i**2*w2r*rhogsol - w3i*w2i**2*w1r*rhogsol - w3i*w2r**2*w1r*rhogsol -& w3i*w2r*w1r**2*rhogsol + w3i**2*rhogsol*w2i*w1r - w3i*w1i*k*Kdrag*vdsol + k*Kdrag*vdsol*w2i*w1i -& k*Kdrag*vgsol*w2i*w1i + w3i*w1i**2*k*rhogeq*vgsol + w3i*w1r**2*rhogeq*k*vgsol - w3i*w1r*cs**2*k**2*rhogsol -& w3i*w2i*k*Kdrag*vdsol + w3i*w1i*k*Kdrag*vgsol + w3i*w2i*k*Kdrag*vgsol + w3i*w2r**2*rhogeq*k*vgsol -& w3i**2*k*Kdrag*vgsol - k*Kdrag*vdsol*w2r*w1r + w3i**2*k*Kdrag*vdsol - k*rhogeq*vgsol*w2r**2*w1i -& w3i*w2r*cs**2*k**2*rhogsol + w3i*w2i**2*rhogeq*k*vgsol + k*Kdrag*vgsol*w2r*w1r - k*rhogeq*vgsol*w2i*w1r**2 +& rhogsol*k**2*cs**2*w2i*w1r + rhogsol*k**2*cs**2*w1i*w2r - k*rhogeq*vgsol*w1i*w2i**2 - w3i**2*k*rhogeq*vgsol*w1i& - k*rhogeq*vgsol*w2i*w1i**2 + w3r*k*Kdrag*vdsol*w2r + 2*w3r*w3i*rhogsol*k**2*cs**2 - w3r*rhogsol*k**2*cs**2*w1i& + w3r*k*Kdrag*vdsol*w1r - w3r*rhogsol*k**2*cs**2*w2i + 2*w3r*w3i*w2r*w1r*rhogsol - 2*w3r*w3i*w2i*rhogsol*w1i -& w3r*k*Kdrag*vgsol*w2r - w3r*k*Kdrag*vgsol*w1r + w3r*rhogsol*w2i*w1i**2 + w3r*rhogsol*w2i*w1r**2 +& w3r*rhogsol*w2r**2*w1i + w3r*rhogsol*w1i*w2i**2 + w3r**2*k*Kdrag*vgsol - w3r**2*k*Kdrag*vdsol -& w3r**2*rhogsol*w2i*w1r + 2*w3i*w2r*k*rhogeq*w1r*vgsol + 2*w3i*k*w2i*rhogeq*w1i*vgsol -& 2*w3r*w3i*w2r*vgsol*k*rhogeq - 2*w3r*w3i*k*rhogeq*w1r*vgsol)/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i& + w3r**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r) rhog3i = - ( - rhogsol*w1i**2*w2r**2 - rhogsol*w1i**2*w2i**2 - rhogsol*w1r**2*w2r**2 - rhogsol*w1r**2*w2i**2 -& 2*w3r*rhogeq*k*vgsol*w2i*w1i + rhogsol*w2i**2*w3i*w1i + rhogsol*k**2*cs**2*w1r*w3r - rhogsol*k**2*cs**2*w3i*w1i& - vgsol*k*rhogeq*w3r*w2i**2 - vgsol*Kdrag*k*w3r*w1i - vgsol*Kdrag*k*w3r*w2i + 2*w3r*rhogeq*k*vgsol*w3i*w1i +& rhogsol*w1i**2*w2i*w3i + rhogsol*w1i*w2i*w3r**2 + rhogsol*w2i*w3i*w1r**2 - rhogsol*w1i*w2i*w3i**2 +& rhogsol*w2i**2*w3r*w1r - rhogsol*k**2*cs**2*w2i*w3i - vgsol*k*rhogeq*w3r*w1i**2 + w3r*rhogsol*k**2*cs**2*w2r -& 2*w3r*w2r*k*rhogeq*w1r*vgsol + w3r**2*w2r*vgsol*k*rhogeq - w3r*w2r**2*rhogeq*k*vgsol -& vgsol*k*rhogeq*w3r*w1r**2 + vgsol*k*rhogeq*w3r**2*w1r + vdsol*Kdrag*k*w3r*w1i - vdsol*Kdrag*k*w2i*w1r +& vdsol*Kdrag*k*w3r*w2i + vdsol*Kdrag*k*w3i*w1r + rhogsol*k**2*cs**2*w1i*w2i + vgsol*Kdrag*k*w2i*w1r -& vgsol*Kdrag*k*w3i*w1r - vgsol*k*rhogeq*w1r*w3i**2 + vgsol*k*rhogeq*w2i**2*w1r - rhogsol*k**2*cs**2*w2r*w1r -& w3r**2*w2r*w1r*rhogsol + w3r*w2r*rhogsol*w1i**2 + w3r*w2r*w1r**2*rhogsol + w3r*w2r**2*w1r*rhogsol -& 2*w3r*w1r*rhogsol*w2i*w3i + 2*vgsol*Kdrag*k*w3i*w3r - 2*vdsol*Kdrag*k*w3i*w3r - w3r**2*rhogsol*k**2*cs**2 +& 2*w3r*rhogeq*k*vgsol*w2i*w3i + rhogsol*k**2*cs**2*w3i**2 - 2*w2r*rhogsol*w3i*w1i*w3r +& vgsol*k*rhogeq*w2r*w1r**2 + vgsol*k*rhogeq*w1r*w2r**2 + vgsol*k*rhogeq*w2r*w1i**2 - vgsol*k*rhogeq*w2r*w3i**2 +& vgsol*Kdrag*k*w1i*w2r - vgsol*Kdrag*k*w2r*w3i + rhogsol*w2r**2*w3i*w1i + rhogsol*w2r*w1r*w3i**2 +& vdsol*Kdrag*k*w2r*w3i - vdsol*Kdrag*k*w1i*w2r)/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i +& w3r**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r) rhog2r =( - w3r**2*k*rhogeq*vgsol*w1i + w3r**2*w2i*rhogeq*k*vgsol + w3r**2*w2r*w1i*rhogsol +& w3i**2*w2i*rhogeq*k*vgsol + w3i**2*w2r*w1i*rhogsol + w3i*w1i**2*w2r*rhogsol + w3i*w2i**2*w1r*rhogsol -& w3i*w2r**2*w1r*rhogsol + w3i*w2r*w1r**2*rhogsol + 2*rhogsol*w3r*w2i*w1r*w2r + 2*cs**2*k**2*rhogsol*w2r*w2i -& k*Kdrag*vgsol*w2i**2 + k*Kdrag*vgsol*w2r**2 - 2*rhogsol*w2r*w2i*w3i*w1i + k*Kdrag*vdsol*w2i**2 -& k*Kdrag*vdsol*w2r**2 - 2*vgsol*rhogeq*k*w3r*w2r*w2i - 2*vgsol*rhogeq*k*w2i*w1r*w2r +& 2*vgsol*rhogeq*k*w3r*w2i*w1r - w3i**2*rhogsol*w2i*w1r + w3i*w1i*k*Kdrag*vdsol - k*Kdrag*vdsol*w2i*w1i +& k*Kdrag*vgsol*w2i*w1i - w3i*w1i**2*k*rhogeq*vgsol - w3i*w1r**2*rhogeq*k*vgsol + w3i*w1r*cs**2*k**2*rhogsol -& w3i*w2i*k*Kdrag*vdsol - w3i*w1i*k*Kdrag*vgsol + w3i*w2i*k*Kdrag*vgsol + w3i*w2r**2*rhogeq*k*vgsol +& k*Kdrag*vdsol*w2r*w1r + k*rhogeq*vgsol*w2r**2*w1i - w3i*w2r*cs**2*k**2*rhogsol - w3i*w2i**2*rhogeq*k*vgsol -& k*Kdrag*vgsol*w2r*w1r + k*rhogeq*vgsol*w2i*w1r**2 - rhogsol*k**2*cs**2*w2i*w1r - rhogsol*k**2*cs**2*w1i*w2r -& k*rhogeq*vgsol*w1i*w2i**2 - w3i**2*k*rhogeq*vgsol*w1i + k*rhogeq*vgsol*w2i*w1i**2 + w3r*k*Kdrag*vdsol*w2r +& w3r*rhogsol*k**2*cs**2*w1i - w3r*k*Kdrag*vdsol*w1r - w3r*rhogsol*k**2*cs**2*w2i - w3r*k*Kdrag*vgsol*w2r +& w3r*k*Kdrag*vgsol*w1r - w3r*rhogsol*w2i*w1i**2 - w3r*rhogsol*w2i*w1r**2 - w3r*rhogsol*w2r**2*w1i +& w3r*rhogsol*w1i*w2i**2 - w3r**2*rhogsol*w2i*w1r + 2*w3i*k*w2i*rhogeq*w1i*vgsol)/(w2r**2 - 2*w3r*w2r + w2i**2 +& w3i**2 - 2*w2i*w3i + w3r**2)/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2) rhog2i =( - 2*w2i*w2r*vgsol*k*rhogeq*w1i + 2*w3r*w2i*rhogsol*w1i*w2r - 2*w2i*k*rhogeq*vgsol*w2r*w3i +& rhogsol*w2i**2*w3i*w1i + rhogsol*k**2*cs**2*w1r*w3r - rhogsol*k**2*cs**2*w3i*w1i + vgsol*k*rhogeq*w3r*w2i**2 -& vgsol*Kdrag*k*w3r*w1i + vgsol*Kdrag*k*w3r*w2i - rhogsol*w1i**2*w2i*w3i - rhogsol*w1i*w2i*w3r**2 -& rhogsol*w2i*w3i*w1r**2 - rhogsol*w1i*w2i*w3i**2 - rhogsol*w2i**2*w3r*w1r + rhogsol*k**2*cs**2*w2i*w3i -& vgsol*k*rhogeq*w3r*w1i**2 - w3r*rhogsol*k**2*cs**2*w2r + 2*w3r*w2r*k*rhogeq*w1r*vgsol +& w3r**2*w2r*vgsol*k*rhogeq - w3r*w2r**2*rhogeq*k*vgsol - vgsol*k*rhogeq*w3r*w1r**2 - vgsol*k*rhogeq*w3r**2*w1r +& vdsol*Kdrag*k*w3r*w1i - vdsol*Kdrag*k*w2i*w1r - vdsol*Kdrag*k*w3r*w2i + vdsol*Kdrag*k*w3i*w1r +& rhogsol*k**2*cs**2*w1i*w2i + vgsol*Kdrag*k*w2i*w1r - vgsol*Kdrag*k*w3i*w1r - vgsol*k*rhogeq*w1r*w3i**2 +& vgsol*k*rhogeq*w2i**2*w1r - rhogsol*k**2*cs**2*w2r*w1r - w3r**2*w2r*w1r*rhogsol - w3r*w2r*rhogsol*w1i**2 -& w3r*w2r*w1r**2*rhogsol + w3r*w2r**2*w1r*rhogsol + rhogsol*w3r**2*w1i**2 + rhogsol*w3r**2*w1r**2 +& rhogsol*w1i**2*w3i**2 + vgsol*k*rhogeq*w2r*w1r**2 - vgsol*k*rhogeq*w1r*w2r**2 + vgsol*k*rhogeq*w2r*w1i**2 +& rhogsol*w3i**2*w1r**2 - w2i**2*rhogsol*k**2*cs**2 + vgsol*k*rhogeq*w2r*w3i**2 + vgsol*Kdrag*k*w1i*w2r +& vgsol*Kdrag*k*w2r*w3i + w2r**2*rhogsol*k**2*cs**2 + 2*w2i*k*Kdrag*vdsol*w2r + 2*w2i*rhogsol*w3i*w2r*w1r -& 2*w2i*k*Kdrag*vgsol*w2r + 2*w2r*w3i*k*rhogeq*w1i*vgsol - rhogsol*w2r**2*w3i*w1i - rhogsol*w2r*w1r*w3i**2 -& vdsol*Kdrag*k*w2r*w3i - vdsol*Kdrag*k*w1i*w2r)/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i +& w3r**2)/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2) rhog1r = - ( - w3r**2*k*rhogeq*vgsol*w1i - 2*rhogsol*k**2*cs**2*w1i*w1r + 2*k*rhogeq*vgsol*w1i*w2r*w1r +& 2*rhogsol*w2i*w1r*w3i*w1i + 2*w3r*k*rhogeq*vgsol*w1i*w1r - 2*w3r*w2r*k*rhogeq*vgsol*w1i -& 2*w3r*w2r*w1i*rhogsol*w1r + w3r**2*w2i*rhogeq*k*vgsol + w3r**2*w2r*w1i*rhogsol + w3i**2*w2i*rhogeq*k*vgsol +& w3i**2*w2r*w1i*rhogsol - w3i*w1i**2*w2r*rhogsol - w3i*w2i**2*w1r*rhogsol - w3i*w2r**2*w1r*rhogsol +& w3i*w2r*w1r**2*rhogsol - w3i**2*rhogsol*w2i*w1r + w3i*w1i*k*Kdrag*vdsol + k*Kdrag*vdsol*w2i*w1i -& k*Kdrag*vgsol*w2i*w1i + w3i*w1i**2*k*rhogeq*vgsol - w3i*w1r**2*rhogeq*k*vgsol + w3i*w1r*cs**2*k**2*rhogsol -& w3i*w2i*k*Kdrag*vdsol - w3i*w1i*k*Kdrag*vgsol + w3i*w2i*k*Kdrag*vgsol + w3i*w2r**2*rhogeq*k*vgsol -& k*Kdrag*vdsol*w2r*w1r - k*rhogeq*vgsol*w2r**2*w1i - w3i*w2r*cs**2*k**2*rhogsol + w3i*w2i**2*rhogeq*k*vgsol +& k*Kdrag*vgsol*w2r*w1r - k*rhogeq*vgsol*w2i*w1r**2 + rhogsol*k**2*cs**2*w2i*w1r + rhogsol*k**2*cs**2*w1i*w2r -& k*rhogeq*vgsol*w1i*w2i**2 - w3i**2*k*rhogeq*vgsol*w1i + k*rhogeq*vgsol*w2i*w1i**2 + w3r*k*Kdrag*vdsol*w2r +& w3r*rhogsol*k**2*cs**2*w1i - w3r*k*Kdrag*vdsol*w1r - w3r*rhogsol*k**2*cs**2*w2i - w3r*k*Kdrag*vgsol*w2r +& w3r*k*Kdrag*vgsol*w1r - Kdrag*w1r**2*k*vgsol - w3r*rhogsol*w2i*w1i**2 + w3r*rhogsol*w2i*w1r**2 +& Kdrag*w1i**2*k*vgsol + w3r*rhogsol*w2r**2*w1i + w3r*rhogsol*w1i*w2i**2 + k*Kdrag*vdsol*w1r**2 -& w3r**2*rhogsol*w2i*w1r - k*Kdrag*vdsol*w1i**2 - 2*w3i*k*w2i*rhogeq*w1i*vgsol)/(w1i**2 - 2*w3i*w1i + w3r**2 +& w1r**2 + w3i**2 - 2*w3r*w1r)/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2) rhog1i = - ( - 2*vdsol*Kdrag*k*w1i*w1r + rhogsol*w2i**2*w3i*w1i + rhogsol*k**2*cs**2*w1i**2 -& rhogsol*k**2*cs**2*w1r**2 + rhogsol*k**2*cs**2*w1r*w3r - rhogsol*k**2*cs**2*w3i*w1i + vgsol*k*rhogeq*w3r*w2i**2& + 2*vgsol*Kdrag*k*w1i*w1r - vgsol*Kdrag*k*w3r*w1i + vgsol*Kdrag*k*w3r*w2i - rhogsol*w1i**2*w2i*w3i +& rhogsol*w1i*w2i*w3r**2 - 2*rhogsol*w1i*w2i*w3r*w1r + rhogsol*w2i*w3i*w1r**2 + rhogsol*w1i*w2i*w3i**2 +& rhogsol*w2i**2*w3r*w1r + rhogsol*k**2*cs**2*w2i*w3i - vgsol*k*rhogeq*w3r*w1i**2 - w3r*rhogsol*k**2*cs**2*w2r -& 2*w3r*w2r*k*rhogeq*w1r*vgsol + w3r**2*w2r*vgsol*k*rhogeq + w3r*w2r**2*rhogeq*k*vgsol +& vgsol*k*rhogeq*w3r*w1r**2 + 2*vgsol*k*rhogeq*w1r*w2i*w1i - vgsol*k*rhogeq*w3r**2*w1r + vdsol*Kdrag*k*w3r*w1i +& vdsol*Kdrag*k*w2i*w1r - vdsol*Kdrag*k*w3r*w2i + vdsol*Kdrag*k*w3i*w1r - w3r**2*rhogsol*w2r**2 -& rhogsol*k**2*cs**2*w1i*w2i - vgsol*Kdrag*k*w2i*w1r - vgsol*Kdrag*k*w3i*w1r + 2*vgsol*k*rhogeq*w1i*w1r*w3i -& vgsol*k*rhogeq*w1r*w3i**2 - 2*vgsol*k*rhogeq*w2i*w1r*w3i - vgsol*k*rhogeq*w2i**2*w1r +& rhogsol*k**2*cs**2*w2r*w1r + w3r**2*w2r*w1r*rhogsol + w3r*w2r*rhogsol*w1i**2 - w3r*w2r*w1r**2*rhogsol +& w3r*w2r**2*w1r*rhogsol + vgsol*k*rhogeq*w2r*w1r**2 - vgsol*k*rhogeq*w1r*w2r**2 - vgsol*k*rhogeq*w2r*w1i**2 -& rhogsol*w2i**2*w3i**2 - rhogsol*w2i**2*w3r**2 + vgsol*k*rhogeq*w2r*w3i**2 - vgsol*Kdrag*k*w1i*w2r +& vgsol*Kdrag*k*w2r*w3i - 2*rhogsol*w2r*w1r*w3i*w1i + rhogsol*w2r**2*w3i*w1i + rhogsol*w2r*w1r*w3i**2 -& vdsol*Kdrag*k*w2r*w3i + vdsol*Kdrag*k*w1i*w2r - rhogsol*w2r**2*w3i**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 +& w3i**2 - 2*w3r*w1r)/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2) !------------------------------- ! D U S T D E N S I T I E S !------------------------------- if (Kdrag.gt.0.) then rhod3r = - rhodeq*( - w3r**3*rhogeq*w1i**2*w2r**2*rhogsol - w3r**2*Kdrag**2*k*vgsol*w2r*w1r +& w3r**2*Kdrag**2*k*vgsol*w2i*w1i - w3r**2*Kdrag**2*k*vdsol*w2i*w1i + w3r**2*Kdrag*k*rhogeq*vgsol*w2i*w1i**2 +& w3r**2*Kdrag**2*k*vdsol*w2r*w1r - w3r**2*Kdrag*rhogsol*k**2*cs**2*w2i*w1r +& w3r**2*Kdrag*k*rhogeq*vgsol*w2i*w1r**2 - w3r**2*Kdrag*rhogsol*k**2*cs**2*w1i*w2r +& w3r**2*rhogeq**2*w2i*w1i**2*w3i*k*vgsol - 4*w3r**2*rhogeq**2*w3i**2*k*w2i*w1i*vgsol -& 2*w3r**2*rhogeq*w2i*w3i**2*k*Kdrag*vgsol + w3r**2*rhogeq*w2r*w3i*w1r*k*Kdrag*vdsol -& 2*w3r**2*rhogeq**2*w1i**2*k*vgsol*w3i**2 - w3r**2*rhogeq*w2i*w3i*w1i*k*Kdrag*vgsol +& w3r**5*rhogeq*w2i*rhogsol*w1i + w3r**2*rhogeq**2*w2i*k*vgsol*w3i*w1r**2 - w3r**5*rhogeq*rhogsol*k**2*cs**2 -& w3r**5*rhogeq*w2r*w1r*rhogsol + w3r**5*rhogeq**2*k*w1r*vgsol + 3*w3r**2*rhogeq*cs**2*k**3*w3i*Kdrag*vdsol +& w3r**5*rhogeq**2*w2r*vgsol*k + 2*w3r**2*rhogeq*w3i**2*cs**2*k**2*rhogsol*w1r -& w3r**2*rhogeq*cs**4*k**4*w2r*rhogsol - 2*w3r**2*rhogeq**2*w3i**2*k*w1r**2*vgsol +& 2*w3r**2*rhogeq*w2r*w3i**2*cs**2*k**2*rhogsol - w3r*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i**2 -& w3r**3*Kdrag*rhogsol*w2i*w1i**2 - w3r**3*Kdrag*rhogsol*w2r**2*w1i - w3r**3*Kdrag*rhogsol*w1i*w2i**2 -& w3r**3*Kdrag*rhogsol*w2i*w1r**2 - w3r**3*rhogeq*w2r*w1i*k*Kdrag*vdsol + w3r**3*rhogeq**2*w2r*w1r**2*k*vgsol +& w3r**3*rhogeq**2*w2r*w1i**2*k*vgsol - w3r**3*rhogeq**2*cs**2*k**3*w1r*vgsol +& w3r**3*rhogeq*w2r*w1i*k*Kdrag*vgsol - w3r**3*Kdrag**2*k*vdsol*w2r + 2*w3r**3*Kdrag*k*rhogeq*vgsol*w3i*w1r +& 2*w3r**3*rhogeq**2*w2r*k*vgsol*w3i**2 + 2*w3r**3*Kdrag*k*rhogeq*vgsol*w2r*w3i +& w3r**3*Kdrag*rhogsol*k**2*cs**2*w1i - w3r**3*rhogeq**2*cs**2*k**3*w2r*vgsol -& 2*w3r**3*Kdrag*rhogsol*k**2*cs**2*w3i + w3r**3*Kdrag*rhogsol*k**2*cs**2*w2i +& 2*w3r**3*Kdrag*rhogsol*w2i*w3i*w1i - w3r**3*rhogeq*w2i**2*w1i**2*rhogsol - 2*w3r**3*Kdrag*rhogsol*w3i*w2r*w1r -& w3r**2*rhogeq*w2i*w3i*w1i*k*Kdrag*vdsol - w3r**3*rhogeq*w1r**2*w2i**2*rhogsol -& w3r**2*rhogeq*cs**4*k**4*w1r*rhogsol - 3*w3r**2*rhogeq**2*cs**2*k**3*w3i*w1i*vgsol -& 3*w3r**2*rhogeq*cs**2*k**3*w3i*Kdrag*vgsol - w3r**2*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol -& w3r**2*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol + w3r**2*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol +& w3r**2*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol - w3r**3*rhogeq*w2r**2*w1r**2*rhogsol +& w3r**2*rhogeq**2*w2i**2*w3i*w1i*k*vgsol + w3r**2*rhogeq**2*cs**2*k**3*w1i**2*vgsol +& w3r**3*rhogeq*cs**4*k**4*rhogsol - 3*w3r**2*rhogeq**2*cs**2*k**3*w3i*w2i*vgsol +& 2*w3r**2*rhogeq*w2r*w3i**2*w1r**2*rhogsol + w3r**2*rhogeq**2*cs**2*k**3*w1r**2*vgsol -& 2*w3r**2*rhogeq**2*w3i**2*w2i**2*k*vgsol + 2*w3r**2*rhogeq*w2i**2*w3i**2*w1r*rhogsol +& w3r**2*rhogeq**2*w3i*w2r**2*w1i*k*vgsol + 2*w3r**2*rhogeq*w1i*w3i**2*k*Kdrag*vdsol +& 2*w3r**2*rhogeq*w1i**2*w3i**2*w2r*rhogsol - 2*w3r**2*rhogeq*w1i*w3i**2*k*Kdrag*vgsol +& 2*w3r**2*rhogeq*w2r**2*w3i**2*w1r*rhogsol - 4*w3r**2*rhogeq**2*w2r*w3i**2*k*w1r*vgsol -& 3*w3r**2*rhogeq*w2r*w3i*w1r*k*Kdrag*vgsol - 2*w3r**2*rhogeq**2*w2r**2*w3i**2*k*vgsol +& 2*w3r**2*rhogeq*w2i*w3i**2*k*Kdrag*vdsol + w3r**3*rhogeq**2*w2r**2*k*w1r*vgsol -& 2*w3r**3*rhogeq*w3i**2*cs**2*k**2*rhogsol + w3r**4*rhogeq*w2i**2*w1r*rhogsol + w3r**4*Kdrag*rhogsol*w1i*w2r +& w3r**4*rhogeq*w2r*w1r**2*rhogsol + w3r**4*rhogeq*w1i**2*w2r*rhogsol - 2*w3r**4*rhogeq**2*k*w2i*w1i*vgsol -& 2*w3r**4*rhogeq*w1i*k*Kdrag*vgsol - w3r**4*rhogeq**2*w2r**2*k*vgsol + w3r**4*rhogeq*w1i*k*Kdrag*vdsol -& w3r**4*rhogeq**2*w1r**2*k*vgsol + w3r**4*rhogeq*w1r*cs**2*k**2*rhogsol + w3r**4*rhogeq*w2r*cs**2*k**2*rhogsol -& 2*w3r**4*rhogeq*w2i*k*Kdrag*vgsol - w3r**4*rhogeq**2*w1i**2*k*vgsol + w3r**4*rhogeq*w2r**2*w1r*rhogsol +& w3r**3*rhogeq*w2i*w1r*k*Kdrag*vgsol + w3r**4*Kdrag**2*k*vdsol + 2*w3r**3*rhogeq*w1i*w3i**2*rhogsol*w2i -& 2*w3r**4*rhogeq**2*w2r*k*w1r*vgsol + 2*w3r**3*rhogeq**2*w3i**2*k*w1r*vgsol -& w3r**3*rhogeq*w2i*w1r*k*Kdrag*vdsol + w3r**3*rhogeq**2*w2i**2*w1r*k*vgsol -& 2*w3r**3*rhogeq*w2r*w3i**2*w1r*rhogsol + w3r**4*rhogeq*w2i*k*Kdrag*vdsol - w3r**4*rhogeq**2*w2i**2*k*vgsol +& w3r**3*Kdrag**2*k*vgsol*w1r + w3r**4*Kdrag*rhogsol*w2i*w1r - w3r**4*Kdrag**2*k*vgsol -& w3r**3*Kdrag**2*k*vdsol*w1r + w3r**3*Kdrag**2*k*vgsol*w2r + w1i*w3i**3*k*Kdrag**2*vdsol +& 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r + w3r*rhogeq**2*w3i**4*w2r*k*vgsol +& 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r - 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r -& 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r + w3r*rhogeq**2*w3i**4*k*w1r*vgsol -& w3r*rhogeq*w3i**4*w2r*w1r*rhogsol + 2*w3r*w3i*cs**4*k**4*rhogeq*rhogsol*w2i + w3r*rhogeq*w3i**4*w1i*rhogsol*w2i& - w2i*w3i**3*k*Kdrag**2*vgsol + 2*w3r*rhogeq*w3i**3*k*Kdrag*vgsol*w2r + w2i*w3i**3*k*Kdrag**2*vdsol -& w1i*w3i**3*k*Kdrag**2*vgsol - w3r*rhogeq*w3i**4*cs**2*k**2*rhogsol -& 2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w1i*w2i**2 - 2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1i) !--break to avoid too many continuation lines rhod3r = rhod3r - rhodeq*( & 2*w3r*w3i**3*Kdrag*rhogsol*w2i*w1i - 2*w3r*w3i**3*Kdrag*rhogsol*w2r*w1r - 2*w3r*w3i**3*Kdrag*rhogsol*k**2*cs**2& + w3r*w3i**2*Kdrag**2*k*vgsol*w1r + 2*w3r*w3i*cs**4*k**4*rhogeq*rhogsol*w1i +& w3r*rhogeq*cs**2*k**2*w1i**2*w2r**2*rhogsol + w3r*rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol -& w3r*rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol + w3r**2*rhogeq**2*cs**2*k**3*w2r**2*vgsol +& w3r**2*rhogeq*w2r**2*w1i*k*Kdrag*vgsol - 2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w1i**2 -& 2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w1r**2 + w1r*w3i**2*cs**2*k**2*rhogeq*rhogsol*w2i**2 -& w1r*w3r**2*cs**2*k**2*rhogeq*rhogsol*w2i**2 - w2r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r**2 -& w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol + w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol -& w2r*w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol - w2r*w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol +& w2r*w3r*rhogeq*cs**4*k**4*w1r*rhogsol + 2*w2r*w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol +& rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r*w1r - w3r*w3i**2*rhogeq*w2i*w1r*k*Kdrag*vdsol +& 3*w3r*w3i**2*rhogeq**2*cs**2*k**3*w2r*vgsol + w3r*w3i**2*Kdrag*rhogsol*k**2*cs**2*w1i +& 2*w3r*rhogeq*w3i**3*k*Kdrag*vgsol*w1r + rhogeq*w3i**2*cs**2*k**2*rhogsol*w1r*w2r**2 -& w3r**2*rhogeq*rhogsol*k**2*cs**2*w2r**2*w1r - w2r*w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2 +& rhogeq*w2r*w3i**2*cs**2*k**2*rhogsol*w1r**2 - w3r*w3i**2*Kdrag*rhogsol*w2r**2*w1i -& w3r*w3i**2*Kdrag**2*k*vdsol*w2r + w3r*w3i**2*Kdrag**2*k*vgsol*w2r - rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r*w1r +& rhogeq**2*cs**2*k**3*w3i*w1i*vgsol*w2r**2 - w3r*w3i**2*Kdrag*rhogsol*w2i*w1r**2 +& w3r*w3i**2*Kdrag*rhogsol*k**2*cs**2*w2i - w3r*w3i**2*Kdrag*rhogsol*w1i*w2i**2 -& 2*w3i**2*cs**2*k**3*rhogeq**2*vgsol*w2r*w1r - w3i**2*cs**2*k**3*rhogeq**2*vgsol*w2r**2 -& w3r*w3i**2*Kdrag*rhogsol*w2i*w1i**2 - w3i*rhogsol*k**4*cs**4*rhogeq*w2r*w1i +& rhogeq*cs**2*k**2*w1i**2*w2r*rhogsol*w3i**2 + Kdrag*k*rhogeq*vgsol*w2r**2*w1i*w3i**2 -& w3r*w3i**2*Kdrag**2*k*vdsol*w1r - rhogeq*w3i**5*w2r*w1i*rhogsol + w3r*w3i**2*rhogeq*w2r*w1i*k*Kdrag*vgsol +& w3r*w3i**2*rhogeq**2*w2r*w1i**2*k*vgsol + w3r*w3i**2*rhogeq*w2i*w1r*k*Kdrag*vgsol -& w3r*w3i**2*rhogeq*w2i**2*w1i**2*rhogsol + w3r*w3i**2*rhogeq**2*w2r**2*k*w1r*vgsol -& w3r*w3i**2*rhogeq*w1r**2*w2i**2*rhogsol - w3r*w3i**2*rhogeq*w2r**2*w1r**2*rhogsol -& 3*w3r*w3i**2*rhogeq*cs**4*k**4*rhogsol + w3r*w3i**2*rhogeq**2*w2i**2*w1r*k*vgsol -& 4*cs**2*k**2*rhogeq*w3r*w3i**2*w2r*w1r*rhogsol - rhogeq**2*w3i**4*w1i**2*k*vgsol -& cs**2*k**3*rhogeq*w3i**3*Kdrag*vdsol - w3r*w3i**2*rhogeq*w1i**2*w2r**2*rhogsol +& cs**2*k**3*rhogeq*w3i**3*Kdrag*vgsol + 3*w3r*w3i**2*rhogeq**2*cs**2*k**3*w1r*vgsol -& w3r*w3i**2*rhogeq*w2r*w1i*k*Kdrag*vdsol + w3r*w3i**2*rhogeq**2*w2r*w1r**2*k*vgsol +& 4*cs**2*k**2*rhogeq*w3r*w3i**2*w2i*rhogsol*w1i - rhogeq**2*w3i**4*k*w1r**2*vgsol +& 2*rhogeq*w3i**3*w3r**2*k*Kdrag*vgsol + 2*rhogeq**2*w3i**3*w3r**2*w1i*k*vgsol +& rhogeq*w3i**4*cs**2*k**2*rhogsol*w1r - 2*rhogeq*w3i**3*w3r**2*k*Kdrag*vdsol +& rhogeq*w3i**4*w2r*cs**2*k**2*rhogsol - 2*rhogeq**2*w3i**4*k*w2i*w1i*vgsol - rhogeq*w3i**3*w2i*w1i*k*Kdrag*vdsol& + rhogeq**2*w3i**3*w2i*w1i**2*k*vgsol + Kdrag*w2i**2*vgsol*k*rhogeq*w1i*w3r**2 -& w3i**2*rhogeq**2*cs**2*k**3*vgsol*w2i**2 + 2*w3r**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i -& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i*w1i - rhogeq**2*w3i**4*w2r**2*k*vgsol +& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w1i + w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1r**2 +& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**2 + rhogeq*w3i**4*w1i**2*w2r*rhogsol - rhogeq**2*w3i**4*w2i**2*k*vgsol) !--break to avoid too many continuation lines rhod3r = rhod3r - rhodeq*( & rhogeq**2*w3i**5*w2i*k*vgsol + rhogeq*w3i**3*w2r*w1r*k*Kdrag*vdsol + rhogeq*w3i**4*w2i*k*Kdrag*vdsol +& rhogeq**2*w3i**3*w2i*k*vgsol*w1r**2 - 2*rhogeq**2*w3i**4*w2r*k*w1r*vgsol +& w3r*rhogeq*cs**2*k**2*w1r**2*rhogsol*w2i**2 + w3r*rhogeq*cs**2*k**2*w1i**2*rhogsol*w2i**2 -& 2*rhogeq*w3i**3*w3r**2*w2i*w1r*rhogsol - 2*rhogeq*w3i**3*w2r*w3r**2*rhogsol*w1i +& w3r**2*rhogeq**2*cs**2*k**3*vgsol*w2i**2 - w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w1r -& w3r*rhogeq*cs**4*k**4*rhogsol*w2i*w1i + 2*rhogeq**2*w3i**3*w3r**2*w2i*k*vgsol +& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w1r - w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w1r +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i*w1i + Kdrag*w3i**3*cs**2*k**2*rhogsol*w1r +& rhogeq*w3i**4*w2i**2*w1r*rhogsol - Kdrag*w3i**3*k*rhogeq*w1r**2*vgsol + Kdrag*w2r*w3i**3*cs**2*k**2*rhogsol -& rhogeq*w3i**5*w1r*w2i*rhogsol - Kdrag*w1r*w2i*w3i**4*rhogsol - rhogeq*w3i**5*k*Kdrag*vdsol +& rhogeq*w3i**5*k*Kdrag*vgsol - 2*w3i**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i + rhogeq**2*w3i**5*w1i*k*vgsol +& rhogeq*w3i**4*w2r**2*w1r*rhogsol + rhogeq*w3i**4*w1i*k*Kdrag*vdsol - Kdrag*w1i**2*rhogeq*k*vgsol*w3i**3 +& rhogeq*w3i**4*w2r*w1r**2*rhogsol - Kdrag*w2r*w1i*w3i**4*rhogsol + w3i**4*k*Kdrag**2*vgsol -& w3i**4*k*Kdrag**2*vdsol + w3i**3*rhogeq**2*k*vgsol*w2r**2*w1i - w3i**2*Kdrag**2*k*vgsol*w2r*w1r +& w3i**3*Kdrag*rhogsol*w2r*w1r**2 + w3i**3*Kdrag*rhogsol*w2r*w1i**2 + w3i**2*Kdrag**2*k*vdsol*w2r*w1r +& w3i**3*cs**2*k**3*rhogeq**2*vgsol*w1i - w3i**2*Kdrag*cs**2*k**2*rhogsol*w2r*w1i +& w3i**3*Kdrag*rhogsol*w2r**2*w1r + w3i**2*rhogeq*cs**4*k**4*rhogsol*w2r -& 2*w3i**3*cs**2*k**2*rhogeq*rhogsol*w2r*w1i - w3i**3*Kdrag*rhogeq*k*vgsol*w2r**2 -& 3*w3i**3*Kdrag*rhogeq*k*vgsol*w2r*w1r - w3i**3*Kdrag*rhogeq*k*vgsol*w2i**2 -& w3i**2*rhogeq**2*cs**2*k**3*vgsol*w1i**2 + w3i**2*rhogeq*k*Kdrag*vgsol*w1i**2*w2i -& w3i**2*rhogeq**2*cs**2*k**3*vgsol*w1r**2 + w3i**2*rhogeq*k*Kdrag*vgsol*w2i*w1r**2 -& w3i**3*Kdrag*rhogeq*k*vgsol*w1i*w2i - w3i**2*Kdrag**2*k*vdsol*w1i*w2i + w3i**2*Kdrag**2*k*vgsol*w1i*w2i -& w3i**2*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i - w3i**2*cs**2*k**3*rhogeq*Kdrag*vgsol*w1i +& w3i**3*Kdrag*rhogsol*w2i**2*w1r + w3i**2*rhogeq*cs**2*k**3*vdsol*Kdrag*w1i +& w3i**2*rhogeq*cs**2*k**3*vdsol*Kdrag*w2i - w3i**2*Kdrag*cs**2*k**2*rhogsol*w2i*w1r -& 2*w3i**3*rhogeq*cs**2*k**2*rhogsol*w2i*w1r + w3i**3*vgsol*k*rhogeq**2*w2i**2*w1i +& w3i**3*vgsol*rhogeq**2*k**3*cs**2*w2i + w3i**2*rhogeq*cs**4*k**4*rhogsol*w1r -& w3i*Kdrag*w3r**2*w1r**2*rhogeq*k*vgsol - w3i*Kdrag*w3r**2*w1i**2*k*rhogeq*vgsol -& w3i*w3r**2*w1i*k*Kdrag**2*vgsol + w3i*w3r**2*w1i*k*Kdrag**2*vdsol + w3i*Kdrag*w3r**2*w1r*cs**2*k**2*rhogsol +& w3i*Kdrag*w2r*w3r**2*cs**2*k**2*rhogsol + Kdrag*w2i**2*k*rhogeq*vgsol*w3i**2*w1i -& w3i*rhogeq*w3r**4*k*Kdrag*vdsol - w3i*rhogeq*w3r**4*rhogsol*w2i*w1r - w3i*rhogeq*w3r**4*rhogsol*w1i*w2r +& w3i*rhogeq**2*w3r**4*k*vgsol*w2i - w3i*w3r**2*Kdrag*rhogeq*k*vgsol*w2i**2 + w3i*w3r**2*Kdrag*rhogsol*w2r*w1r**2& - w3i*w3r**2*w2i*k*Kdrag**2*vgsol + w3i*w3r**2*w2i*k*Kdrag**2*vdsol + w3i*rhogeq*w3r**4*k*Kdrag*vgsol +& w3i*rhogeq**2*w3r**4*k*vgsol*w1i + w3i*w3r**2*Kdrag*rhogsol*w2r**2*w1r + w3i*w3r**2*Kdrag*rhogsol*w2r*w1i**2 +& w3i*w3r**2*Kdrag*rhogsol*w2i**2*w1r + 2*w3i*w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i -& w3i*w3r**2*Kdrag*rhogeq*k*vgsol*w2r**2 + 2*w3i*w3r**2*rhogeq*cs**2*k**2*rhogsol*w2i*w1r) rhod3r = rhod3r/(w3r**2 +& w3i**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r)/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 -& 2*w2i*w3i + w3r**2)/rhogeq/Kdrag rhod3i = - rhodeq*(w3r*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w1i + w2r*w3i*cs**2*k**3*rhogeq**2*vgsol*w1i**2 +& w2r*w3i*cs**2*k**3*rhogeq**2*vgsol*w1r**2 - w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1i +& rhogeq*w2r**2*w3i**2*cs**2*k**2*rhogsol*w1i - w3i**2*Kdrag*rhogsol*w2i**2*w1r**2 -& w3i**2*Kdrag*rhogsol*w2i**2*w1i**2 - w3r**2*Kdrag*rhogsol*w2i**2*w1i**2 +& rhogeq*w1i*rhogsol*k**2*cs**2*w3i**2*w2i**2 - w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1i**2 -& w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1r**2 - w2r*w3i*cs**4*k**4*rhogeq*rhogsol*w1r -& w2r*w3r*rhogeq*cs**4*k**4*rhogsol*w1i + w2r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1i +& rhogeq*w1i**2*rhogsol*k**2*cs**2*w3i**2*w2i - rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r**2*w2i +& w2r*w3r*rhogeq*cs**2*k**3*Kdrag*vdsol*w1r - w2r*w3r*rhogeq*cs**2*k**3*Kdrag*vgsol*w1r +& w3i*cs**4*k**4*rhogeq*rhogsol*w1i*w2i - w3i*cs**2*k**2*rhogeq*rhogsol*w2i**2*w1r**2 +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r*w2i - w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r*w2i -& rhogeq*w1i*rhogsol*k**2*cs**2*w3r**2*w2i**2 - w3i*cs**2*k**2*rhogeq*rhogsol*w2i**2*w1i**2 +& w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i + w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2i +& w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol*w2i - w3r*rhogeq*cs**4*k**4*w1r*rhogsol*w2i -& w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i + w3r**2*rhogeq*w2i**2*w1r*k*Kdrag*vgsol +& w3r**2*rhogeq*w1r*k*Kdrag*vgsol*w2r**2 - w3r**2*Kdrag*rhogsol*w1i**2*w2r**2 -& w3r**2*Kdrag*rhogsol*w2i**2*w1r**2 - w2r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1i -& w3i**2*Kdrag*rhogsol*w1r**2*w2r**2 - w3i**2*Kdrag*rhogsol*w1i**2*w2r**2 - w3r**2*Kdrag*rhogsol*w1r**2*w2r**2 +& w3i**2*rhogeq*w2i**2*w1r*k*Kdrag*vgsol + w3i**2*rhogeq*w1r*k*Kdrag*vgsol*w2r**2 -& w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2*w2i + w3i**2*cs**2*k**2*rhogeq*rhogsol*w1r**2*w2i +& rhogeq*w3r**4*rhogsol*w2r**2*w1i + rhogeq*w3r**4*rhogsol*w1i*w2i**2 + rhogeq*w3r**4*rhogsol*w2i*w1i**2 +& rhogeq*w3r**4*rhogsol*w2i*w1r**2 - w3r*rhogeq*w2r*w3i**2*w1r*k*Kdrag*vgsol - rhogeq**2*w3i**5*w2r*k*vgsol -& rhogeq**2*w3i**5*k*w1r*vgsol + rhogeq*w3i**5*w2r*w1r*rhogsol - w3i**2*cs**4*k**4*rhogeq*rhogsol*w2i +& 2*w3r**2*rhogeq*w3i**3*cs**2*k**2*rhogsol - 3*w3r*rhogeq*w2i*w3i**2*w1i*k*Kdrag*vgsol -& w3r*rhogeq*w2r*w3i**2*w1r*k*Kdrag*vdsol - 2*w3r**2*Kdrag*k*rhogeq*vgsol*w3i**2*w1r -& 2*w3r**2*Kdrag*k*rhogeq*vgsol*w2r*w3i**2 - 2*w3r**2*rhogeq**2*w2r*k*vgsol*w3i**3 +& 3*w3r*rhogeq**2*cs**2*k**3*w3i**2*w1i*vgsol + 3*w3r*rhogeq*cs**2*k**3*w3i**2*Kdrag*vgsol -& w3r*rhogeq**2*w2i**2*w3i**2*w1i*k*vgsol + 3*w3r*rhogeq**2*cs**2*k**3*w3i**2*w2i*vgsol -& w3r*rhogeq**2*w3i**2*w2r**2*w1i*k*vgsol + 2*w3r*rhogeq*w1i*w3i**3*k*Kdrag*vgsol -& w3r*rhogeq**2*w2i*w1i**2*w3i**2*k*vgsol + 2*w3r*rhogeq*w2i*w3i**3*k*Kdrag*vgsol -& w3r*rhogeq**2*w2i*k*vgsol*w3i**2*w1r**2 - 3*w3r*rhogeq*cs**2*k**3*w3i**2*Kdrag*vdsol -& w3i**3*rhogeq*w2i**2*w1i**2*rhogsol + w3i**2*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r -& w3i**3*rhogeq*w1r**2*w2i**2*rhogsol + w3i**3*rhogeq**2*w2r**2*k*w1r*vgsol + w3i**3*rhogeq**2*w2i**2*w1r*k*vgsol& + w3i**3*rhogeq*cs**4*k**4*rhogsol - rhogeq*w3i**5*w1i*rhogsol*w2i - w3i**4*Kdrag*rhogsol*w2i*w1i +& rhogeq*w3i**5*cs**2*k**2*rhogsol + w3i**4*Kdrag*rhogsol*w2r*w1r + w3i**2*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r +& w3i**4*Kdrag*rhogsol*k**2*cs**2 - w3i**2*cs**4*k**4*rhogeq*rhogsol*w1i - w3i**3*Kdrag**2*k*vgsol*w1r -& w3i**3*rhogeq**2*cs**2*k**3*w2r*vgsol + w3i**3*Kdrag*rhogsol*w2r**2*w1i - w3i**3*Kdrag*rhogsol*k**2*cs**2*w1i -& 2*rhogeq*w3i**4*k*Kdrag*vgsol*w1r - 2*w3r**2*rhogeq*w1i*w3i**3*rhogsol*w2i -& 2*w3r**2*rhogeq**2*w3i**3*k*w1r*vgsol + 2*w3r**2*rhogeq*w2r*w3i**3*w1r*rhogsol +& w3r*rhogeq*w2i*w3i**2*w1i*k*Kdrag*vdsol - w3i**3*rhogeq*w2i*w1r*k*Kdrag*vdsol -& w3i**3*Kdrag*rhogsol*k**2*cs**2*w2i - w3i**2*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r) !--break to avoid too many continuation lines rhod3i = rhod3i - rhodeq*( & w3i**3*Kdrag*rhogsol*w2i*w1i**2 - w3i**2*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r + w3i**3*Kdrag**2*k*vdsol*w1r +& w3i**3*rhogeq**2*w2r*w1i**2*k*vgsol - w3i**3*rhogeq*w2r**2*w1r**2*rhogsol - 2*rhogeq*w3i**4*k*Kdrag*vgsol*w2r -& Kdrag*w3r**4*rhogsol*k**2*cs**2 - w3i**3*Kdrag**2*k*vgsol*w2r - rhogeq*w3r**5*rhogsol*w2i*w1r +& w3i**3*Kdrag*rhogsol*w1i*w2i**2 + w3i**3*rhogeq*w2r*w1i*k*Kdrag*vgsol + Kdrag*w3r**4*w2i*rhogsol*w1i +& w3i**3*rhogeq*w2i*w1r*k*Kdrag*vgsol + rhogeq**2*w3i**4*w3r*w1i*k*vgsol - rhogeq*w3i**4*w3r*k*Kdrag*vdsol +& w3i**3*rhogeq**2*w2r*w1r**2*k*vgsol + w3i**3*Kdrag**2*k*vdsol*w2r + rhogeq*w3i**4*w3r*k*Kdrag*vgsol -& w3i**3*rhogeq**2*cs**2*k**3*w1r*vgsol - rhogeq*w3i**4*w2r*w3r*rhogsol*w1i - w3i**3*rhogeq*w1i**2*w2r**2*rhogsol& - rhogeq*w3i**4*w3r*w2i*w1r*rhogsol - w3i**3*rhogeq*w2r*w1i*k*Kdrag*vdsol - 2*w3r*w3i**3*k*Kdrag**2*vdsol +& 2*w3i**2*rhogeq**2*w3r**3*k*vgsol*w1i + 2*w3i**2*rhogeq*w3r**3*k*Kdrag*vgsol +& w3i**2*w3r*Kdrag*rhogsol*w2r*w1i**2 + w3i**2*w3r*Kdrag*rhogsol*w2r**2*w1r -& w3i**2*w3r*Kdrag*rhogeq*k*vgsol*w2r**2 + w3i**2*w3r*Kdrag*rhogsol*w2i**2*w1r -& 2*w3i**2*w3r*cs**2*k**2*rhogeq*rhogsol*w2r*w1i - 2*w3i**2*w3r*rhogeq*cs**2*k**2*rhogsol*w2i*w1r -& w3i*w3r**2*rhogeq*w1i**2*w2r**2*rhogsol + 2*w3i*w3r*rhogeq*cs**4*k**4*w2r*rhogsol -& w3i*w3r**4*rhogeq*w2i*rhogsol*w1i + w3i*w3r**4*rhogeq*rhogsol*k**2*cs**2 + w3i*w3r**4*rhogeq*w2r*w1r*rhogsol -& w3i*w3r**4*rhogeq**2*w2r*vgsol*k + rhogeq**2*w3i**4*w3r*w2i*k*vgsol - w3i*w3r**4*rhogeq**2*k*w1r*vgsol +& w3i*w3r**2*Kdrag*rhogsol*w2r**2*w1i + w3i*w3r**2*Kdrag*rhogsol*w2i*w1r**2 + w3i*w3r**2*Kdrag*rhogsol*w1i*w2i**2& + w3i*w3r**2*Kdrag**2*k*vdsol*w2r + w3i*w3r**2*rhogeq**2*w2r*w1r**2*k*vgsol +& w3i*w3r**2*rhogeq**2*w2r*w1i**2*k*vgsol + 3*w3i*w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol +& 2*w3i*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol - w3i*w3r**2*Kdrag*rhogsol*k**2*cs**2*w1i +& 3*w3i*w3r**2*rhogeq**2*cs**2*k**3*w2r*vgsol + 2*w3i*w3r*rhogeq*cs**4*k**4*w1r*rhogsol +& 2*w3i*w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol - w3i*w3r**2*Kdrag*rhogsol*k**2*cs**2*w2i -& w3i*w3r**2*rhogeq*w1r**2*w2i**2*rhogsol - w3i*w3r**2*rhogeq*w2i**2*w1i**2*rhogsol +& w3i**2*w3r*w1i*k*Kdrag**2*vdsol - w3i**2*Kdrag*w3r*w1r**2*rhogeq*k*vgsol -& w3i**2*Kdrag*w3r*w1i**2*k*rhogeq*vgsol + w3i**2*Kdrag*w3r*w1r*cs**2*k**2*rhogsol +& w3i**2*Kdrag*w2r*w3r*cs**2*k**2*rhogsol - w3i**2*w3r*w1i*k*Kdrag**2*vgsol -& 2*w3i**2*rhogeq*w3r**3*k*Kdrag*vdsol - 2*w3i**2*rhogeq*w3r**3*rhogsol*w2i*w1r -& 2*w3i**2*rhogeq*w3r**3*rhogsol*w1i*w2r + w3i**2*w3r*Kdrag*rhogsol*w2r*w1r**2 -& w3i**2*w3r*Kdrag*rhogeq*k*vgsol*w2i**2 - 2*w3i*w3r**3*Kdrag**2*k*vdsol - w3i**2*w3r*w2i*k*Kdrag**2*vgsol +& w3i**2*w3r*w2i*k*Kdrag**2*vdsol - w3i*w3r**2*Kdrag**2*k*vgsol*w1r + 2*w3i*w3r**3*rhogeq*w2i*k*Kdrag*vgsol -& 2*w3i*w3r**3*Kdrag*rhogsol*w2i*w1r + w3i*w3r**2*Kdrag**2*k*vdsol*w1r -& 2*w3i*w3r*rhogeq**2*cs**2*k**3*vgsol*w2i**2 - 2*w3i*w3r*rhogeq**2*cs**2*k**3*w2r**2*vgsol -& w3i*w3r**2*rhogeq*w2r**2*w1r**2*rhogsol - 2*w3i*w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol -& 2*w3i*w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol - 3*w3i*w3r**2*rhogeq*cs**4*k**4*rhogsol +& w3i*w3r**2*rhogeq**2*w2r**2*k*w1r*vgsol - w3i*w3r**2*rhogeq*w2r*w1i*k*Kdrag*vdsol -& 2*w3i*w3r**3*Kdrag*rhogsol*w1i*w2r + 2*w3i*w3r**3*rhogeq*w1i*k*Kdrag*vgsol) !--break to avoid too many continuation lines rhod3i = rhod3i - rhodeq*( & w3i*w3r**2*rhogeq*w2r*w1i*k*Kdrag*vgsol + w3i*w3r**2*Kdrag*rhogsol*w2i*w1i**2 +& rhogeq*rhogsol*w2r**2*w1i*w3i**4 - rhogeq*w3r**5*k*Kdrag*vdsol + rhogeq*w3r**3*k*Kdrag*vdsol*w2i*w1i -& rhogeq*w3r**3*k*Kdrag*vdsol*w2r*w1r + 2*rhogeq*w3r**2*rhogsol*w2r**2*w1i*w3i**2 +& w3i*w3r**2*rhogeq*w2i*w1r*k*Kdrag*vgsol + 2*rhogeq*w3r**2*rhogsol*w1i*w2i**2*w3i**2 +& 2*rhogeq*w3r**2*rhogsol*w2i*w1r**2*w3i**2 + 2*rhogeq*w3r**2*rhogsol*w2i*w1i**2*w3i**2 -& 2*Kdrag*w2r*w3r*w3i**3*rhogsol*w1i + rhogeq*w3r**4*k*Kdrag*vdsol*w2r + 2*rhogeq*w3r**2*k*Kdrag*vdsol*w2r*w3i**2& - Kdrag*w3r**3*w1r**2*rhogeq*k*vgsol - Kdrag*w3r**3*w1i**2*k*rhogeq*vgsol + Kdrag*w3r**3*w1r*cs**2*k**2*rhogsol& + Kdrag*w2r*w3r**3*cs**2*k**2*rhogsol + cs**2*k**3*rhogeq*w3r**3*Kdrag*vdsol +& w3i*w3r**2*rhogeq**2*w2i**2*w1r*k*vgsol - rhogeq**2*w3r**3*k*vgsol*w2i*w1r**2 -& rhogeq*rhogsol*k**2*cs**2*w3i**4*w2i + rhogeq**2*w3r**5*k*vgsol*w1i + rhogeq*w3r**5*k*Kdrag*vgsol -& w3i*w3r**2*rhogeq*w2i*w1r*k*Kdrag*vdsol - w3i*w3r**2*Kdrag**2*k*vgsol*w2r + rhogeq*rhogsol*w3i**4*w2i*w1r**2 +& 2*w3i*w3r**3*Kdrag**2*k*vgsol + w3i*rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol + rhogeq*rhogsol*w2i*w1i**2*w3i**4 +& rhogeq*k*Kdrag*vdsol*w2r*w3i**4 + 2*w3i*w1r*w3r*cs**2*k**2*rhogeq*rhogsol*w2i**2 + rhogeq**2*w3r**5*k*vgsol*w2i& + 2*rhogeq*w3r**2*k*Kdrag*vdsol*w3i**2*w1r - 2*w3i*w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol -& rhogeq*w3r**5*rhogsol*w1i*w2r + rhogeq*k*Kdrag*vdsol*w3i**4*w1r - 2*rhogeq*w3r**2*rhogsol*k**2*cs**2*w3i**2*w1i& - 2*w3i*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol - Kdrag*w2r*w3r**4*w1r*rhogsol + w3r**3*Kdrag*rhogsol*w2r**2*w1r& + Kdrag**2*k*vgsol*w2r*w1i*w3i**2 + w3r**2*Kdrag*k*rhogeq*vgsol*w2r*w1i**2 +& w3r**2*Kdrag*k*rhogeq*vgsol*w2r*w1r**2 + w3r**2*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r -& w3r**2*Kdrag*cs**2*k**2*rhogsol*w2r*w1r - w3r**2*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r +& rhogeq**2*cs**2*k**3*w1r*vgsol*w2i**2*w3i + 2*w3r**3*cs**2*k**2*rhogeq*rhogsol*w2r*w1i +& 2*w3i**2*rhogeq**2*w3r**3*k*vgsol*w2i + w3r**3*Kdrag*rhogsol*w2r*w1r**2 - w3r**3*Kdrag*rhogeq*k*vgsol*w2i**2 -& w3r**3*rhogeq**2*cs**2*k**3*vgsol*w1i + 2*w3i*w2r*w3r*cs**2*k**2*rhogeq*rhogsol*w1r**2 -& w3r**3*rhogeq**2*k*vgsol*w2r**2*w1i - w3r**3*Kdrag*rhogeq*k*vgsol*w2r**2 - rhogeq*w3r**4*rhogsol*k**2*cs**2*w2i& + rhogeq*rhogsol*w2i**2*w3i**4*w1i - rhogeq*w3r**4*rhogsol*k**2*cs**2*w1i -& 4*w3i*w3r*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i + w3r**3*w1i*k*Kdrag**2*vdsol - w3r**3*w2i*k*Kdrag**2*vgsol +& rhogeq*w3r**4*k*Kdrag*vdsol*w1r + w3r**3*w2i*k*Kdrag**2*vdsol - rhogeq*rhogsol*k**2*cs**2*w3i**4*w1i -& rhogeq**2*w3r**3*k*vgsol*w2i*w1i**2 - 2*rhogeq*w3r**2*rhogsol*k**2*cs**2*w3i**2*w2i -& w3r**3*w1i*k*Kdrag**2*vgsol - 4*w3i*w2r*w3r*rhogeq**2*cs**2*k**3*w1r*vgsol +& w3r**2*cs**4*k**4*rhogeq*rhogsol*w2i + 2*w3i*w3r*rhogeq*rhogsol*k**2*cs**2*w2r**2*w1r +& 2*w3r*w3i**3*k*Kdrag**2*vgsol - w3r**2*Kdrag**2*k*vdsol*w2i*w1r - Kdrag**2*k*vdsol*w2i*w1r*w3i**2 -& w3r**3*vgsol*k*rhogeq**2*w2i**2*w1i - w3r**3*Kdrag*rhogeq*k*vgsol*w2r*w1r +& 2*w3r**3*rhogeq*cs**2*k**2*rhogsol*w2i*w1r - 3*w3r**3*Kdrag*k*rhogeq*vgsol*w1i*w2i +& w3r**2*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r - w3r**2*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r +& Kdrag**2*k*vgsol*w2i*w1r*w3i**2 + rhogeq**2*cs**2*k**3*vgsol*w1i*w2r**2*w3r - w3r**2*Kdrag**2*k*vdsol*w2r*w1i -& Kdrag**2*k*vdsol*w2r*w1i*w3i**2 + w3r**2*cs**4*k**4*rhogeq*rhogsol*w1i +& w3r**2*Kdrag*cs**2*k**2*rhogsol*w1i*w2i + w3r**3*Kdrag*rhogsol*w2r*w1i**2 -& cs**2*k**3*rhogeq*w3r**3*Kdrag*vgsol + 2*w3i*w2r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r +& 4*cs**2*k**2*rhogeq*w3r**2*w3i*w2i*rhogsol*w1i - 4*cs**2*k**2*rhogeq*w3r**2*w3i*w2r*w1r*rhogsol -& 2*Kdrag*w1r*w2i*w3i**3*rhogsol*w3r + Kdrag*k*rhogeq*vgsol*w2r*w1r**2*w3i**2 + w3r**2*Kdrag**2*k*vgsol*w2r*w1i -& Kdrag*cs**2*k**2*rhogsol*w2r*w1r*w3i**2 + w3i**3*Kdrag*rhogsol*w2i*w1r**2 +& Kdrag*k*rhogeq*vgsol*w2r*w1i**2*w3i**2 + w3r**2*Kdrag**2*k*vgsol*w2i*w1r +& Kdrag*cs**2*k**2*rhogsol*w1i*w2i*w3i**2 + w3r**3*Kdrag*rhogsol*w2i**2*w1r -& w3r**3*vgsol*rhogeq**2*k**3*cs**2*w2i) rhod3i = rhod3i/(w3r**2 + w3i**2)/(w1i**2 - 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 -& 2*w3r*w1r)/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i + w3r**2)/rhogeq/Kdrag rhod2r = - rhodeq*(k*Kdrag**2*vdsol*w2i**3*w1i - k*Kdrag**2*vgsol*w2i**3*w1i -& 2*w3r*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i**2 + w3r*Kdrag*rhogsol*w2i**3*w1i**2 -& Kdrag*k*rhogeq*vgsol*w2i**3*w1i**2 + w3r*Kdrag*rhogsol*w2i**3*w1r**2 - Kdrag*k*rhogeq*vgsol*w2i**3*w1r**2 -& 2*w2i*w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i + w2i*w3r**2*rhogeq**2*k*vgsol*w2r**2*w1i -& w2i*w3r**2*Kdrag*rhogeq*k*vgsol*w2r**2 - w3r*rhogeq**2*cs**2*k**3*w2r**3*vgsol -& w3r*Kdrag*rhogsol*k**2*cs**2*w1i*w2r**2 + w3r*Kdrag**2*k*vdsol*w2r**2*w1r - w3r*Kdrag**2*k*vgsol*w2r**2*w1r +& w3r*Kdrag*k*rhogeq*vgsol*w2r**3*w1i - w3r*rhogeq*cs**2*k**2*w1i**2*w2r**2*rhogsol -& w3r*rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol + 2*w3r*rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol +& w3r**2*rhogeq**2*cs**2*k**3*w2r**2*vgsol + w3r**2*rhogeq*w2r**2*w1i*k*Kdrag*vgsol -& w3r**2*Kdrag*rhogsol*w2r**3*w1i + w3r**2*rhogeq**2*w2r**3*k*w1r*vgsol + w2i*w3r*rhogeq*k*Kdrag*vdsol*w2r**2*w1r& + w2i*w3r*Kdrag*rhogsol*w2r**2*w1r**2 + w2i*w3r*Kdrag*rhogsol*w2r**2*w1i**2 - w2i*w3r*rhogeq*rhogsol*w2r**4*w1i& + 2*w2i*w3r*rhogeq*cs**2*k**2*rhogsol*w2r**2*w1i + 2*w2i*w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r +& w2i*w3r*Kdrag*cs**2*k**2*rhogsol*w2r**2 - 2*w2i*w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r -& 4*w3r*rhogeq*cs**2*k**2*rhogsol*w2r*w2i**2*w1r - w3r*rhogeq*k*Kdrag*vdsol*w2r*w2i**2*w1i +& rhogeq**2*k*vgsol*w2i**5*w1i - w3r*rhogeq*rhogsol*w2i**5*w1i + 4*w3i*cs**2*k**2*rhogeq*rhogsol*w2r*w2i**2*w1i +& 2*w3r**2*rhogeq*rhogsol*w2r**2*w2i**2*w1r - w3r**2*rhogeq*rhogsol*w2r*w2i**2*w1r**2 +& w3r**2*rhogeq**2*k*vgsol*w2r*w2i**2*w1r + 2*vgsol*k*rhogeq**2*w2i**3*w2r**2*w1i +& 2*w3r*rhogeq*cs**2*k**2*rhogsol*w2i**2*w2r**2 + 3*w3r*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w2r -& 2*w3r*Kdrag*rhogsol*w2r*w1r*w2i**3 - 2*w3r*rhogeq*rhogsol*w2i**3*w2r**2*w1i -& w3r**2*rhogeq*rhogsol*w2r*w2i**2*w1i**2 + 2*w3r*rhogeq*rhogsol*w1i**2*w2r**2*w2i**2 +& 2*w3r*rhogeq*rhogsol*w2i**2*w1r**2*w2r**2 + w3r*w2r*Kdrag*rhogeq*k*vgsol*w2i**2*w1i -& 2*w3r**2*rhogeq**2*k*vgsol*w2i**2*w2r**2 + w3r*rhogeq**2*k*vgsol*w2r*w2i**2*w1i**2 +& w3r*rhogeq**2*k*vgsol*w2r*w2i**2*w1r**2 - 4*w3r*rhogeq**2*k*vgsol*w2r**2*w2i**2*w1r -& w3r*rhogeq*cs**4*k**4*w2r**2*rhogsol - w3r**2*rhogeq*w2r**3*w1r**2*rhogsol +& w1r*Kdrag*rhogsol*k**2*cs**2*w2i**3 + w2i*w3r**2*Kdrag*rhogsol*w2r**2*w1r - 2*w2i*w3r*Kdrag*rhogsol*w2r**3*w1r& - 3*w2i*w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1r + w2i*rhogeq**2*k*vgsol*w2r**4*w1i +& rhogeq**2*w1i**2*k*vgsol*w3r*w2r**3 + 2*w2i*w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1r +& w1r*w3i**2*cs**2*k**2*rhogeq*rhogsol*w2i**2 + w1r*w3r**2*cs**2*k**2*rhogeq*rhogsol*w2i**2 +& 2*Kdrag*w3r*w2r**3*k*rhogeq*vgsol*w2i + w3r*rhogeq**2*w1r**2*k*vgsol*w2r**3 - w3r*rhogeq*w2r**5*w1r*rhogsol -& rhogeq*w1i*w3r*w2r**3*k*Kdrag*vdsol + rhogeq*w1i**2*w3r*w2r**4*rhogsol + w3r*rhogeq*w2r**4*w1r**2*rhogsol +& w3r*rhogeq**2*w2r**5*k*vgsol + w3r*w2r**3*k*Kdrag**2*vgsol - w3r*w2r**3*k*Kdrag**2*vdsol +& Kdrag*w3r*w2r**4*rhogsol*w1i + w3r*rhogeq*w2r**4*cs**2*k**2*rhogsol +& w2r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r**2 - w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol +& w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol - w2r*w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol -& w2r*w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol + w2r*w3r*rhogeq*cs**4*k**4*w1r*rhogsol -& w2r*w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol - w2r*w3r**2*Kdrag*rhogsol*w1i*w2i**2 -& rhogeq*w2r*w3i*w1r*k*Kdrag*vdsol*w2i**2 + rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r*w1r -& rhogeq*w2i*w3i*w1i*k*Kdrag*vdsol*w2r**2 - rhogeq*w3i**2*cs**2*k**2*rhogsol*w1r*w2r**2 -& 2*w3r*rhogeq**2*w2r**4*k*w1r*vgsol - 2*w3r*rhogeq*w2r**3*w1r*rhogsol*w2i**2) !--break to avoid too many continuation lines rhod2r = rhod2r - rhodeq*( & 2*w3r*rhogeq**2*w2i**2*k*vgsol*w2r**3 - w3r**2*rhogeq**2*w2r**4*vgsol*k -& w3r**2*rhogeq*rhogsol*k**2*cs**2*w2r**2*w1r + w3r**2*rhogeq*w2r**4*w1r*rhogsol +& w2r*w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2 - w2r*w3r*rhogeq*rhogsol*w2i**4*w1r +& Kdrag*rhogsol*k**2*cs**2*w1i*w2r**3 - rhogeq**2*w2r**4*w3i**2*k*vgsol +& rhogeq*w2r*w3i**2*cs**2*k**2*rhogsol*w1r**2 + rhogeq*cs**4*k**4*w2r**3*rhogsol +& w2r*w3r*rhogeq**2*k*vgsol*w2i**4 + rhogeq*w2r**4*w3i**2*w1r*rhogsol + rhogeq**2*cs**2*k**3*w2r**2*vgsol*w1r**2& - 3*rhogeq*cs**4*k**4*w2r*rhogsol*w2i**2 - 2*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w2r*w1r +& 2*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w2r*w1r - rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r**2 -& 2*rhogeq*w2r*w3i**2*cs**2*k**2*rhogsol*w2i*w1i - rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r*w1r -& rhogeq**2*w1i**2*k*vgsol*w2r**4 + rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r**2 +& 2*rhogeq**2*cs**2*k**3*w3i*w1i*vgsol*w2r**2 - 3*rhogeq**2*cs**2*k**3*w2r**2*vgsol*w2i*w1i +& 2*rhogeq*cs**4*k**4*w2r*rhogsol*w2i*w1i - rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2r**2 -& 3*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w2r**2 - 2*rhogeq**2*w1i**2*k*vgsol*w2r**2*w2i**2 +& rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2r**2 + rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2r**2 +& 3*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w2r**2 - 4*rhogeq**2*w3i*w2r**2*w1i*k*vgsol*w2i**2 -& 2*rhogeq**2*w3i*w2r**4*w1i*k*vgsol + 2*rhogeq*w2r**2*w3i**2*w1r*rhogsol*w2i**2 +& 2*w2r*Kdrag*w3r*w2i**3*k*rhogeq*vgsol + rhogeq*cs**2*k**2*w2r**4*w1r*rhogsol +& rhogeq**2*w2r**3*w3i**2*k*w1r*vgsol - rhogeq**2*cs**2*k**3*w2r**3*w1r*vgsol -& rhogeq*cs**4*k**4*w1r*rhogsol*w2r**2 + w2r*w3r*w2i**2*k*Kdrag**2*vgsol - w2r*w3r*w2i**2*k*Kdrag**2*vdsol -& rhogeq*w2r*w3i**2*w1r**2*rhogsol*w2i**2 + 2*rhogeq*cs**2*k**2*w2r**2*w1r*rhogsol*w2i**2 +& rhogeq**2*w2i*k*vgsol*w3i*w1r**2*w2r**2 - 3*rhogeq**2*cs**2*k**3*w3i*w2i*vgsol*w2r**2 -& 2*Kdrag*k*rhogeq*vgsol*w2r**4*w1i - rhogeq*w2r**3*w3i**2*w1r**2*rhogsol + w3i*vdsol*Kdrag*k*rhogeq*w2r**4 -& vdsol*Kdrag*k*rhogeq*w2i*w2r**4 - 2*w3i*rhogeq*rhogsol*w2r**2*w2i**3*w1r + w3i*rhogeq*rhogsol*w2r*w2i**4*w1i -& w3i*rhogeq*rhogsol*w2i**5*w1r + w3i*rhogeq*rhogsol*w2r**5*w1i - w3i*rhogeq*rhogsol*w2i*w2r**4*w1r +& 2*w3i*rhogeq*rhogsol*w2i**2*w2r**3*w1i - w3i**2*cs**2*k**3*rhogeq**2*vgsol*w2r*w1r +& w3i**2*cs**2*k**3*rhogeq**2*vgsol*w2r**2 - 2*rhogsol*k**2*cs**2*Kdrag*w2i*w2r**3 +& w3i*rhogsol*k**2*cs**2*Kdrag*w2r**3 + w3i*rhogsol*k**2*cs**2*Kdrag*w2r*w2i**2 -& 2*rhogsol*k**2*cs**2*Kdrag*w2r*w2i**3 - w3i*vgsol*k*Kdrag**2*w2i*w2r**2 + vdsol*k*Kdrag**2*w2r**4 -& cs**2*k**2*rhogeq*rhogsol*w2r*w2i**4 + 2*w3i*rhogeq**2*k*vgsol*w2r**2*w2i**3 -& 2*cs**2*k**2*rhogeq*rhogsol*w2r**3*w2i**2 + w3i*rhogeq**2*k*vgsol*w2i*w2r**4 +& 2*w3i*Kdrag*rhogsol*w2r*w2i**3*w1i - cs**2*k**2*rhogeq*rhogsol*w2r**5 + w3i*rhogeq**2*k*vgsol*w2i**5 +& 2*rhogeq**2*k*vgsol*w2i**2*w2r**3*w1r + w3i*Kdrag*rhogsol*w2r**4*w1r + 2*w3i*Kdrag*rhogsol*w2i*w2r**3*w1i +& rhogeq*w2r**2*w3i*w1r**2*k*Kdrag*vgsol + w3i*vdsol*k*Kdrag**2*w2i*w2r**2 - vgsol*k*Kdrag**2*w2r**4 +& 2*vdsol*Kdrag*k*rhogeq*w2i**2*w2r**2*w1i - vdsol*Kdrag*k*rhogeq*w2i**5 + vdsol*Kdrag*k*rhogeq*w2r**4*w1i -& 2*vdsol*Kdrag*k*rhogeq*w2r**2*w2i**3 - w3i*rhogsol*k**4*cs**4*rhogeq*w2r*w1i +& 2*vgsol*k*rhogeq*Kdrag*w2i*w2r**3*w1r + 2*vgsol*k*rhogeq*Kdrag*w2r**2*w2i**3 +& 2*vgsol*k*rhogeq*Kdrag*w2r*w2i**3*w1r + vgsol*k*rhogeq*Kdrag*w2i*w2r**4 - 2*w3i*vgsol*k*rhogeq*Kdrag*w2r**4 +& vgsol*k*rhogeq*Kdrag*w2i**5 - Kdrag*w2r**3*rhogsol*w1i**2*w3i - Kdrag*w2r**2*k*rhogeq*vgsol*w2i*w3i**2 -& Kdrag*w2i**2*rhogsol*w3i*w2r*w1r**2 + Kdrag*w2r**2*rhogsol*k**2*cs**2*w2i*w1r -& Kdrag*w2i**2*rhogsol*w1i**2*w2r*w3i + w2i**2*k*Kdrag**2*vgsol*w2r*w1r - w2r**3*k*Kdrag**2*vdsol*w1r -& w2i**2*k*Kdrag**2*vdsol*w2r*w1r + rhogeq**2*w1i**2*w2r**2*k*vgsol*w2i*w3i +& rhogeq*cs**2*k**2*w1i**2*w2r*rhogsol*w3i**2 + Kdrag*k*rhogeq*vgsol*w2r**2*w1i*w3i**2 +& Kdrag*k*rhogeq*vgsol*w2r**2*w1i**2*w3i + w2r**2*k*Kdrag**2*vgsol*w3i*w1i - w2r**2*k*Kdrag**2*vdsol*w3i*w1i +& rhogeq**2*k*vgsol*w2r**5*w1r - 2*w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w2r*w1i**2 -& 2*w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w2r*w1r**2 - 2*rhogeq**2*k*vgsol*w2i**2*w2r**2*w1r**2) !--break to avoid too many continuation lines rhod2r = rhod2r - rhodeq*( & rhogeq**2*k*vgsol*w2r*w2i**4*w1r - Kdrag*w2r**2*k*rhogeq*vgsol*w2i*w3i*w1i -& Kdrag*w2r**2*k*rhogeq*vgsol*w2i*w1i**2 + Kdrag*w2r**3*k*rhogeq*vgsol*w3i*w1r -& Kdrag*w2i*vgsol*k*rhogeq*w1r**2*w2r**2 + Kdrag*w2i**2*k*rhogeq*vgsol*w2r*w3i*w1r + w2r**3*k*Kdrag**2*vgsol*w1r& - Kdrag*w2r**3*rhogsol*w1i*w3i**2 - Kdrag*w2r**2*rhogsol*k**2*cs**2*w3i*w1r +& rhogeq**2*w1i*w2r**2*k*vgsol*w2i*w3i**2 + Kdrag*w2r**2*rhogsol*w2i*w1r*w3i**2 -& rhogeq*w1i**2*w2r**3*rhogsol*w3i**2 - Kdrag*w2r**3*rhogsol*w3i*w1r**2 - rhogeq*w1i**2*w2i**2*rhogsol*w2r*w3i**2& - Kdrag*w2i**2*rhogsol*w1i*w2r*w3i**2 - w3r**2*rhogeq*w1i**2*w2r**3*rhogsol +& 2*rhogsol*k**4*cs**4*rhogeq*w2r*w2i*w3i + 3*cs**2*k**3*rhogeq**2*vgsol*w2r*w1r*w2i**2 +& 2*rhogeq*w2i**2*k*Kdrag*vdsol*w2r**2*w3i - rhogeq*w2r**3*w3i*w1r*k*Kdrag*vdsol +& Kdrag*rhogsol*k**2*cs**2*w1i*w2r*w2i**2 - 2*Kdrag*k*rhogeq*vgsol*w2r**2*w1i*w2i**2 -& 2*rhogeq**2*w2r**2*w3i**2*k*vgsol*w2i**2 - Kdrag**2*k*vgsol*w2i*w1i*w2r**2 + Kdrag**2*k*vdsol*w2i*w1i*w2r**2 +& w2r*rhogeq**2*vgsol*k*w2i**2*w1r*w3i**2 - 2*Kdrag*w2r**2*k*rhogeq*vgsol*w2i**2*w3i - k*Kdrag**2*vdsol*w2i**4 +& k*Kdrag**2*vgsol*w2i**4 + Kdrag*w2i**2*vgsol*k*rhogeq*w1i*w3r**2 - w3i**2*rhogeq**2*cs**2*k**3*vgsol*w2i**2 +& w2i**2*k*Kdrag**2*vdsol*w3r*w1r - w2i**2*k*Kdrag**2*vdsol*w3i*w1i + w2i**2*k*Kdrag**2*vgsol*w3i*w1i -& Kdrag*rhogsol*k**2*cs**2*w3i*w1r*w2i**2 - w2i**2*k*Kdrag**2*vgsol*w3r*w1r +& w3r**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i - w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i*w1i -& rhogeq**2*vgsol*k*w2i**4*w1r**2 - rhogeq**2*vgsol*k*w2i**4*w1i**2 - w3r**2*vgsol*k*rhogeq*Kdrag*w2i**3 -& w3r*Kdrag*rhogsol*w2i**4*w1i + cs**2*k**3*rhogeq*vgsol*Kdrag*w2i**3 + w3r**2*rhogeq**2*vgsol*k*w2i**3*w1i +& cs**2*k**3*rhogeq**2*vgsol*w2i**3*w1i + w3r*vdsol*Kdrag*k*rhogeq*w2i**3*w1r - w3i*vgsol*k*Kdrag**2*w2i**3 +& w3i*vdsol*k*Kdrag**2*w2i**3 - w3i**2*vgsol*k*rhogeq*Kdrag*w2i**3 - w3i*vgsol*k*rhogeq*Kdrag*w2i**3*w1i -& 3*w3r*vgsol*k*rhogeq*Kdrag*w2i**3*w1r - w3i*Kdrag*rhogsol*w2i**4*w1r + w3r*rhogsol*k**2*cs**2*Kdrag*w2i**3 +& w3r**2*rhogeq*rhogsol*w2i**4*w1r + w3i**2*rhogeq*rhogsol*w2i**4*w1r + w3i**2*Kdrag*rhogsol*w2i**3*w1r +& w3r**2*Kdrag*rhogsol*w2i**3*w1r - 2*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w1i +& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**3 + w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1r**2 +& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**2 - cs**2*k**3*rhogeq*vdsol*Kdrag*w2i**3 -& 2*w3r*rhogeq**2*k*vgsol*w2i**4*w1r - w3r**2*rhogeq**2*vgsol*k*w2i**4 + w3r*cs**2*k**2*rhogeq*rhogsol*w2i**4 -& w3i**2*rhogeq**2*vgsol*k*w2i**4 - w3i*vdsol*Kdrag*k*rhogeq*w2i**3*w1i + w3i*vdsol*Kdrag*k*rhogeq*w2i**4 +& rhogeq*rhogsol*k**2*cs**2*w2i**4*w1r + rhogeq*k*Kdrag*vdsol*w2i**4*w1i - 2*w3i*rhogeq**2*k*vgsol*w2i**4*w1i +& w3i*rhogeq**2*k*vgsol*w2i**3*w1i**2 + w3i*rhogeq**2*k*vgsol*w2i**3*w1r**2 -& 2*w3r*cs**2*k**2*rhogeq*rhogsol*w2i**3*w1i + w3i**2*rhogeq**2*vgsol*k*w2i**3*w1i +& w3r*rhogeq*cs**2*k**2*w1r**2*rhogsol*w2i**2 + w3r*rhogeq*cs**2*k**2*w1i**2*rhogsol*w2i**2 +& w3r*rhogeq*cs**4*k**4*rhogsol*w2i**2 - w3r*Kdrag*rhogsol*k**2*cs**2*w1i*w2i**2 -& w3r**2*rhogeq**2*cs**2*k**3*vgsol*w2i**2 - w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w1r -& w3r*rhogeq*cs**4*k**4*rhogsol*w2i*w1i + rhogeq*cs**4*k**4*w1r*rhogsol*w2i**2 -& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i**2 + w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i**2 -& rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i**2 + rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i**2 +& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w1r - rhogeq**2*cs**2*k**3*w1r**2*vgsol*w2i**2 -& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w1r - rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2i**2 +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i*w1i + Kdrag*w2i**2*k*rhogeq*vgsol*w3i*w1i**2 +& w3i**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i - 2*w3i*cs**2*k**2*rhogeq*rhogsol*w2i**3*w1r +& w3r*rhogeq*rhogsol*w2i**4*w1r**2 + w3r*rhogeq*rhogsol*w2i**4*w1i**2 - rhogeq**2*k*vgsol*w2r**4*w1r**2 +& Kdrag*w2i**2*k*rhogeq*vgsol*w3i**2*w1i + Kdrag*w2i**2*k*rhogeq*vgsol*w3i*w1r**2) rhod2r = rhod2r/(w2i**2 +& w2r**2)/rhogeq/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i + w3r**2)/(w2r**2 + w1r**2 + w2i**2 -& 2*w2i*w1i - 2*w2r*w1r + w1i**2)/Kdrag rhod2i =rhodeq*( - w3r**2*Kdrag*rhogsol*w1i*w2i**3 - w2r*w3i*vdsol*k*Kdrag**2*w2i**2 +& w2r*w3i**2*vgsol*k*rhogeq*Kdrag*w2i**2 + 3*w2r*w3i*vgsol*k*rhogeq*Kdrag*w2i**2*w1i +& w2r*w3r*vgsol*k*rhogeq*Kdrag*w2i**2*w1r + w2r*w3r**2*vgsol*k*rhogeq*Kdrag*w2i**2 -& 3*w2r*cs**2*k**3*rhogeq*vgsol*Kdrag*w2i**2 - w2r*w3r*rhogsol*k**2*cs**2*Kdrag*w2i**2 +& 2*w2r*w3i*Kdrag*rhogsol*w2i**3*w1r - w2r*w3i*cs**2*k**3*rhogeq**2*vgsol*w1i**2 +& 3*w2r*cs**2*k**3*rhogeq*vdsol*Kdrag*w2i**2 - w2r*w3r**2*Kdrag*rhogsol*w2i**2*w1r -& 3*w2r*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**2 - 2*Kdrag*k*rhogeq*vgsol*w2r**3*w1i*w2i +& 4*w2r*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i - w2r*w3i**2*Kdrag*rhogsol*w2i**2*w1r -& w2r*w3i*cs**2*k**3*rhogeq**2*vgsol*w1r**2 - w2r*w3i*vdsol*Kdrag*k*rhogeq*w2i**2*w1i +& w2r*w3i*vgsol*k*Kdrag**2*w2i**2 + Kdrag*vgsol*k*rhogeq*w1r**2*w2r**3 - Kdrag*w2i*k*rhogeq*vgsol*w2r**2*w3i*w1r& - Kdrag*w2r**3*rhogsol*w1r*w3i**2 - 3*cs**2*k**3*rhogeq**2*vgsol*w2r**2*w1r*w2i +& Kdrag*rhogsol*k**2*cs**2*w1i*w2r**2*w2i - w3i**2*Kdrag*rhogsol*w1i*w2i**3 +& 4*w2r*w3r*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i - w2r*w3r*Kdrag*rhogsol*w2i**2*w1i**2 -& Kdrag**2*k*vdsol*w1i*w2r**3 - w2r**2*rhogeq**2*vgsol*k*w2i*w1r*w3i**2 -& 2*w2r*w1r*w3r**2*cs**2*k**2*rhogeq*rhogsol*w2i - w2r*k*Kdrag**2*vdsol*w2i**2*w1i +& w2r*w3r*rhogeq*rhogsol*w2i**4*w1i - 2*w2r*w1r*w3i**2*cs**2*k**2*rhogeq*rhogsol*w2i +& w2r*Kdrag*k*rhogeq*vgsol*w2i**2*w1i**2 - w2r*rhogeq**2*k*vgsol*w2i**4*w1i - w2r*w3r*Kdrag*rhogsol*w2i**2*w1r**2& + w2r*k*Kdrag**2*vgsol*w2i**2*w1i - 2*Kdrag*w2r**3*k*rhogeq*vgsol*w2i*w3i + Kdrag**2*k*vgsol*w1i*w2r**3 +& rhogeq*w1i**2*w2i*rhogsol*w2r**2*w3i**2 - Kdrag*w2i*rhogsol*w1i*w2r**2*w3i**2 -& rhogsol*k**4*cs**4*rhogeq*w2r**2*w3i + rhogeq**2*w1i*w2r**3*k*vgsol*w3i**2 +& w3r**2*rhogeq**2*k*vgsol*w2r**3*w1i + w3r**2*Kdrag*rhogeq*k*vgsol*w2r**3 + w2r*w3i*rhogeq*rhogsol*w2i**4*w1r -& w2r*w3i*rhogeq**2*k*vgsol*w2i**4 + w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1i +& w2r*vdsol*Kdrag*k*rhogeq*w2i**4 - w2r*vgsol*k*rhogeq*Kdrag*w2i**4 + 2*w2r*w3i**2*rhogeq**2*cs**2*k**3*vgsol*w2i& + w2r*Kdrag*k*rhogeq*vgsol*w2i**2*w1r**2 - w2r*w1r*Kdrag*rhogsol*k**2*cs**2*w2i**2 -& 2*vgsol*k*rhogeq**2*w2i**2*w2r**3*w1i - 3*w3r*cs**2*k**3*rhogeq**2*vgsol*w2i*w2r**2 +& w3r*rhogeq*k*Kdrag*vdsol*w2r**3*w1r - w3r*Kdrag*rhogsol*w2r**3*w1r**2 - w3r*Kdrag*rhogsol*w2r**3*w1i**2 +& w3r*rhogeq*rhogsol*w2r**5*w1i - 4*w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w2i*w1i +& w3r**2*rhogeq*rhogsol*w2r**2*w2i*w1r**2 - w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r**2 +& w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r**2 + w3r*rhogeq*k*Kdrag*vdsol*w2r**2*w2i*w1i -& w3r*Kdrag*cs**2*k**2*rhogsol*w2r**3 - 2*w3r*rhogeq*cs**2*k**2*rhogsol*w2r**3*w1i +& 4*w3r*rhogeq*cs**2*k**2*rhogsol*w2r**2*w2i*w1r - w3r**2*rhogeq**2*k*vgsol*w2r**2*w2i*w1r -& w3r*rhogeq**2*k*vgsol*w2r**2*w2i*w1r**2 - w3r**2*Kdrag*rhogsol*w2r**3*w1r + w3r*Kdrag*rhogsol*w2r**4*w1r +& w3r*Kdrag*k*rhogeq*vgsol*w2r**3*w1r - 2*w2r*k*Kdrag**2*vgsol*w2i**3 + rhogeq*w2r**2*w3i*w1r*k*Kdrag*vdsol*w2i -& rhogeq*w3i*w1i*k*Kdrag*vdsol*w2r**3 + 2*w2r**2*w3r*rhogeq**2*k*vgsol*w2i**3 -& 2*w3i*cs**2*k**2*rhogeq*rhogsol*w2r**3*w1r - w3r*rhogeq**2*k*vgsol*w2r**2*w2i*w1i**2 -& rhogeq**2*k*vgsol*w2r**5*w1i - w2r**2*w3r**2*Kdrag*rhogsol*w1i*w2i + 2*w3r*rhogeq*rhogsol*w2i**2*w2r**3*w1i +& w3r**2*rhogeq*rhogsol*w2r**2*w2i*w1i**2 - w3r*w2r**2*Kdrag*rhogeq*k*vgsol*w2i*w1i +& rhogeq**2*cs**2*k**3*w2r**3*vgsol*w1i + 3*rhogeq*cs**4*k**4*w2r**2*rhogsol*w2i +& rhogeq*cs**2*k**3*Kdrag*vdsol*w2r**2*w1r - rhogeq*cs**2*k**3*Kdrag*vgsol*w2r**2*w1r -& 2*w2r**2*w3r*rhogeq*rhogsol*w2i**3*w1r - w3r*rhogeq*w2r**4*w1r*rhogsol*w2i + w3r*rhogeq**2*w2i*k*vgsol*w2r**4 +& 2*w2r*k*Kdrag**2*vdsol*w2i**3 - rhogeq*cs**2*k**3*Kdrag*vdsol*w2r**3 - w2r**2*w3r*w2i*k*Kdrag**2*vdsol +& 2*w2r**2*Kdrag*w3r*w2i**2*k*rhogeq*vgsol + rhogeq*w2r**2*w3i**2*w1r**2*rhogsol*w2i +& rhogeq**2*k*vgsol*w3i*w1r**2*w2r**3 - rhogeq*cs**4*k**4*w2r**2*rhogsol*w1i) !--break to avoid too many continuation lines rhod2i = rhod2i + rhodeq*(& rhogeq*cs**2*k**3*Kdrag*vgsol*w2r**3 + rhogeq*w2r**2*w3i**2*cs**2*k**2*rhogsol*w1i +& w3i**2*Kdrag*rhogsol*w2i**2*w1r**2 + rhogeq**2*cs**2*k**3*w3i*vgsol*w2r**3 +& 2*w3i*rhogeq*rhogsol*w2r**2*w2i**3*w1i + w3i*rhogeq*rhogsol*w2r**5*w1r + w3i*rhogeq*rhogsol*w2i*w2r**4*w1i +& w2r**2*w3r*w2i*k*Kdrag**2*vgsol + rhogsol*k**2*cs**2*Kdrag*w2r**4 - 2*w3i*rhogeq**2*k*vgsol*w2r**3*w2i**2 -& cs**2*k**2*rhogeq*rhogsol*w2r**4*w2i - 2*cs**2*k**2*rhogeq*rhogsol*w2r**2*w2i**3 - w3i*rhogeq**2*k*vgsol*w2r**5& + rhogeq**2*k*vgsol*w2i*w2r**4*w1r + vdsol*Kdrag*k*rhogeq*w2r**5 + 2*w3i*rhogeq*rhogsol*w2r**3*w2i**2*w1r +& w3i**2*Kdrag*rhogsol*w2i**2*w1i**2 + 2*vdsol*Kdrag*k*rhogeq*w2r**3*w2i**2 +& 2*vgsol*k*rhogeq*Kdrag*w2r**2*w2i**2*w1r + w3i*rhogsol*k**2*cs**2*Kdrag*w2r**2*w2i +& w3i*vgsol*k*Kdrag**2*w2r**3 - w2i*k*Kdrag**2*vdsol*w2r**2*w1r + rhogeq**2*w1i**2*w2r**3*k*vgsol*w3i -& w3i*vdsol*k*Kdrag**2*w2r**3 - w3i*Kdrag*rhogsol*w2r**4*w1i - 2*vgsol*k*rhogeq*Kdrag*w2r**3*w2i**2 -& Kdrag*w2i*rhogsol*w1i**2*w2r**2*w3i + w2i*k*Kdrag**2*vgsol*w2r**2*w1r + 3*Kdrag*w2r**3*k*rhogeq*vgsol*w3i*w1i +& Kdrag*w2r**3*k*rhogeq*vgsol*w1i**2 + w3r**2*Kdrag*rhogsol*w2i**2*w1i**2 -& rhogeq*w1i*rhogsol*k**2*cs**2*w3i**2*w2i**2 + w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1i**2 +& w3i*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1r**2 + 2*rhogeq**2*k*vgsol*w2r**2*w2i**3*w1r -& vgsol*k*rhogeq*Kdrag*w2r**5 + Kdrag*w2r**3*k*rhogeq*vgsol*w3i**2 - Kdrag*w2i*rhogsol*w3i*w2r**2*w1r**2 -& Kdrag*w2r**3*rhogsol*k**2*cs**2*w1r + 2*Kdrag*w2i**4*vgsol*k*rhogeq*w1r - 2*Kdrag*w2i**3*w2r*vgsol*k*rhogeq*w1i& + Kdrag*w2i**4*rhogsol*w3i*w1i + rhogeq*w1i*w2r**4*rhogsol*k**2*cs**2 +& 2*rhogeq*w1i*w2r**2*rhogsol*k**2*cs**2*w2i**2 - Kdrag*w3r*w2i**4*rhogsol*w1r +& w2r*w3i*cs**4*k**4*rhogeq*rhogsol*w1r + rhogeq*w1i*w3r*w2i**3*k*Kdrag*vdsol +& 2*Kdrag*w2r**3*rhogsol*w3i*w1r*w2i - 2*w2r*w3r*rhogeq*cs**4*k**4*rhogsol*w2i +& 2*w2r*w3r**2*rhogeq**2*cs**2*k**3*vgsol*w2i + rhogeq*w1i*w2i**4*rhogsol*k**2*cs**2 +& w2r*w3i*rhogeq**2*k*vgsol*w2i**2*w1r**2 + 2*w2r*w3r*cs**2*k**2*rhogeq*rhogsol*w2i**2*w1i -& 2*w2r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i + 2*w2r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i -& 2*w2r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i + w2r*w3r*rhogeq*cs**4*k**4*rhogsol*w1i +& 2*w2r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i - w2r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1i -& 2*w2r*rhogeq*cs**4*k**4*w1r*rhogsol*w2i + w2r*w3i*rhogeq**2*k*vgsol*w2i**2*w1i**2 +& w2r*w3i**2*rhogeq**2*vgsol*k*w2i**2*w1i - 2*w2r*w3r*rhogeq*cs**2*k**2*w1r**2*rhogsol*w2i -& 2*w2r*w3r*rhogeq*cs**2*k**2*w1i**2*rhogsol*w2i - w2r*w3i**2*rhogeq**2*cs**2*k**3*vgsol*w1i +& 2*w2r*w3i*cs**2*k**2*rhogeq*rhogsol*w2i**2*w1r - rhogeq**2*w1i**2*k*vgsol*w3r*w2i**3 +& rhogeq*w1i**2*rhogsol*k**2*cs**2*w3i**2*w2i + rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r**2*w2i -& w2r*w3r*rhogeq*cs**2*k**3*Kdrag*vdsol*w1r + 2*w2r*rhogeq**2*cs**2*k**3*w1r**2*vgsol*w2i +& w2r*w3r*rhogeq*cs**2*k**3*Kdrag*vgsol*w1r + 2*w2r*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2i -& w3i*cs**4*k**4*rhogeq*rhogsol*w1i*w2i - w3i*cs**2*k**2*rhogeq*rhogsol*w2i**2*w1r**2 +& w3r*rhogeq**2*cs**2*k**3*w2i**3*vgsol - w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r*w2i +& rhogeq**2*cs**2*k**3*w2i**3*w1r*vgsol + w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r*w2i -& rhogeq*w1i*rhogsol*k**2*cs**2*w3r**2*w2i**2 - w3r*w2i**3*k*Kdrag**2*vdsol +& w3r*Kdrag*rhogsol*k**2*cs**2*w1r*w2r**2 - w3r*Kdrag*k*rhogeq*vgsol*w2i**2*w1r**2 -& w3r*Kdrag*k*rhogeq*vgsol*w1r**2*w2r**2 - w3i*cs**2*k**2*rhogeq*rhogsol*w2i**2*w1i**2) !--break to avoid too many continuation lines rhod2i = rhod2i + rhodeq*( & w3i*cs**4*k**4*rhogeq*rhogsol*w2i**2 + rhogeq*cs**4*k**4*w2i**2*w1i*rhogsol -& w3r*Kdrag*k*rhogeq*vgsol*w1i**2*w2r**2 + w3r*Kdrag**2*k*vdsol*w2i**2*w1i + w3r*Kdrag**2*k*vdsol*w1i*w2r**2 +& w3r*Kdrag*rhogsol*k**2*cs**2*w2i**2*w1r - w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i -& w3r*rhogeq*cs**2*k**3*w2i**2*Kdrag*vdsol + w3r**2*rhogeq*w2i**3*w1i**2*rhogsol - 2*w2i*k*Kdrag**2*vgsol*w2r**3& - w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2i - w3r*Kdrag**2*k*vgsol*w2i**2*w1i - w3r*Kdrag**2*k*vgsol*w1i*w2r**2& - w3r*Kdrag*k*rhogeq*vgsol*w1i*w2i**3 - w3r*Kdrag*k*rhogeq*vgsol*w2i**2*w1i**2 +& w3r**2*rhogeq*w1r**2*w2i**3*rhogsol - w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol*w2i +& w3r*rhogeq*cs**4*k**4*w1r*rhogsol*w2i - w3r**2*rhogeq**2*w2i**3*w1r*k*vgsol -& w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i + w3r*rhogeq*cs**2*k**3*w2i**2*Kdrag*vgsol +& w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i - w3r**2*rhogeq*w2i**2*w1r*k*Kdrag*vgsol -& w3r**2*rhogeq*w1r*k*Kdrag*vgsol*w2r**2 + w3r**2*Kdrag*rhogsol*w1i**2*w2r**2 +& w3r**2*Kdrag*rhogsol*w2i**2*w1r**2 - Kdrag*rhogsol*k**2*cs**2*w3i*w1i*w2r**2 -& Kdrag*k*rhogeq*vgsol*w3i*w1r*w2i**3 - Kdrag*rhogsol*w1i**2*w2i**3*w3i +& w2r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1i - Kdrag*rhogsol*k**2*cs**2*w2i**2*w3i*w1i -& Kdrag**2*k*vgsol*w2i**2*w3i*w1r + w3i**2*Kdrag*rhogsol*w1r**2*w2r**2 + w3i**2*Kdrag*rhogsol*w1i**2*w2r**2 +& w3r**2*Kdrag*rhogsol*w1r**2*w2r**2 + w2r*w3r**2*rhogeq**2*vgsol*k*w2i**2*w1i -& 3*w2r*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w1i + w2r*w3r*vdsol*Kdrag*k*rhogeq*w2i**2*w1r -& w2r*w3r**2*rhogeq**2*cs**2*k**3*vgsol*w1i + 2*w2r*w3r*Kdrag*rhogsol*w2i**3*w1i -& w3i**2*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i - rhogeq*cs**2*k**3*w2i**2*w1r*Kdrag*vdsol -& Kdrag*rhogsol*w2i**3*w1r**2*w3i - w3i**2*rhogeq*w2i**2*w1r*k*Kdrag*vgsol -& w3i**2*rhogeq*w1r*k*Kdrag*vgsol*w2r**2 - rhogeq*w1r*k*Kdrag*vdsol*w2r**4 -& 2*rhogeq*w2i**2*w1r*k*Kdrag*vdsol*w2r**2 - 2*rhogeq*w1i*w3i**2*rhogsol*w2i**2*w2r**2 -& rhogeq*w1i*w3i**2*rhogsol*w2r**4 - 2*w3i*rhogeq*rhogsol*w2i**2*w1r**2*w2r**2 -& w3r*rhogeq**2*k*vgsol*w2i**3*w1r**2 - w3i*rhogeq*rhogsol*w1r**2*w2r**4 +& 2*w3i*rhogeq*rhogsol*k**2*cs**2*w2i**2*w2r**2 + w3i*rhogeq*rhogsol*k**2*cs**2*w2r**4 +& w3i**2*rhogeq*w1r**2*w2i**3*rhogsol - w3r**2*rhogeq*rhogsol*w2i**4*w1i -& 2*w3r**2*rhogeq*rhogsol*w2i**2*w1i*w2r**2 - w3i**2*rhogeq*rhogsol*w2i**4*w1i +& w3i**2*rhogeq*w2i**3*w1i**2*rhogsol - rhogeq*rhogsol*k**2*cs**2*w2i**5 +& w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2*w2i - w3i*rhogeq*rhogsol*w2i**4*w1r**2 +& w3i**2*cs**2*k**2*rhogeq*rhogsol*w1r**2*w2i + w3i*cs**2*k**2*rhogeq*rhogsol*w2i**4 +& 2*w2i*k*Kdrag**2*vdsol*w2r**3 - w3r*rhogeq*rhogsol*w2i**5*w1r - rhogeq*w1i**2*w2i**4*rhogsol*w3i -& cs**4*k**4*rhogeq*rhogsol*w2i**3 + w3r*w2i**3*k*Kdrag**2*vgsol - rhogeq*k*Kdrag*vdsol*w2i**4*w1r +& w3i*vdsol*Kdrag*k*rhogeq*w2i**3*w1r + w3i*rhogeq*rhogsol*w2i**5*w1i + w3r*rhogeq**2*k*vgsol*w2i**5 -& w3r*vdsol*Kdrag*k*rhogeq*w2i**4 - 2*w3r*vdsol*Kdrag*k*rhogeq*w2i**2*w2r**2 -& 2*Kdrag*w2i**3*k*rhogeq*vgsol*w2r*w3i - w2i**3*k*Kdrag**2*vdsol*w1r + w2i**3*k*Kdrag**2*vgsol*w1r +& 2*Kdrag*w3r*w2r**3*rhogsol*w1i*w2i + Kdrag*w2i**3*rhogsol*k**2*cs**2*w3i -& 2*rhogeq*w1i**2*w2i**2*rhogsol*w3i*w2r**2 - rhogeq*w1i**2*w2r**4*rhogsol*w3i - Kdrag*w2i**4*rhogsol*k**2*cs**2& + Kdrag*w2i**3*rhogsol*k**2*cs**2*w1i - w3r**2*rhogeq*rhogsol*w1i*w2r**4 - w3r*rhogeq*k*Kdrag*vdsol*w2r**4 +& 2*Kdrag*w3r*w2i**4*k*rhogeq*vgsol - w3i**2*rhogeq**2*w2i**3*w1r*k*vgsol + Kdrag**2*k*vdsol*w2i**2*w3i*w1r +& Kdrag**2*k*vdsol*w3i*w1r*w2r**2 - Kdrag**2*k*vgsol*w3i*w1r*w2r**2 + rhogeq*cs**2*k**3*w2i**2*w1r*Kdrag*vgsol +& rhogeq**2*w1r*w2i**5*k*vgsol) rhod2i = rhod2i/(w2i**2 + w2r**2)/rhogeq/(w2r**2 - 2*w3r*w2r + w2i**2 + w3i**2 - 2*w2i*w3i +& w3r**2)/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r + w1i**2)/Kdrag rhod1r =(2*w2i*w3r*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r*w3i**2 - w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w1r*w3i**2 +& rhogeq*w2r*w3i*w1r*k*Kdrag*vdsol*w2i**2*w3r**2 + w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w1r*w3i**2 -& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i*w1i*w3r**2 - Kdrag*w2i**2*k*rhogeq*vgsol*w2r*w3i*w1r*w3r**2 +& Kdrag*w2r**2*k*rhogeq*vgsol*w2i*w3i*w1i*w3r**2 + 4*w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w2r*w1i**2*w3r**2 -& rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r*w1r*w3r**2 + rhogeq*w2i*w3i*w1i*k*Kdrag*vdsol*w2r**2*w3r**2 +& w2i*w3r*rhogeq*k*Kdrag*vdsol*w2r**2*w1r*w3i**2 - 4*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w2r*w1r*w3r**2 +& 4*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w2r*w1r*w3r**2 + w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w3i**2 +& 2*rhogeq*cs**2*k**3*w3i**2*Kdrag*vgsol*w2r*w1r*w1i - 2*w2i*w3i**2*cs**2*k**2*rhogeq*rhogsol*w2r**2*w1r*w1i +& w1i**2*rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r*w1r - w1i**2*rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r*w1r +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i*w1i*w3r**2 - w3r*rhogeq*k*Kdrag*vdsol*w2r*w2i**2*w1i*w3i**2 +& 4*w3r*w2i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r*w3i*w1i - 2*rhogeq*cs**2*k**3*w3i**2*Kdrag*vdsol*w2r*w1r*w1i -& 2*w2r*rhogeq**2*cs**2*k**3*w1r*vgsol*w3i*w1i*w2i**2 - 4*w2i*w3r**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i*w3i**2 +& 3*w3r*w2r*Kdrag*rhogeq*k*vgsol*w2i**2*w1i*w3i**2 - w2i*w3r*Kdrag*k*rhogeq*vgsol*w2r**2*w1r*w3i**2 -& w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w3i**2 + rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r*w1r*w3r**2 +& 2*w3r*w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w2r**2 - 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r*w2i**2 -& 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r**3 - 4*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w1r*w2r**2 +& 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r**3 + 2*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r*w2i**2 +& 4*w3r*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w1r*w2r**2 + 2*w3r*w3i*cs**4*k**4*rhogeq*rhogsol*w2i**3 +& 4*w2r*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i*w1r*w3i**2 - 4*rhogeq**2*k*vgsol*w2r*w2i**2*w1r*w3i**3*w1i -& w3r*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i**4 - 2*w3r*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i**2*w2r**2 -& 2*w3r**3*Kdrag*rhogsol*w2r**2*w1i*w2i**2 - rhogeq*w3i**3*w2i*w1r*rhogsol*w2r**2*w1i**2 +& 2*w1r**2*rhogsol*k**4*cs**4*rhogeq*w2r*w2i*w3i - rhogeq*w3i**3*k*Kdrag*vdsol*w2r**2*w1i**2 +& w1i**2*rhogeq**2*k*vgsol*w2r*w2i**2*w1r*w3i**2 + w1i**3*w2i*rhogeq**2*k*vgsol*w2r**2*w3i**2 -& 2*w2r*rhogeq*w1i**3*rhogsol*k**2*cs**2*w3i**2*w2i + w1i**2*rhogeq**2*w2r**3*k*w1r*vgsol*w3i**2 -& 2*w2r*cs**2*k**2*rhogeq*rhogsol*w1r**2*w3i**2*w1i*w2i - 2*Kdrag*k*rhogeq*vgsol*w2r**3*w1i*w1r*w3i**2 -& 2*w2r*Kdrag*rhogeq*k*vgsol*w2i**2*w1i*w1r*w3i**2 + w1r**3*rhogeq**2*k*vgsol*w2r*w2i**2*w3i**2 -& 2*w1r**3*w2r*rhogeq**2*cs**2*k**3*vgsol*w2i*w3i - 2*w3i**2*cs**2*k**3*rhogeq**2*vgsol*w2r**2*w2i**2 -& w1r**3*w2r*rhogeq**2*cs**2*k**3*vgsol*w3i**2 - w3i*rhogsol*k**4*cs**4*rhogeq*w2r*w1i*w2i**2 -& w3i*rhogsol*k**4*cs**4*rhogeq*w2r**3*w1i - w2i*rhogeq*k*Kdrag*vdsol*w2r**2*w1r**2*w3i**2 +& w1r**3*rhogeq**2*w2r**3*k*vgsol*w3i**2 - w3i**2*rhogeq*k*Kdrag*vdsol*w2r**2*w1i**2*w2i -& w3i**2*cs**2*k**3*rhogeq**2*vgsol*w2r**4 + 2*rhogeq**2*cs**2*k**3*w3i*w1i*vgsol*w2r**2*w2i**2 -& rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r**3*w1r - 2*w3r*w3i**2*Kdrag*rhogsol*w2r**2*w1i*w2i**2 -& rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r*w1r*w2i**2 + rhogeq**2*cs**2*k**3*w3i*w1i*vgsol*w2r**4) !--break to avoid too many continuation lines rhod1r = rhod1r + (& 2*w2r*w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2*w2i**2 + 2*w2r**3*w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2 -& 2*rhogeq*w2r*w3i**2*cs**2*k**2*rhogsol*w1r**2*w2i**2 - 2*rhogeq*w2r**3*w3i**2*cs**2*k**2*rhogsol*w1r**2 +& rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r*w1r*w2i**2 + rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r**3*w1r +& w2r*w3r*rhogeq*cs**4*k**4*w1r*rhogsol*w2i**2 + w2r**3*w3r*rhogeq*cs**4*k**4*w1r*rhogsol +& w2r*w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol*w2i**2 + w2r**3*w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol +& w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i**2 + w2r**3*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol -& w2r**3*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol - w2r*w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2i**2 -& w2r**3*w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol - w2r*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i**2 +& 4*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w2i**3*w1i**2 + 4*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w2i*w1i**2*w2r**2 -& w3r*rhogeq**2*cs**2*k**3*w2r**4*w1r*vgsol + 2*w3r**2*rhogeq**2*cs**2*k**3*w2r**2*vgsol*w2i**2 +& w3r**2*rhogeq**2*cs**2*k**3*w2r**4*vgsol + w3r*rhogeq*cs**2*k**2*w2r**4*w1r**2*rhogsol +& 2*w3r*rhogeq*cs**2*k**2*w1i**2*w2r**2*rhogsol*w2i**2 - 4*w3r*w3i*cs**4*k**4*rhogeq*rhogsol*w1i*w2i**2 +& w3r*rhogeq*cs**2*k**2*w1i**2*w2r**4*rhogsol + 2*w3r*rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol*w2i**2 -& 2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w2r**4*w1i - 2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w1i*w2i**4 -& 4*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w1i*w2i**2*w2r**2 - w3i**3*Kdrag*rhogeq*k*vgsol*w2i**4 +& 2*w3i**3*Kdrag*rhogsol*w2r**2*w1r*w2i**2 + w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i**3*w1i +& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i*w1i*w2r**2 - w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w1r*w2r**2 -& w3r*rhogeq*cs**4*k**4*rhogsol*w2i**3*w1i + w3r*rhogeq*cs**2*k**3*w2i**3*Kdrag*vdsol*w1r +& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w1r*w2r**2 - w3r*rhogeq*cs**2*k**3*w2i**3*Kdrag*vgsol*w1r +& w3r*rhogeq*cs**2*k**2*w1i**2*rhogsol*w2i**4 + w3r**2*rhogeq**2*cs**2*k**3*vgsol*w2i**4 -& w3i*cs**4*k**4*rhogeq*rhogsol*w2i**3*w1r - w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w1r*w2r**2 -& w3r*rhogeq*cs**4*k**4*rhogsol*w2i*w1i*w2r**2 + w3r*rhogeq*cs**2*k**2*w1r**2*rhogsol*w2i**4 +& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**4*w1i + w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**3*w1r**2 +& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1r**2*w2r**2 - w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**3*w1i**2 -& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**2*w2r**2 - w3i**2*rhogeq**2*cs**2*k**3*vgsol*w2i**4 +& Kdrag*w2i**4*vgsol*k*rhogeq*w1i*w3r**2 - w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i**3*w1i -& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i*w1i*w2r**2 - 2*w3i**3*cs**2*k**3*rhogeq**2*vgsol*w2r*w1r*w2i -& rhogeq*w3i**3*w2i*w1r**3*rhogsol*w2r**2 + 2*w3i*w3r**2*Kdrag*rhogsol*w2r**2*w1r*w2i**2 -& w3i*w3r**2*Kdrag*rhogeq*k*vgsol*w2i**4 + Kdrag*w2i**4*k*rhogeq*vgsol*w3i**2*w1i +& 2*w1r**2*rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r**2 - 2*w1r**2*rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r**2 +& w1r**4*w2r*cs**2*k**2*rhogeq*rhogsol*w3i**2 + w3r*rhogeq**2*cs**2*k**3*w2r**3*vgsol*w3i**2 +& 2*w2i*w3r**2*rhogeq**2*k*vgsol*w2r**2*w1i*w3i**2 - w2i*w3r**4*Kdrag*rhogeq*k*vgsol*w2r**2 +& w2i*w3r**4*rhogeq**2*k*vgsol*w2r**2*w1i - 2*w2i*w3r**4*cs**2*k**2*rhogeq*rhogsol*w2r*w1i -& w3r*Kdrag*rhogsol*w2i**3*w1r**2*w3i**2 - Kdrag*w3r**3*w2r**4*rhogsol*w1i +& w3r*Kdrag*rhogsol*w2i**3*w1i**2*w3i**2 + 2*Kdrag*k*rhogeq*vgsol*w2i**3*w1r**2*w3i**2 -& 2*w1i**2*w2r*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i*w3i - w1i**2*w2r*rhogeq**2*cs**2*k**3*w1r*vgsol*w3i**2 -& w3r**3*w2r**3*k*Kdrag**2*vdsol + 2*Kdrag*k*rhogeq*vgsol*w2i**3*w1r**2*w3r**2 +& w1r**2*w2i*rhogeq**2*k*vgsol*w2r**2*w1i*w3i**2 + k*Kdrag**2*vgsol*w2i**3*w1i*w3i**2) !--break to avoid too many continuation lines rhod1r = rhod1r + (& k*Kdrag**2*vgsol*w2i**3*w1i*w3r**2 + w3r**3*w2r**3*k*Kdrag**2*vgsol +& 2*w1i**2*w2r*cs**2*k**2*rhogeq*rhogsol*w1r**2*w3i**2 - w3r**3*rhogeq*w2r**4*w1r**2*rhogsol -& rhogeq*w1i**2*w3r**3*w2r**4*rhogsol - w3r**4*rhogeq*w2r**3*w1r**2*rhogsol - k*Kdrag**2*vdsol*w2i**3*w1i*w3i**2& - w3r**4*Kdrag*rhogsol*w2r**3*w1i - w3r**3*Kdrag*rhogsol*w2i**3*w1r**2 + w3r**3*Kdrag*rhogsol*w2i**3*w1i**2 -& k*Kdrag**2*vdsol*w2i**3*w1i*w3r**2 - rhogeq**2*w3i**2*k*w1r**4*vgsol*w2r**2 +& Kdrag*w2r**3*rhogsol*w1i**2*w3i**3 + 2*w3r**2*rhogeq**2*w2r**3*k*w1r*vgsol*w3i**2 +& w2i*w3r**3*Kdrag*rhogsol*w2r**2*w1i**2 + w3r**4*rhogeq*w2r**2*w1i*k*Kdrag*vgsol -& w2i*w3r**3*Kdrag*rhogsol*w2r**2*w1r**2 + w3r**4*rhogeq**2*w2r**3*k*w1r*vgsol -& 2*w3r*rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol*w3i**2 - 2*w3r**2*Kdrag*rhogsol*w2r**3*w1i*w3i**2 +& 2*w2r*rhogeq**2*cs**2*k**3*w1r*vgsol*w3i**3*w1i + w3r**4*rhogeq**2*cs**2*k**3*w2r**2*vgsol +& 2*w3r*rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol*w3i**2 + 2*w3r**2*rhogeq**2*cs**2*k**3*w2r**2*vgsol*w3i**2 +& rhogeq**2*cs**2*k**3*w2r**2*vgsol*w1r**2*w3i*w1i - w1i**3*w3i*rhogsol*k**4*cs**4*rhogeq*w2r -& 2*w2r*cs**2*k**2*rhogeq*rhogsol*w1r**2*w3i**3*w1i + 3*w3r*Kdrag*k*rhogeq*vgsol*w2r**3*w1i*w3i**2 +& 2*rhogeq*w3i**3*cs**2*k**2*rhogsol*w1r*w2r**2*w1i + w3i**3*Kdrag*rhogsol*w2r**4*w1r -& 2*w3r**3*rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol + 2*w3r**3*rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol -& rhogeq*w2r**3*w3i**4*w1r**2*rhogsol - w3r**3*Kdrag**2*k*vgsol*w2r**2*w1r + w3r**3*Kdrag**2*k*vdsol*w2r**2*w1r +& 3*w3r**3*Kdrag*k*rhogeq*vgsol*w2r**3*w1i + 2*rhogeq*cs**4*k**4*w2r*rhogsol*w2i*w1i**2*w3i -& w3r*Kdrag**2*k*vgsol*w2r**2*w1r*w3i**2 + rhogeq*w2r**4*w3i**4*w1r*rhogsol - rhogeq**2*w2r**4*w3i**4*k*vgsol +& w3r**4*rhogeq*w2r**4*w1r*rhogsol + w3r*Kdrag**2*k*vdsol*w2r**2*w1r*w3i**2 -& w3r*Kdrag*rhogsol*k**2*cs**2*w1i*w2r**2*w3i**2 - w3r**4*rhogeq**2*w2r**4*vgsol*k +& w3r**3*rhogeq**2*cs**2*k**3*w2r**3*vgsol - w3r**3*Kdrag*rhogsol*k**2*cs**2*w1i*w2r**2 -& 2*w2i*w3r**2*Kdrag*rhogeq*k*vgsol*w2r**2*w3i**2 + 2*rhogeq*cs**4*k**4*w1r*rhogsol*w2r**2*w3i*w1i -& w3r**4*rhogeq*w1i**2*w2r**3*rhogsol - 2*w2i*w3r**3*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r +& 4*w3r**2*rhogeq*rhogsol*w2r**2*w2i**2*w1r*w3i**2 + w2i*w3r**3*Kdrag*cs**2*k**2*rhogsol*w2r**2 +& w2i*w3r*Kdrag*cs**2*k**2*rhogsol*w2r**2*w3i**2 - 2*rhogeq**2*cs**2*k**3*w2r**3*w1r*vgsol*w3i*w1i -& Kdrag*w2r**3*rhogsol*w3i**3*w1r**2 - w1r**3*rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r -& w3r**4*rhogeq*rhogsol*w2r*w2i**2*w1r**2 + w2i*w3r*Kdrag*rhogsol*w2r**2*w1i**2*w3i**2 +& 2*w3r**4*rhogeq*rhogsol*w2r**2*w2i**2*w1r + 2*w2i*w3r**3*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r -& rhogeq*w1i**2*w2r**3*rhogsol*w3i**4 - Kdrag*w2r**3*rhogsol*w1i*w3i**4 -& w2i*w3r*Kdrag*rhogsol*w2r**2*w1r**2*w3i**2 + w2i*w3r**3*rhogeq*k*Kdrag*vdsol*w2r**2*w1r +& 2*w3r**2*rhogeq*w2r**2*w1i*k*Kdrag*vgsol*w3i**2 - 4*w3r**2*rhogeq**2*k*vgsol*w2i**2*w2r**2*w3i**2 +& 2*w3r**2*rhogeq**2*k*vgsol*w2r*w2i**2*w1r*w3i**2 - 2*w3r*rhogeq*rhogsol*w2i**2*w1r**2*w2r**2*w3i**2 -& w3r**4*rhogeq*rhogsol*w2r*w2i**2*w1i**2 + w3i**3*Kdrag*rhogsol*w2i**4*w1r -& 2*w3r*rhogeq*rhogsol*w1i**2*w2r**2*w2i**2*w3i**2 - 2*w3r**2*rhogeq*rhogsol*w2r*w2i**2*w1i**2*w3i**2 +& w3r**4*rhogeq*rhogsol*w2i**4*w1r + w3i**3*vdsol*k*Kdrag**2*w2i**3 +& rhogeq*w1i*w3i**2*k*Kdrag*vdsol*w2r**2*w1r**2 + w3r**3*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w2r -& w3i**3*vgsol*k*Kdrag**2*w2i**3 + w3r**4*rhogeq**2*k*vgsol*w2r*w2i**2*w1r - w3r**3*Kdrag*rhogsol*w2i**4*w1i -& 2*w3r**2*rhogeq*rhogsol*w2r*w2i**2*w1r**2*w3i**2 - w3r**3*rhogeq*k*Kdrag*vdsol*w2r*w2i**2*w1i -& w3r**3*rhogeq*rhogsol*w2i**4*w1i**2 + 2*w3i**2*rhogsol*k**4*cs**4*rhogeq*w2r*w1i**2 +& 2*w2i*w3r**2*Kdrag*rhogsol*w2r**2*w1r*w3i**2 - w1r*Kdrag*rhogsol*k**2*cs**2*w2i**3*w3i**2 +& 2*w3r*rhogeq**2*k*vgsol*w2r**2*w2i**2*w1r*w3i**2 - w3r**3*rhogeq*rhogsol*w2i**4*w1r**2 -& w1r*Kdrag*rhogsol*k**2*cs**2*w2i**3*w3r**2 - 2*w3r*rhogeq**2*k*vgsol*w2r*w2i**2*w1r**2*w3i**2 -& w3i**4*rhogeq**2*vgsol*k*w2i**4 + w3r**4*Kdrag*rhogsol*w2i**3*w1r - w3r**4*rhogeq**2*vgsol*k*w2i**4 +& w3i**4*Kdrag*rhogsol*w2i**3*w1r - w3r*rhogeq*cs**4*k**4*w2r**2*rhogsol*w3i**2) !--break to avoid too many continuation lines rhod1r = rhod1r + (& 2*w3r*rhogeq**2*k*vgsol*w2r*w2i**2*w1i**2*w3i**2 + w3i**4*rhogeq*rhogsol*w2i**4*w1r +& 3*w3r**3*w2r*Kdrag*rhogeq*k*vgsol*w2i**2*w1i + 2*w3r**3*rhogeq**2*k*vgsol*w2r**2*w2i**2*w1r -& 2*w3r**3*rhogeq**2*k*vgsol*w2r*w2i**2*w1r**2 + 2*w3r**3*rhogeq**2*k*vgsol*w2r*w2i**2*w1i**2 -& 2*w3r**4*rhogeq**2*k*vgsol*w2i**2*w2r**2 - 2*w3r**3*rhogeq*rhogsol*w2i**2*w1r**2*w2r**2 +& w3r*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w2r*w3i**2 - 2*w3r**3*rhogeq*rhogsol*w1i**2*w2r**2*w2i**2 +& w1r*w3r**4*cs**2*k**2*rhogeq*rhogsol*w2i**2 + w1r*w3i**4*cs**2*k**2*rhogeq*rhogsol*w2i**2 +& 2*rhogeq**2*w1i**2*k*vgsol*w3r*w2r**3*w3i**2 + w2i*w3r**4*Kdrag*rhogsol*w2r**2*w1r -& 2*w3r**2*rhogeq*w2r**3*w1r**2*rhogsol*w3i**2 - w3r**3*rhogeq*cs**4*k**4*w2r**2*rhogsol +& w1r**3*rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r - 2*w3r**3*rhogeq**2*w1r**2*k*vgsol*w2r**3 +& 2*rhogeq**2*w1i**2*k*vgsol*w3r**3*w2r**3 - w2i*w3r**3*Kdrag*k*rhogeq*vgsol*w2r**2*w1r -& rhogeq*w1i*w3r**3*w2r**3*k*Kdrag*vdsol - 2*w3r*rhogeq**2*w1r**2*k*vgsol*w2r**3*w3i**2 +& w2r*w3r**3*rhogeq**2*cs**2*k**3*w1r**2*vgsol - w2r*w3r**3*rhogeq**2*cs**2*k**3*w1i**2*vgsol -& w1i**3*rhogeq*w2r**2*k*Kdrag*vgsol*w3i**2 + 2*w1r*w3i**2*cs**2*k**2*rhogeq*rhogsol*w2i**2*w3r**2 +& w2r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r**4 - rhogeq*w3i**4*cs**2*k**2*rhogsol*w1r*w2r**2 -& 2*w2r*w3r**2*Kdrag*rhogsol*w1i*w2i**2*w3i**2 - w2r*w3r**4*rhogeq**2*cs**2*k**3*w1r*vgsol -& rhogeq*w1i*w3r*w2r**3*k*Kdrag*vdsol*w3i**2 + w2r*w3r**3*rhogeq*cs**4*k**4*w1r*rhogsol -& Kdrag*w3r*w2r**4*rhogsol*w1i*w3i**2 - w3r*w2r**3*k*Kdrag**2*vdsol*w3i**2 + w3r*w2r**3*k*Kdrag**2*vgsol*w3i**2 +& rhogeq*rhogsol*w2r*w2i**2*w1i**3*w3i**3 - 4*rhogeq**2*w2r**3*k*w1r*vgsol*w3i**3*w1i +& w2r**2*k*Kdrag**2*vdsol*w3i**2*w1i**2 - w3r*rhogeq*w2r**4*w1r**2*rhogsol*w3i**2 -& rhogeq*w1i**2*w3r*w2r**4*rhogsol*w3i**2 + w3r*rhogeq**2*w2r**4*k*w1r*vgsol*w3i**2 -& w2r**2*k*Kdrag**2*vgsol*w3i**2*w1i**2 - Kdrag*rhogsol*k**2*cs**2*w1i*w2r**3*w3r**2 +& w2r*w3r**3*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol - w2r*w3r**3*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol +& w2r*w3r**4*cs**2*k**2*rhogeq*rhogsol*w1r**2 + 2*w2r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w3r**2*w3i**2 -& w3r**4*rhogeq*rhogsol*k**2*cs**2*w2r**2*w1r - rhogeq**2*w1i**4*k*vgsol*w3i**2*w2r**2 -& Kdrag*rhogsol*k**2*cs**2*w1i*w2r**3*w3i**2 + w2r*w3r*rhogeq**2*cs**2*k**3*w1r**2*vgsol*w3i**2 -& w2r*w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w3i**2 - w2r*w3r**4*Kdrag*rhogsol*w1i*w2i**2 +& rhogeq*w2r*w3i**3*w1r*k*Kdrag*vdsol*w2i**2 - 2*w2r*w3r**2*rhogeq**2*cs**2*k**3*w1r*vgsol*w3i**2 +& rhogeq**2*w3i**3*w1i**3*k*vgsol*w2r**2 + rhogeq*w2r*w3i**4*cs**2*k**2*rhogsol*w1r**2 +& w2r*w3r*rhogeq*cs**4*k**4*w1r*rhogsol*w3i**2 - 2*w2r*rhogeq*w1i**3*rhogsol*k**2*cs**2*w3i**3 -& rhogeq*cs**2*k**3*w3i**3*Kdrag*vdsol*w2r**2 + rhogeq*cs**4*k**4*w2r*rhogsol*w2i**2*w3i**2 +& w3r**3*rhogeq**2*w2r**4*k*w1r*vgsol - w1r**2*rhogeq*w2r**2*w1i*k*Kdrag*vgsol*w3i**2 -& rhogeq*cs**4*k**4*w2r*rhogsol*w2i**2*w3r**2 + 2*rhogeq**2*cs**2*k**3*w2r**2*vgsol*w1r**2*w3i**2 +& rhogeq*cs**2*k**3*w3i**3*Kdrag*vdsol*w2r*w1r + 2*rhogeq**2*w3i**3*w2r**2*w1i*k*vgsol*w2i**2 -& rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r**2*w3r**2 - w1r**2*w3i*rhogsol*k**4*cs**4*rhogeq*w2r*w1i -& 2*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2r**2*w3i**2 + rhogeq*cs**4*k**4*w2r**3*rhogsol*w3i**2 -& rhogeq*cs**4*k**4*w2r**3*rhogsol*w3r**2 + 2*w2r*w3r**2*cs**2*k**2*rhogeq*rhogsol*w1r**2*w3i**2 +& 2*w3r**2*rhogeq*w2r**4*w1r*rhogsol*w3i**2 - 2*w3r**2*rhogeq**2*w2r**4*vgsol*k*w3i**2 -& 2*rhogeq*w3i**2*cs**2*k**2*rhogsol*w1r*w2r**2*w3r**2 + rhogeq*w2i*w3i**3*w1i*k*Kdrag*vdsol*w2r**2 +& rhogeq*cs**2*k**3*w3i**3*Kdrag*vgsol*w2r**2 + rhogeq*cs**2*k**2*w2r**4*w1r*rhogsol*w3i**2 -& rhogeq*cs**2*k**2*w2r**4*w1r*rhogsol*w3r**2 + 2*rhogeq**2*cs**2*k**3*w2r**2*vgsol*w2i*w1i*w3i**2 -& 2*w2i*w3r*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r*w3i**2 + rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r**2*w3r**2 -& rhogeq*cs**2*k**3*w3i**3*Kdrag*vgsol*w2r*w1r + w2r*w3r**3*w2i**2*k*Kdrag**2*vgsol) !--break to avoid too many continuation lines rhod1r = rhod1r + (& rhogeq**2*w3i*w2r**4*w1i*k*vgsol*w3r**2 + rhogeq**2*w2r**3*w3i**4*k*w1r*vgsol +& 2*rhogeq*w2r**2*w3i**4*w1r*rhogsol*w2i**2 + rhogeq**2*w3i**3*w2r**4*w1i*k*vgsol -& 2*rhogeq*w2r*w3i**4*cs**2*k**2*rhogsol*w2i*w1i - w2r*w3r**3*w2i**2*k*Kdrag**2*vdsol -& rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2r**2*w3r**2 - rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w2r**2*w3i**2 +& rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w2r**2*w3r**2 + rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2r**2*w3i**2 +& w2r*w3r*w2i**2*k*Kdrag**2*vgsol*w3i**2 - rhogeq*cs**4*k**4*w1r*rhogsol*w2r**2*w3i**2 +& 3*rhogeq*cs**4*k**4*w1r*rhogsol*w2r**2*w3r**2 + rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2r**2*w3r**2 -& rhogeq*w2r*w3i**4*w1r**2*rhogsol*w2i**2 - 4*rhogeq*cs**4*k**4*w2r*rhogsol*w2i*w1i*w3i**2 -& 2*rhogeq**2*cs**2*k**3*w2r**3*w1r*vgsol*w3r**2 + rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w2r**2*w3i**2 +& Kdrag*k*rhogeq*vgsol*w2r**4*w1i*w3i**2 + Kdrag*k*rhogeq*vgsol*w2r**4*w1i*w3r**2 -& rhogeq**2*cs**2*k**3*w3i**3*w2i*vgsol*w2r**2 + w1i**3*w3r**3*rhogeq*rhogsol*w2i**3 +& 2*rhogeq**2*w2i*k*vgsol*w3i**3*w1r**2*w2r**2 - w2r*w3r*w2i**2*k*Kdrag**2*vdsol*w3i**2 -& rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w2r**2*w3r**2 - rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2r**2*w3i**2 -& w3i**4*cs**2*k**3*rhogeq**2*vgsol*w2r*w1r + 2*rhogeq*cs**2*k**2*w2r**2*w1r*rhogsol*w2i**2*w3i**2 -& 2*rhogeq*cs**2*k**2*w2r**2*w1r*rhogsol*w2i**2*w3r**2 + 2*rhogeq**2*w3i*w2r**2*w1i*k*vgsol*w2i**2*w3r**2 -& w3i**3*vgsol*k*Kdrag**2*w2i*w2r**2 + w3i**3*rhogsol*k**2*cs**2*Kdrag*w2r*w2i**2 +& w3i*rhogsol*k**2*cs**2*Kdrag*w2r**3*w3r**2 + w3i**3*rhogsol*k**2*cs**2*Kdrag*w2r**3 +& w3i**4*cs**2*k**3*rhogeq**2*vgsol*w2r**2 - rhogeq**2*cs**2*k**3*w3i*w2i*vgsol*w2r**2*w3r**2 +& 2*rhogeq**2*w2i*k*vgsol*w3i*w1r**2*w2r**2*w3r**2 - w3i*vgsol*k*Kdrag**2*w2i*w2r**2*w3r**2 +& w3i*Kdrag*rhogsol*w2r**4*w1r*w3r**2 - 2*w3r*rhogeq*cs**2*k**2*w1i**3*w2r**2*rhogsol*w3i +& 2*w3r*rhogeq**2*cs**2*k**3*w2r**3*vgsol*w3i*w1i - 2*w3r*w1r**2*w2i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r -& 2*w3r*w1i**3*w2i*rhogeq*cs**2*k**2*rhogsol*w2r**2 + 2*w3r*w1r**2*w2i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r +& 2*w3r*w1i**2*rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol + w3r*rhogeq*w1i**3*w3i**2*rhogsol*w2i*w2r**2 +& w3i*rhogsol*k**2*cs**2*Kdrag*w2r*w2i**2*w3r**2 + 2*w3r*w2r*w1i**3*rhogeq**2*cs**2*k**3*vgsol*w2i +& 2*w3r*w2r*rhogeq**2*cs**2*k**3*w1i**3*vgsol*w3i + w3r*w1i**4*rhogeq*cs**2*k**2*w2r**2*rhogsol +& 2*w3r*w2r*w1r**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i + w3r*w1i**2*rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol +& w3r*rhogeq*w2r**3*w1r**3*rhogsol*w3i**2 - 2*w3r*w2r*rhogeq*cs**2*k**3*w1i**2*Kdrag*vdsol*w3i +& 2*w3r*w2r*rhogeq*cs**2*k**3*w1i**2*Kdrag*vgsol*w3i - 2*w3r*w2r*cs**2*k**2*rhogeq*rhogsol*w1r**3*w3i**2 +& 2*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2r**2*w1r - 2*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2r**2*w1r +& 2*w3r*rhogeq**2*cs**2*k**3*w2r**2*vgsol*w2i*w1i*w1r - 2*w3r*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**3*w1r +& 4*w3r*rhogeq*rhogsol*k**2*cs**2*w2r**3*w1r*w3i*w1i + 2*w3r*w2r*Kdrag*rhogsol*w1i*w2i**2*w3i**2*w1r -& 2*w3r*w1r**2*rhogeq*cs**4*k**4*w2r**2*rhogsol + w3r*rhogeq*rhogsol*w2r*w2i**2*w1i**2*w3i**2*w1r -& w3r*w1r**2*w2r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol + w3r*w1r**2*w2r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol +& 2*w3r*w2r*rhogeq**2*cs**2*k**3*w1r**2*vgsol*w3i*w1i - 2*w3r*w2r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w3i**2*w1r +& w3r*rhogeq*rhogsol*w2r*w2i**2*w1r**3*w3i**2 - 4*w3r*rhogsol*k**4*cs**4*rhogeq*w2r*w2i*w3i*w1r +& w3r*w1r**3*rhogeq**2*cs**2*k**3*w2r**2*vgsol + w3r*rhogeq**2*w3i**2*k*w1r**3*vgsol*w2r**2 -& 4*w3r*rhogeq**2*cs**2*k**3*w2r**2*w1r*vgsol*w3i*w1i - 2*w3r*rhogeq*cs**2*k**2*w2r**2*w1r**2*rhogsol*w3i*w1i +& 2*w3r*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w2r*w3i*w1i + 4*w3r*w2i*cs**2*k**2*rhogeq*rhogsol*w2r*w1i*w3i**2*w1r -& 2*w3r*w1i**2*rhogeq*cs**2*k**2*rhogsol*w2r*w2i**2*w1r - 2*w3r*w1i**2*w2i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2r +& 2*w3r*w1i**2*w2i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r + w3r*rhogeq*w1i**2*w2r**3*rhogsol*w3i**2*w1r -& 2*w3r*rhogeq**2*cs**2*k**3*w3i*w2i*vgsol*w2r**2*w1r + w3r**3*rhogeq*w2r**3*w1r**3*rhogsol -& 2*w3r**3*rhogeq*w2r**2*w1i*k*Kdrag*vgsol*w1r - w3i*rhogsol*k**4*cs**4*rhogeq*w2r*w1i*w3r**2) !--break to avoid too many continuation lines rhod1r = rhod1r + (& w3i*vdsol*k*Kdrag**2*w2i*w2r**2*w3r**2 + 2*rhogeq*w2r**2*w3i**3*w1r**2*k*Kdrag*vgsol -& 4*w3r*rhogeq**2*cs**2*k**3*w2r*w1i**2*vgsol*w2i*w3i - w3r*w1r**4*w2r*rhogeq**2*cs**2*k**3*vgsol +& 4*w3r*w2i**2*cs**2*k**2*rhogeq*rhogsol*w2r*w1i*w1r*w3i + w3r*w1r**3*w2r*rhogeq*cs**4*k**4*rhogsol -& w3i**3*vgsol*k*rhogeq*Kdrag*w2r**4 - 2*w3r*rhogeq*w2r**2*w1i*k*Kdrag*vgsol*w3i**2*w1r +& w3r*rhogeq**2*w3i**2*k*w1r*vgsol*w2r**2*w1i**2 + 4*w3r*rhogeq**2*cs**2*k**3*w2r*w1r**2*vgsol*w2i*w3i +& 2*w3r*cs**2*k**3*rhogeq**2*w2r*vgsol*w2i*w1i*w3i**2 - 2*w3r*w2r**3*rhogeq*w1i**2*rhogsol*k**2*cs**2*w1r -& 2*w3r*w2r**3*cs**2*k**2*rhogeq*rhogsol*w1r**3 + rhogeq*w2r**3*w1r**2*rhogsol*w3i**3*w1i -& 2*w3r*rhogeq*cs**2*k**3*w3i*Kdrag*vdsol*w2r*w1r**2 - 4*w3r*w2i*rhogeq**2*k*vgsol*w2r**2*w1i*w3i**2*w1r -& 2*w3r*w1r**3*rhogeq*cs**2*k**2*rhogsol*w2r*w2i**2 - 2*w3r*w2i*w1i*rhogeq**2*cs**2*k**3*w1r*vgsol*w3i**2 +& w3i**3*vdsol*k*Kdrag**2*w2i*w2r**2 + 2*rhogeq*w2r**2*w3i*w1r**2*k*Kdrag*vgsol*w3r**2 -& 2*w3r*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1r**3 - 2*w3r*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**2*w1r +& 4*w3r*rhogeq**2*cs**2*k**3*w3i*w1i*vgsol*w2i**2*w1r + 2*w3r*rhogeq*cs**2*k**3*w3i*Kdrag*vgsol*w2r*w1r**2 +& 2*w3r*Kdrag*rhogsol*w2r**3*w1i*w3i**2*w1r - 2*w3r*w1i**2*w2r*rhogeq**2*cs**2*k**3*w1r**2*vgsol +& w3r*w1i**2*w2r*rhogeq*cs**4*k**4*w1r*rhogsol + w3r*w1i**3*w2r*rhogeq*cs**2*k**3*Kdrag*vdsol -& w3r*w1i**3*w2r*rhogeq*cs**2*k**3*Kdrag*vgsol - w3r*w1i**4*w2r*rhogeq**2*cs**2*k**3*vgsol +& w3r*rhogeq*w1i*w3i**2*rhogsol*w2i*w2r**2*w1r**2 - 2*w3r*w1r**2*w2i*rhogeq*cs**2*k**2*rhogsol*w2r**2*w1i +& Kdrag*w2i**2*rhogsol*w1i**2*w2r*w3i**3 + Kdrag*w2i**2*rhogsol*w1i**2*w2r*w3i*w3r**2 -& Kdrag*w2i**2*rhogsol*w3i*w2r*w1r**2*w3r**2 - Kdrag*w2i**2*rhogsol*w3i**3*w2r*w1r**2 -& Kdrag*w2r**2*k*rhogeq*vgsol*w2i*w3i**4 - w3i*vgsol*k*rhogeq*Kdrag*w2r**4*w3r**2 +& 2*w1r**3*rhogeq*cs**2*k**2*rhogsol*w2i**2*w3i**2 + Kdrag*w2r**3*rhogsol*w1i**2*w3i*w3r**2 -& w1r**3*w3i**3*rhogeq*rhogsol*w2i**3 - 4*w3r**3*w2i*rhogeq**2*k*vgsol*w2r**2*w1i*w1r -& w3i**3*rhogsol*k**4*cs**4*rhogeq*w2r*w1i + rhogeq*cs**2*k**2*w1i**2*w2r*rhogsol*w3i**4 -& w2r**3*k*Kdrag**2*vgsol*w1r*w3r**2 - 2*w1i**2*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w3i**2 -& 2*rhogeq**2*w1i**2*w2r**2*k*vgsol*w2i*w3i**3 - w2r**2*k*Kdrag**2*vdsol*w3i**3*w1i +& w2i**2*k*Kdrag**2*vdsol*w2r*w1r*w3i**2 + w1i**4*w2r*rhogeq*rhogsol*k**2*cs**2*w3i**2 +& w2r**2*k*Kdrag**2*vgsol*w3i**3*w1i + w2i**2*k*Kdrag**2*vdsol*w2r*w1r*w3r**2 -& 2*rhogeq**2*w1i**2*w2r**2*k*vgsol*w2i*w3i*w3r**2 + w2r**3*k*Kdrag**2*vdsol*w1r*w3i**2 -& w1r**2*vdsol*Kdrag*k*rhogeq*w2i**3*w3i**2 - w1r**2*vdsol*Kdrag*k*rhogeq*w2i**3*w3r**2 +& w2r**3*k*Kdrag**2*vdsol*w1r*w3r**2 - Kdrag*w2r**2*rhogsol*k**2*cs**2*w2i*w1r*w3i**2 -& w1r**2*Kdrag*k*rhogeq*vgsol*w1i*w2i**2*w3i**2 - w2i**2*k*Kdrag**2*vgsol*w2r*w1r*w3i**2 -& w2i**2*k*Kdrag**2*vgsol*w2r*w1r*w3r**2 - w1r**2*Kdrag*k*rhogeq*vgsol*w1i*w2i**2*w3r**2 -& Kdrag*w2r**2*rhogsol*k**2*cs**2*w2i*w1r*w3r**2 + w2i**2*k*Kdrag**2*vgsol*w3i**3*w1i +& 2*w3r*w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w1r**2 - w2i**2*k*Kdrag**2*vdsol*w3i**3*w1i +& w2i**2*k*Kdrag**2*vdsol*w3r**3*w1r - 2*w3r**3*w2r*cs**2*k**2*rhogeq*rhogsol*w1r**3 +& 2*w3r**3*w2r*Kdrag*rhogsol*w1i*w2i**2*w1r - w3i**4*rhogeq**2*cs**2*k**3*vgsol*w2i**2 -& Kdrag*w2i**2*k*rhogeq*vgsol*w2r*w3i**3*w1r + 2*Kdrag*w2i*vgsol*k*rhogeq*w1r**2*w2r**2*w3i**2 +& w3r**3*rhogeq*w2i*rhogsol*w1i*w2r**2*w1r**2 - 2*w3r**3*w2r*rhogeq*w1i**2*rhogsol*k**2*cs**2*w1r +& 2*Kdrag*w2i*vgsol*k*rhogeq*w1r**2*w2r**2*w3r**2 - Kdrag*w2r**3*k*rhogeq*vgsol*w3i*w1r*w3r**2 -& 2*rhogeq**2*w2r**2*w3i**4*k*vgsol*w2i**2 - Kdrag*w2i**2*rhogsol*w1i*w2r*w3i**4 -& rhogeq*w1i**2*w2i**2*rhogsol*w2r*w3i**4 - Kdrag*w2r**3*rhogsol*w3i*w1r**2*w3r**2) !--break to avoid too many continuation lines rhod1r = rhod1r + (& Kdrag*w2r**2*k*rhogeq*vgsol*w2i*w3i**3*w1i - 2*rhogeq*w1i**2*w2r**3*rhogsol*w3i**2*w3r**2 -& w2r**2*k*Kdrag**2*vdsol*w3i*w1i*w3r**2 + Kdrag*w2r**2*rhogsol*w2i*w1r*w3i**4 +& w2r**2*k*Kdrag**2*vgsol*w3i*w1i*w3r**2 - w2r**3*k*Kdrag**2*vgsol*w1r*w3i**2 +& 4*w3i**3*cs**2*k**2*rhogeq*rhogsol*w2i*w2r*w1i**2 + Kdrag*k*rhogeq*vgsol*w2r**2*w1i*w3i**4 +& 2*w3r**3*cs**2*k**3*rhogeq**2*w2r*vgsol*w2i*w1i + w3r**3*rhogeq*w2i*rhogsol*w1i**3*w2r**2 +& 2*w3r**3*Kdrag*rhogsol*w2r**3*w1i*w1r - Kdrag**2*k*vdsol*w2i*w1i*w2r**2*w3r**2 +& w3r**3*rhogeq**2*k*w1r**3*vgsol*w2r**2 + w3r*rhogeq*cs**2*k**2*w1r**4*rhogsol*w2i**2 +& Kdrag**2*k*vgsol*w2i*w1i*w2r**2*w3i**2 - 2*cs**2*k**3*rhogeq**2*vgsol*w2r*w1r*w2i**2*w3r**2 +& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w1r**3 + w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i*w1i*w1r**2 -& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w1r**3 + Kdrag**2*k*vgsol*w2i*w1i*w2r**2*w3r**2 +& w3r**3*rhogeq**2*k*w1r*vgsol*w2r**2*w1i**2 + rhogeq*w2r**3*w3i**3*w1r*k*Kdrag*vdsol +& 2*rhogsol*k**4*cs**4*rhogeq*w2r*w2i*w3i**3 + 2*rhogsol*k**4*cs**4*rhogeq*w2r*w2i*w3i*w3r**2 -& w2i**2*k*Kdrag**2*vgsol*w3r**3*w1r - Kdrag*w2r**2*rhogsol*k**2*cs**2*w3i*w1r*w3r**2 +& rhogeq**2*w1i*w2r**2*k*vgsol*w2i*w3i**4 - Kdrag*w2r**2*rhogsol*k**2*cs**2*w3i**3*w1r -& Kdrag*w2r**3*k*rhogeq*vgsol*w3i**3*w1r - w3i**4*vgsol*k*rhogeq*Kdrag*w2i**3 +& w3i*vdsol*k*Kdrag**2*w2i**3*w3r**2 - w3i*vgsol*k*Kdrag**2*w2i**3*w3r**2 +& 2*w2i**3*w1i*w3r*rhogeq**2*cs**2*k**3*w1r*vgsol + w3r**4*rhogeq**2*vgsol*k*w2i**3*w1i -& w3r*Kdrag*rhogsol*w2i**4*w1i*w3i**2 - Kdrag*rhogsol*k**2*cs**2*w1i*w2r*w2i**2*w3i**2 -& w2i**2*k*Kdrag**2*vgsol*w3r*w1r*w3i**2 - Kdrag*rhogsol*k**2*cs**2*w3i**3*w1r*w2i**2 -& Kdrag*rhogsol*k**2*cs**2*w1i*w2r*w2i**2*w3r**2 + rhogeq*w2r**3*w3i*w1r*k*Kdrag*vdsol*w3r**2 -& w3r**4*vgsol*k*rhogeq*Kdrag*w2i**3 + w2i**2*k*Kdrag**2*vgsol*w3i*w1i*w3r**2 +& 2*w3r*rhogeq*cs**2*k**2*w1i**2*rhogsol*w2i**2*w1r**2 - w2i**2*k*Kdrag**2*vdsol*w3i*w1i*w3r**2 +& w1i**3*rhogeq**2*cs**2*k**3*w3i*vgsol*w2r**2 + w2i**2*k*Kdrag**2*vdsol*w3r*w1r*w3i**2 -& 2*w3i**2*rhogeq**2*cs**2*k**3*vgsol*w2i**2*w3r**2 + 4*w3r**3*w2i*cs**2*k**2*rhogeq*rhogsol*w2r*w1i*w1r +& Kdrag*w2i**2*vgsol*k*rhogeq*w1i*w3r**4 + w3r**3*rhogeq*rhogsol*w2r*w2i**2*w1i**2*w1r -& 2*Kdrag*w2r**2*k*rhogeq*vgsol*w2i**2*w3i**3 + w2r*rhogeq**2*vgsol*k*w2i**2*w1r*w3i**4 -& Kdrag**2*k*vdsol*w2i*w1i*w2r**2*w3i**2 - 2*w2i**3*w1i**3*w3r*rhogeq*cs**2*k**2*rhogsol +& w3r**3*vdsol*Kdrag*k*rhogeq*w2i**3*w1r + 2*cs**2*k**3*rhogeq**2*vgsol*w2i**3*w1i*w3i**2 +& 2*w3i**2*Kdrag*rhogsol*w2i**3*w1r*w3r**2 - Kdrag*rhogsol*k**2*cs**2*w3i*w1r*w2i**2*w3r**2 +& 2*Kdrag*w2i**2*vgsol*k*rhogeq*w1i*w3r**2*w3i**2 - w3r*rhogeq*cs**4*k**4*rhogsol*w2i*w1i*w1r**2 -& w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w1r**3 + 2*w3r**2*rhogeq**2*vgsol*k*w2i**3*w1i*w3i**2 -& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i*w1i*w1r**2 + w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1r**4 -& 2*Kdrag*w2r**2*k*rhogeq*vgsol*w2i**2*w3i*w3r**2 - cs**2*k**3*rhogeq*vgsol*Kdrag*w2i**3*w3i**2 +& 2*w3r**2*rhogeq*rhogsol*w2i**4*w1r*w3i**2 + 2*Kdrag*k*rhogeq*vgsol*w2r**2*w1i*w2i**2*w3i**2 +& 2*Kdrag*k*rhogeq*vgsol*w2r**2*w1i*w2i**2*w3r**2 + w3r**3*rhogsol*k**2*cs**2*Kdrag*w2i**3 +& w3i*Kdrag*rhogsol*w2i**4*w1r*w3r**2 + cs**2*k**3*rhogeq*vgsol*Kdrag*w2i**3*w3r**2 +& w1r**2*w3r**3*rhogeq*rhogsol*w2i**3*w1i + 2*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**2*w1r**2 -& 2*w3r**2*vgsol*k*rhogeq*Kdrag*w2i**3*w3i**2 + w3r**4*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i +& w1r**2*vgsol*k*rhogeq**2*w2i**3*w1i*w3r**2 + w1r**2*vgsol*k*rhogeq**2*w2i**3*w1i*w3i**2) !--break to avoid too many continuation lines rhod1r = rhod1r + (& w1r**2*w3r*rhogeq*rhogsol*w2i**3*w1i*w3i**2 - 2*w2i*Kdrag*rhogsol*w2r**2*w1r*w3i**3*w1i +& rhogeq*rhogsol*w2r*w2i**2*w1r**2*w3i**3*w1i + w3r*rhogeq**2*k*vgsol*w2i**4*w1r*w3i**2 -& 2*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i**2*w1r + 2*w3r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i**2*w1r +& w3r**3*rhogeq**2*k*vgsol*w2i**4*w1r + cs**2*k**3*rhogeq*vdsol*Kdrag*w2i**3*w3i**2 -& cs**2*k**3*rhogeq*vdsol*Kdrag*w2i**3*w3r**2 - w3i**3*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**2 -& w3r*vgsol*k*rhogeq*Kdrag*w2i**3*w1r*w3i**2 + w3i*vgsol*k*rhogeq*Kdrag*w2i**3*w1i*w3r**2 -& w3i**3*cs**2*k**3*rhogeq**2*vgsol*w2i**3 + w3i**3*cs**2*k**3*rhogeq**2*vgsol*w2i*w1r**2 -& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**3*w3r**2 + w3r*vdsol*Kdrag*k*rhogeq*w2i**3*w1r*w3i**2 -& 2*w2i**3*w1i*w3i**3*Kdrag*rhogsol*w1r + w3r*rhogeq*cs**2*k**2*w1i**4*rhogsol*w2i**2 -& 2*w2i**3*w1i*w3r*rhogeq*cs**2*k**2*w1r**2*rhogsol - 2*w2i**2*w1i**2*w3i*cs**2*k**3*rhogeq*Kdrag*vgsol +& 2*w2i**2*w1i**2*w3i*cs**2*k**3*rhogeq*Kdrag*vdsol + 2*w3i**3*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w1i +& 2*w2i**2*w1i**2*w3r*rhogeq*cs**4*k**4*rhogsol - w3i**3*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i*w1i +& w3r*rhogsol*k**2*cs**2*Kdrag*w2i**3*w3i**2 - w3r**3*vgsol*k*rhogeq*Kdrag*w2i**3*w1r +& 2*w3r**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i*w3i**2 + w3i**3*vgsol*k*rhogeq*Kdrag*w2i**3*w1i +& 2*w2i*w1i**2*w3r*w3i*cs**4*k**4*rhogeq*rhogsol + w3i**3*rhogeq**2*k*vgsol*w2i**4*w1i -& 2*w2i**3*w1i*w3i*w3r**2*Kdrag*rhogsol*w1r + w3r**3*rhogeq*w1i**2*w2r**3*rhogsol*w1r +& w3r**3*rhogeq*rhogsol*w2r*w2i**2*w1r**3 + rhogeq*rhogsol*k**2*cs**2*w2i**4*w1r*w3i**2 -& rhogeq*rhogsol*k**2*cs**2*w2i**4*w1r*w3r**2 + w3i*vdsol*Kdrag*k*rhogeq*w2i**3*w1i*w3r**2 -& w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w1r*w1i**2 + w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i*w1i**3 +& w3i**3*vdsol*Kdrag*k*rhogeq*w2i**3*w1i + w3r*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w1r*w1i**2 -& 2*w3r**2*rhogeq**2*vgsol*k*w2i**4*w3i**2 - w3r*rhogeq*cs**4*k**4*rhogsol*w2i*w1i**3 -& w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w1r*w1i**2 + w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**4 -& w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i*w1i**3 - w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1i**2*w3r**2 +& w3i*cs**2*k**3*rhogeq**2*vgsol*w2i*w1r**2*w3r**2 + 2*w3i*cs**2*k**3*rhogeq**2*vgsol*w2i**2*w1i*w3r**2 +& 2*w3i*rhogsol*k**4*cs**4*rhogeq*w1i*w2i**2*w1r + 2*w3i*rhogeq**2*k*vgsol*w2i**3*w1r**2*w3r**2 -& 2*w3i*rhogeq**2*k*vgsol*w2i**3*w1i**2*w3r**2 - 2*w3r*rhogeq*cs**2*k**2*w1r**2*rhogsol*w2i**2*w3i**2 +& w3i*rhogeq**2*k*vgsol*w2i**4*w1i*w3r**2 + w3i**4*rhogeq**2*vgsol*k*w2i**3*w1i +& 2*w3i**3*rhogeq**2*k*vgsol*w2i**3*w1r**2 - 2*w3i**3*rhogeq**2*k*vgsol*w2i**3*w1i**2 -& w3i*cs**4*k**4*rhogeq*rhogsol*w2i*w1r*w3r**2 - w3r**4*rhogeq**2*cs**2*k**3*vgsol*w2i**2 -& w3r*Kdrag*rhogsol*k**2*cs**2*w1i*w2i**2*w3i**2 + w3r**3*rhogeq*cs**4*k**4*rhogsol*w2i**2 -& w3r*rhogeq*rhogsol*w2i**4*w1r**2*w3i**2 + rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i**2*w3r**2 -& rhogeq*cs**4*k**4*w1r*rhogsol*w2i**2*w3i**2 - rhogeq*cs**4*k**4*w1r*rhogsol*w2i**2*w3r**2 -& w3r**3*rhogeq*cs**4*k**4*rhogsol*w2i*w1i + 3*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i**2*w3i**2 +& 2*w2i*w1i*rhogeq*cs**4*k**4*w1r*rhogsol*w3i**2 + 2*w2i*w1i*rhogeq*cs**4*k**4*w1r*rhogsol*w3r**2 -& 2*w2i**3*w1i*rhogeq*cs**2*k**2*w1r*rhogsol*w3i**2 + 2*w2i**3*w1i*rhogeq*cs**2*k**2*w1r*rhogsol*w3r**2 -& rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w2i**2*w3r**2 + w3i*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i**2*w3r**2 -& w3i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i**2*w3r**2 - w3i**3*cs**4*k**4*rhogeq*rhogsol*w2i*w1r -& w3r**3*Kdrag*rhogsol*k**2*cs**2*w1i*w2i**2 - w3r*rhogeq*cs**4*k**4*rhogsol*w2i*w1i*w3i**2) !--break to avoid too many continuation lines rhod1r = rhod1r + (& w3r*rhogeq*cs**4*k**4*rhogsol*w2i**2*w3i**2 - 2*w3r**2*rhogeq**2*w1i**2*k*vgsol*w2r**2*w1r**2 +& w3r**2*w1r**3*rhogeq**2*w2r**3*k*vgsol - 2*w3r**3*rhogeq*cs**2*k**2*w1r**2*rhogsol*w2i**2 -& w3r**2*w3i*rhogeq*rhogsol*w2i*w1r*w2r**2*w1i**2 - w3r**2*w3i*rhogeq*k*Kdrag*vdsol*w2r**2*w1i**2 -& w3r*rhogeq*rhogsol*w2i**4*w1i**2*w3i**2 - 4*w3r**2*rhogeq**2*k*vgsol*w2r*w2i**2*w1r*w3i*w1i -& 4*w3r**2*w2r*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i*w1r - w2i**2*k*Kdrag**2*vdsol*w1r**2*w3r**2 +& w2i**2*k*Kdrag**2*vgsol*w1r**2*w3i**2 + w2i**2*k*Kdrag**2*vgsol*w1r**2*w3r**2 -& 4*vgsol*k*rhogeq**2*w2i**3*w1i*w3i**2*w3r*w1r - 4*vgsol*k*rhogeq**2*w2i**3*w1i*w3r**3*w1r -& 2*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w2i**2*w3r**2 + 2*w2i**2*w1i*Kdrag*rhogsol*k**2*cs**2*w1r*w3r**2 +& 2*w2i**2*w1i*Kdrag*rhogsol*k**2*cs**2*w1r*w3i**2 + w2i**2*w1i**2*Kdrag**2*k*vdsol*w3r**2 -& 3*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w2i**2*w3i**2 + 2*rhogeq**2*cs**2*k**3*w1r**2*vgsol*w2i**2*w3r**2 +& w3i**3*cs**2*k**3*rhogeq*Kdrag*vdsol*w2i**2 - w2i**2*w1i**2*Kdrag**2*k*vgsol*w3r**2 +& w2i**2*w1i**2*Kdrag**2*k*vdsol*w3i**2 - w2i**2*w1i**2*Kdrag**2*k*vgsol*w3i**2 -& w3i**3*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i**2 + w3i**4*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i +& w3i**3*cs**2*k**3*rhogeq*Kdrag*vgsol*w2i*w1i - w3r**3*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w1r +& w3r**3*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w1r - w2i**2*k*Kdrag**2*vdsol*w1r**2*w3i**2 +& 2*Kdrag*w2i**2*k*rhogeq*vgsol*w3i*w1r**2*w3r**2 + 2*w1r**2*rhogeq*cs**2*k**3*w2i*Kdrag*vgsol*w3r**2 -& w1r**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i*w3i**2 + w1r**2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i*w3r**2 +& 2*Kdrag*w2i**2*k*rhogeq*vgsol*w3i**3*w1r**2 - 2*w1r**2*rhogeq**2*w1i**2*k*vgsol*w2i**2*w3i**2 -& 2*w1r**2*rhogeq**2*w1i**2*k*vgsol*w2i**2*w3r**2 + Kdrag*w2i**2*k*rhogeq*vgsol*w3i**4*w1i -& w1i**2*vdsol*Kdrag*k*rhogeq*w2i**3*w3i**2 - w1i**2*vdsol*Kdrag*k*rhogeq*w2i**3*w3r**2 +& w1i**3*vdsol*Kdrag*k*rhogeq*w2i**2*w3r**2 + w1i**3*vdsol*Kdrag*k*rhogeq*w2i**2*w3i**2 -& w1i**2*w3i**3*rhogeq*rhogsol*w2i**3*w1r - w1i**2*w3i*rhogeq*rhogsol*w2i**3*w1r*w3r**2 -& Kdrag**2*k*vdsol*w2r**2*w1r**2*w3i**2 + 2*w1i**2*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w3i**2 +& 2*w1i**2*rhogeq*cs**2*k**2*w1r*rhogsol*w2i**2*w3i**2 - 2*rhogeq**2*cs**2*k**3*vgsol*w2i*w1i*w3r**3*w1r -& 2*rhogeq*cs**2*k**2*w1r*rhogsol*w2i**2*w3i**3*w1i + Kdrag**2*k*vgsol*w2r**2*w1r**2*w3i**2 -& 2*rhogeq*cs**2*k**2*w1r*rhogsol*w2i**2*w3r**2*w3i*w1i + w1i**3*vgsol*k*rhogeq**2*w2i**3*w3r**2 +& w1i**3*vgsol*k*rhogeq**2*w2i**3*w3i**2 - 2*rhogeq**2*w1i**2*k*vgsol*w3i**2*w2r**2*w1r**2 +& 2*Kdrag*rhogsol*k**2*cs**2*w1i*w2r**2*w3i**2*w1r + 2*w3r**2*Kdrag*rhogsol*k**2*cs**2*w1i*w2r**2*w1r -& 2*w3r**2*rhogeq*cs**2*k**2*w2r**2*w1r**3*rhogsol + w1i**3*w3r*rhogeq*rhogsol*w2i**3*w3i**2 +& w3r**2*w1r**3*w2r*rhogeq**2*cs**2*k**3*vgsol - w1r**4*rhogeq**2*k*vgsol*w2i**2*w3i**2 -& w1r**4*rhogeq**2*k*vgsol*w2i**2*w3r**2 - w1i**4*rhogeq**2*k*vgsol*w2i**2*w3r**2 -& w1i**4*rhogeq**2*k*vgsol*w2i**2*w3i**2 + w1r**2*vdsol*Kdrag*k*rhogeq*w2i**2*w1i*w3r**2 -& w1r**3*w3i*rhogeq*rhogsol*w2i**3*w3r**2 + w1r**2*vdsol*Kdrag*k*rhogeq*w2i**2*w1i*w3i**2 -& 2*w1r**2*rhogeq*cs**2*k**3*w2i*Kdrag*vdsol*w3r**2 - w3r**2*w2i*rhogeq*k*Kdrag*vdsol*w2r**2*w1r**2 -& w3r**2*rhogeq**2*w1r**4*k*vgsol*w2r**2 + w3r**2*w1r**4*w2r*cs**2*k**2*rhogeq*rhogsol -& w1i**3*Kdrag*k*rhogeq*vgsol*w2i**2*w3r**2 - w1i**3*Kdrag*k*rhogeq*vgsol*w2i**2*w3i**2) !--break to avoid too many continuation lines rhod1r = rhod1r + (& rhogeq**2*w3i**3*w1i*k*vgsol*w2r**2*w1r**2 + w3r**2*rhogeq*w1i*k*Kdrag*vdsol*w2r**2*w1r**2 +& w3r**2*rhogeq*rhogsol*w2r*w2i**2*w1r**2*w3i*w1i + w3r**2*w1i**2*rhogeq**2*k*vgsol*w2r*w2i**2*w1r -& 4*w3r**2*rhogeq**2*w2r**3*k*w1r*vgsol*w3i*w1i - 2*w3r**2*w1r**2*w2i*cs**2*k**2*rhogeq*rhogsol*w2r*w1i +& w3r**2*rhogeq*w1i**3*k*Kdrag*vdsol*w2r**2 + w3r**2*rhogeq*rhogsol*w2r*w2i**2*w1i**3*w3i -& w3r**2*rhogeq**2*w1i**4*k*vgsol*w2r**2 - w3r**2*Kdrag**2*k*vgsol*w2r**2*w1i**2 +& w3r**2*Kdrag**2*k*vdsol*w2r**2*w1i**2 - 2*w3r**2*w1i**3*w2i*cs**2*k**2*rhogeq*rhogsol*w2r +& w3r**2*w1i**3*w2i*rhogeq**2*k*vgsol*w2r**2 + w3r**2*rhogeq*w2r**3*w1r**2*rhogsol*w3i*w1i +& 2*w3r**2*rhogeq*rhogsol*k**2*cs**2*w2r**2*w1r*w3i*w1i - 2*w3r**2*w2r*cs**2*k**2*rhogeq*rhogsol*w1r**2*w3i*w1i +& w3r**2*w1i**2*rhogeq**2*w2r**3*k*w1r*vgsol - 2*w3r**2*w2r*rhogeq*w1i**3*rhogsol*k**2*cs**2*w3i -& 2*w3r**2*w2i*Kdrag*rhogsol*w2r**2*w1r*w3i*w1i - 2*w3r**2*w2r*Kdrag*rhogeq*k*vgsol*w2i**2*w1i*w1r -& 2*w3r**2*Kdrag*k*rhogeq*vgsol*w2r**3*w1i*w1r - w3r**2*w3i*rhogeq*rhogsol*w2i*w1r**3*w2r**2 -& w3r**2*w1i**3*rhogeq*w2r**2*k*Kdrag*vgsol + 2*w3r**2*w2r*rhogeq**2*cs**2*k**3*w1r*vgsol*w3i*w1i -& 2*w3r**2*w2r*rhogeq*cs**2*k**3*w1i*Kdrag*vdsol*w1r + 2*w3r**2*w2r*rhogeq*cs**2*k**3*w1i*Kdrag*vgsol*w1r +& w3r**2*w1r**3*rhogeq**2*k*vgsol*w2r*w2i**2 - 2*w3r**2*w2r*rhogeq*cs**4*k**4*w1r**2*rhogsol +& w1i**3*rhogeq**2*cs**2*k**3*vgsol*w2i*w3r**2 - w1i**3*rhogeq**2*cs**2*k**3*vgsol*w2i*w3i**2 -& w3r**2*w1r**2*rhogeq*w2r**2*w1i*k*Kdrag*vgsol + rhogeq*w1i**3*w3i**2*k*Kdrag*vdsol*w2r**2 +& w3r**2*w1r**2*w2i*rhogeq**2*k*vgsol*w2r**2*w1i + w2i**2*w1r**3*w3r**3*rhogeq**2*k*vgsol +& w3r**2*Kdrag**2*k*vgsol*w2r**2*w1r**2 - w3r**2*Kdrag**2*k*vdsol*w2r**2*w1r**2 +& w3r**2*w1i**4*w2r*rhogeq*rhogsol*k**2*cs**2 - rhogeq*w3i**3*k*Kdrag*vdsol*w2r**2*w1r**2 -& w2i**2*rhogeq**2*cs**2*k**3*w3i*w1i**3*vgsol + w3r**2*rhogeq*w1i**3*w2r**3*rhogsol*w3i -& w2i**2*w3r*rhogeq**2*cs**2*k**3*w1i**2*vgsol*w1r + 2*w3r**2*w2i*rhogeq*cs**2*k**2*rhogsol*w2r**2*w1i*w1r +& w3r**2*w3i*rhogeq**2*k*vgsol*w1i*w2r**2*w1r**2 - w3r**2*w3i*rhogeq*k*Kdrag*vdsol*w2r**2*w1r**2 -& w2i**2*w3r*rhogeq**2*cs**2*k**3*w1r**3*vgsol - w3r**2*w2i*w1i**2*rhogeq*k*Kdrag*vdsol*w2r**2 -& w2i**2*rhogeq**2*cs**2*k**3*w3i*w1i*vgsol*w1r**2 - 2*w2i**2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w1i*w1r**2 -& 2*w2i**2*Kdrag*k*rhogeq*vgsol*w1i*w3r**3*w1r - 2*w2i**2*w3r*w3i*cs**2*k**2*rhogeq*rhogsol*w1i**3 -& w2i**2*w1r**2*w3i*vdsol*Kdrag*k*rhogeq*w3r**2 - 2*w3r**2*w1i**2*rhogeq*rhogsol*k**2*cs**2*w2r**2*w1r +& w3r**2*w3i*rhogeq**2*k*vgsol*w1i**3*w2r**2 - 2*w3r**2*w2r*rhogeq**2*cs**2*k**3*w1r*vgsol*w2i*w3i +& 2*w3r**2*w1i**2*w2r*cs**2*k**2*rhogeq*rhogsol*w1r**2 + w3r**2*w1i**2*w2r*rhogeq**2*cs**2*k**3*w1r*vgsol +& w2i**2*w1i**3*rhogeq**2*w3i**3*k*vgsol + w2i**2*w1i**2*w3r*rhogeq**2*k*w1r*vgsol*w3i**2 +& w2i**2*w1i**3*rhogeq**2*w3i*k*vgsol*w3r**2 + w2i**2*w1i**2*w3r**3*rhogeq**2*k*w1r*vgsol -& w2i**2*w1r**2*w3i**3*vdsol*Kdrag*k*rhogeq - 2*w2i**2*Kdrag*k*rhogeq*vgsol*w1i*w3i**2*w3r*w1r -& w2i**2*w1i**2*w3i**3*vdsol*Kdrag*k*rhogeq - w2i**2*w1i**2*w3i*vdsol*Kdrag*k*rhogeq*w3r**2 +& w2i**2*w1r**3*w3r*rhogeq**2*k*vgsol*w3i**2 + w2i**2*w1r**2*rhogeq**2*w3i**3*w1i*k*vgsol +& w2i**2*w1r**2*rhogeq**2*w3i*w1i*k*vgsol*w3r**2 - 4*w3r*w2i*cs**2*k**3*rhogeq*Kdrag*vgsol*w2r*w3i*w1i +& w3r*w1r**4*rhogeq*cs**2*k**2*w2r**2*rhogsol + rhogeq*w1i**3*w2r**3*rhogsol*w3i**3) rhod1r = rhod1r*rhodeq/(w1i**2 - 2*w3i*w1i +& w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r)/(w3r**2 + w3i**2)/Kdrag/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i - 2*w2r*w1r& + w1i**2)/rhogeq/(w2i**2 + w2r**2) rhod1i = - ( - 2*rhogsol*Kdrag*w1i**3*rhodeq*w3r**2*w2i**3 - 2*rhodsol*rhogeq*Kdrag*w3i**4*w2i**2*w2r**2 -& rhodsol*rhogeq*Kdrag*w2r**4*w3i**4 - rhodsol*rhogeq*Kdrag*w3i**4*w2i**4 -& 2*rhogsol*Kdrag*w1i**3*rhodeq*w3r**2*w2i*w2r**2 - 2*rhodsol*rhogeq*Kdrag*w2r**4*w3i**2*w3r**2 -& 2*rhogsol*Kdrag*w1i**3*rhodeq*w3r**2*w2r**2*w3i - 2*rhogsol*Kdrag*w1i**3*rhodeq*w3r**2*w2i**2*w3i -& 2*rhogsol*Kdrag*w1i**3*rhodeq*w2r**2*w3i**3 - 2*rhogsol*Kdrag*w1i**3*rhodeq*w2i**2*w3i**3 -& 2*rhogsol*Kdrag*w1i**3*rhodeq*w2i**3*w3i**2 - rhodsol*rhogeq*Kdrag*w3r**4*w2i**4 -& rhodsol*rhogeq*Kdrag*w3r**4*w2r**4 - 2*rhodsol*rhogeq*Kdrag*w3r**4*w2i**2*w2r**2 -& 4*rhodsol*rhogeq*Kdrag*w3r**2*w2i**2*w2r**2*w3i**2 - 2*rhodsol*rhogeq*Kdrag*w3i**2*w2i**4*w3r**2 -& 2*rhogsol*Kdrag*w1i**3*rhodeq*w2i*w2r**2*w3i**2 + rhogsol*rhogeq*k**4*cs**4*w1i**3*rhodeq*w3r*w2r -& rhogsol*rhogeq*k**4*cs**4*w1i**3*rhodeq*w2i*w3i + w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r**2*w2i**2 -& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r*w3r*w3i**2 -& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r*w2r*w2i**2 - w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r*w2r**3 -& w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**2*w2i**4 - w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**4*w2i**2 +& w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**4*w2r**2 - vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w3r*w2i**3 +& w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**2*w2i**4 - w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w2r**4*w3i**2 -& 2*w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**2*w2i**2*w2r**2 -& vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w3r**3*w2i - w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**4*w2i**2 +& w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**2*w2r**4 - 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w2r**2*w3i**3 +& cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3i**4*w2i +& 2*w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**2*w2i**2*w2r**2 -& 2*w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**2*w2i**2*w3i**2 +& w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**4*w2r**2 + rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w3r*w2i**2*w3i**2 +& rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w3r*w2r**2*w3i**2 + rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w2r*w2i**2*w3i**2 +& rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w2r**3*w3r**2 + rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w2r*w2i**2*w3r**2 +& rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w2r**3*w3i**2 + rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w3r**3*w2i**2 +& rhogeq*k*Kdrag*vdsol*w1i**2*rhodeq*w3r**3*w2r**2 + 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w2i**2*w3i**3 +& 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w2i*w2r**2*w3i**2 +& cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3i*w2i**4 + 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w2i**3*w3i**2 +& 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3i*w2r**2*w2i**2 +& cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3i*w2r**4 +& 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3i**2*w2i*w3r**2 +& 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3r**2*w2i**2*w3i -& 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3r**2*w2r**2*w3i -& 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3r**2*w2i*w2r**2 -& 2*cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3r**2*w2i**3 -& 2*w1i*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w2i**3*w3i -& 2*w1i*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**2*w2i**2 -& 2*w1i*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i*w2i*w3r**2 -& 2*w1i*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w2i*w3i*w2r**2 +& 2*w1i*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**2*w2r**2 -& 2*w1i*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**3*w2i) !--break to avoid too many continuation lines rhod1i = rhod1i - (& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r**2*w3i**2 + cs**2*k**2*rhogsol*w1i**2*rhogeq*rhodeq*w3r**4*w2i +& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i**3*w3i + w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3i**2*w2i**2 +& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3i**3*w2i + w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i*w3i*w2r**2 -& 3*w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r**2*w2r**2 +& 4*w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r*w2r*w2i*w3i -& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r*w3r**3 + w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3i*w2i*w3r**2 +& 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w3r*w2r**2*w2i*w3i**2 + w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w3r**2*w2r**2*w3i +& w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w3r**2*w2i**2*w3i + w1r**2*rhogsol*rhogeq*rhodeq*w2r**4*w3i**3 -& 2*rhogsol*rhogeq*k**2*cs**2*w1r*rhodeq*w2r*w3i**4*w2i + 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w3r**3*w2i*w2r**2 +& 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w3i*w2i**2*w3r**2*w2r + 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w3i*w2r**3*w3r**2 +& 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w3r*w2i**3*w3i**2 - 4*vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w2r*w2i*w3i**2 -& vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w2r*w3i**3 - 2*rhogsol*rhogeq*k**2*cs**2*w1r*rhodeq*w2r*w2i*w3r**4 -& 4*rhogsol*rhogeq*k**2*cs**2*w1r*rhodeq*w2r*w2i*w3i**2*w3r**2 -& 2*rhogsol*rhogeq*k**2*cs**2*w1r*rhodeq*w3i*w3r*w2i**4 - 2*rhogsol*rhogeq*k**2*cs**2*w1r*rhodeq*w2r**4*w3i*w3r -& 4*rhogsol*rhogeq*k**2*cs**2*w1r*rhodeq*w3r*w3i*w2r**2*w2i**2 + 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w2i**3*w3r**3 -& vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w2r*w3i*w3r**2 -& vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w3r*w2i*w3i**2 -& vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w3r*w2i*w2r**2 -& 4*vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w3i*w3r*w2i**2 - vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w2r**3*w3i& - vgsol*Kdrag*w1i*k**3*cs**2*rhogeq*rhodeq*w2r*w3i*w2i**2 +& w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w2i*w2r**2*w3i**2 + 4*w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r*w2i*w3r**2 +& w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r*w3i*w3r**2 + w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w3r*w2i*w3i**2 +& w1r**2*rhogsol*rhogeq*rhodeq*w2r**2*w2i*w3r**4 + w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w2r**2*w3i**3 +& w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w2i**2*w3i**3 + w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w3r**2*w2i*w2r**2 +& w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w3r**2*w2i**3 + 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3i**3 +& 2*w1r*w1i*rhogsol*Kdrag*rhodeq*w3i**3*w2r**3 - 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2r**3*w3r**2 -& 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2r*w2i**2*w3r**2 + w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r**3*w3i& + w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r*w3i*w2i**2 + w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r*w3i**3 +& vgsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w3r**2*w2i**2 + w1r*vgsol*k*w1i**2*rhogeq**2*rhodeq*w2i**3*w3i**2 +& w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w3r**3*w2i + w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w3r*w2i**3 +& w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w3r*w2i*w2r**2 + vgsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w3r**2*w2r**2 +& vgsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w3i**2*w2i**2 + vgsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w2r**2*w3i**2 +& 2*w1i*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**2*w2r**2*w3i**2 -& 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w3r**3*w2r**2 +& 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w3r**3*w2i**2 +& 4*w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w3i*w3r*w2r**2 -& 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w3r*w2r**2*w3i**2) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w3r*w2i**2*w3i**2 +& 4*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2r*w2i*w3r**2*w3i +& 4*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2i*w3i*w3r*w2r**2 +& 4*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2i**3*w3i*w3r - 2*w1r*vdsol*Kdrag**2*k*w1i*rhodeq*w3r**2*w2r**2 -& 2*w1r*vdsol*Kdrag**2*k*w1i*rhodeq*w3i**2*w2i**2 - 2*w1r*vdsol*Kdrag**2*k*w1i*rhodeq*w2r**2*w3i**2 -& w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r**4*w2i + 4*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2r*w2i*w3i**3 +& 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2r*w2i**2*w3i**2 - 2*w1r*vdsol*Kdrag**2*k*w1i*rhodeq*w3r**2*w2i**2& - 2*w1r**3*rhogsol*Kdrag*rhodeq*w3r**3*w2r**2 - 2*w1r**3*rhogsol*Kdrag*rhodeq*w2r**3*w3i**2 +& w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r**3*w2i**2 - w1i**4*Kdrag*rhogeq*rhodsol*w2r**2*w3i**2 -& 2*w1r**3*rhogsol*Kdrag*rhodeq*w3r**3*w2i**2 - 2*w1r**3*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3r**2 +& w1r**2*rhogsol*Kdrag*rhodeq*w2i*w2r**2*w3i**3 + w1r**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i**3 +& w1r**2*rhogsol*Kdrag*rhodeq*w3i**4*w2r**2 - w1i**4*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2 -& w1i**4*Kdrag*rhogeq*rhodsol*w3r**2*w2r**2 - w1i**4*Kdrag*rhogeq*rhodsol*w3i**2*w2i**2 +& 2*w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**2*w3i**2 + 2*w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2r**2*w3i**2 +& 3*w1r**2*rhogsol*Kdrag*rhodeq*w3r*w2r**3*w3i**2 + w1r**2*rhogsol*Kdrag*rhodeq*w2r**4*w3i**2 +& w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2r**4 + w1r**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i*w3r**2 +& w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**4 + w1r**2*rhogsol*Kdrag*rhodeq*w2i*w3i*w2r**2*w3r**2 +& 3*w1r**2*rhogsol*Kdrag*rhodeq*w2r*w3r**3*w2i**2 + 2*w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**2*w2r**2 +& 3*w1r**2*rhogsol*Kdrag*rhodeq*w2r*w3r*w2i**2*w3i**2 + 2*w1r**2*rhogsol*Kdrag*rhodeq*w3i**2*w2i**2*w2r**2 +& w1r**2*rhogsol*Kdrag*rhodeq*w3i**2*w2i**4 + w1r**2*rhogsol*Kdrag*rhodeq*w3i**4*w2i**2 +& w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w3r*w2i**2*w3i**2 + w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w3r*w2r**2*w3i**2 +& w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w2r**3*w3i**2 + w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w2r*w2i**2*w3r**2 +& w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w2r*w2i**2*w3i**2 + w1r**2*rhogsol*Kdrag*rhodeq*w3r**4*w2i**2 +& w1r**2*rhogsol*Kdrag*rhodeq*w3r**4*w2r**2 + 3*w1r**2*rhogsol*Kdrag*rhodeq*w3r**3*w2r**3 -& 2*rhogsol*rhogeq*k**2*cs**2*w1i**3*rhodeq*w3i*w2i*w3r**2 - 2*rhogsol*rhogeq*k**2*cs**2*w1i**3*rhodeq*w3i**3*w2i& - 2*rhogsol*rhogeq*k**2*cs**2*w1i**3*rhodeq*w2i*w3i*w2r**2 -& 2*rhogsol*rhogeq*k**2*cs**2*w1i**3*rhodeq*w2i**3*w3i + 2*rhogsol*rhogeq*k**2*cs**2*w1i**3*rhodeq*w3r**2*w2r**2& - 2*rhogsol*rhogeq*k**2*cs**2*w1i**3*rhodeq*w3i**2*w2i**2 + w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w3r**3*w2i**2 +& w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w3r**3*w2r**2 + w1r**2*rhogeq*k*Kdrag*vdsol*rhodeq*w2r**3*w3r**2 +& rhogsol*rhogeq*w1i**3*rhodeq*w2r*w3r*w2i**2*w3i**2 - rhogsol*rhogeq*w1i**3*rhodeq*w2i*w2r**2*w3i**3 -& rhogsol*rhogeq*w1i**3*rhodeq*w2i**3*w3i**3 + w1i**4*rhogsol*Kdrag*rhodeq*w3r**2*w2i**2 +& rhogsol*rhogeq*w1i**3*rhodeq*w2r*w3r**3*w2i**2 - rhogsol*rhogeq*w1i**3*rhodeq*w2i**3*w3i*w3r**2 -& rhogsol*rhogeq*w1i**3*rhodeq*w2i*w3i*w2r**2*w3r**2 + rhogsol*rhogeq*w1i**3*rhodeq*w3r**3*w2r**3 +& rhogsol*rhogeq*w1i**3*rhodeq*w3r*w2r**3*w3i**2 + w1i**4*rhogsol*Kdrag*rhodeq*w3r**2*w2r**2 +& w1i**4*rhogsol*Kdrag*rhodeq*w3i**2*w2i**2 + w1i**4*rhogsol*Kdrag*rhodeq*w2r**2*w3i**2 +& w1r*Kdrag*rhogeq*k*vgsol*w1i**2*rhodeq*w3r**2*w2i**2 + w1r*Kdrag*rhogeq*k*vgsol*w1i**2*rhodeq*w3r**2*w2r**2 +& w1r*Kdrag*rhogeq*k*vgsol*w1i**2*rhodeq*w3i**2*w2i**2 + w1r*Kdrag*rhogeq*k*vgsol*w1i**2*rhodeq*w2r**2*w3i**2 +& w1i*vdsol*k*Kdrag**2*rhodeq*w3r**3*w2r**2 + w1i*vdsol*k*Kdrag**2*rhodeq*w2r**3*w3r**2 +& w1i*vdsol*k*Kdrag**2*rhodeq*w2r*w2i**2*w3r**2 + w1i*vdsol*k*Kdrag**2*rhodeq*w3r*w2i**2*w3i**2 +& w1i*vdsol*k*Kdrag**2*rhodeq*w3r*w2r**2*w3i**2 + w1i*vdsol*k*Kdrag**2*rhodeq*w2r**3*w3i**2) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & w1i*vdsol*k*Kdrag**2*rhodeq*w2r*w2i**2*w3i**2 + Kdrag*cs**2*k**2*rhogsol*w1i**2*rhodeq*w2r**2*w3i**2 -& rhogsol*w1r**3*rhogeq*rhodeq*w2r*w2i**2*w3i**3 - rhogsol*w1r**3*rhogeq*rhodeq*w3i**3*w2r**3 +& w1i*vdsol*k*Kdrag**2*rhodeq*w3r**3*w2i**2 - rhogsol*w1r**3*rhogeq*rhodeq*w3r*w2r**2*w2i*w3i**2 +& Kdrag*cs**2*k**2*rhogsol*w1i**2*rhodeq*w3r**2*w2i**2 + Kdrag*cs**2*k**2*rhogsol*w1i**2*rhodeq*w3r**2*w2r**2 +& Kdrag*cs**2*k**2*rhogsol*w1i**2*rhodeq*w3i**2*w2i**2 - w1i**2*Kdrag*rhogeq*rhodsol*w3i**4*w2i**2 -& w1i**2*Kdrag*rhogeq*rhodsol*w3i**4*w2r**2 - 4*w1i**2*Kdrag*rhogeq*rhodsol*w2i**3*w3i**3 -& rhogsol*w1r**3*rhogeq*rhodeq*w3r**3*w2i*w2r**2 - 2*w1i**2*Kdrag*rhogeq*rhodsol*w3r**2*w2r**2*w3i**2 -& w1i**2*Kdrag*rhogeq*rhodsol*w2r**4*w3i**2 - 2*w1i**2*Kdrag*rhogeq*rhodsol*w3i**2*w2i**2*w2r**2 -& 4*w1i**2*Kdrag*rhogeq*rhodsol*w2i*w2r**2*w3i**3 - 4*w1i**2*Kdrag*rhogeq*rhodsol*w2i*w3i*w2r**2*w3r**2 -& w1i**2*Kdrag*rhogeq*rhodsol*w3i**2*w2i**4 - rhogsol*w1r**3*rhogeq*rhodeq*w2i**3*w3r**3 -& rhogsol*w1r**3*rhogeq*rhodeq*w3i*w2i**2*w3r**2*w2r - rhogsol*w1r**3*rhogeq*rhodeq*w3i*w2r**3*w3r**2 -& rhogsol*w1r**3*rhogeq*rhodeq*w3r*w2i**3*w3i**2 - 2*w1i**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2*w2r**2 -& 4*w1i**2*Kdrag*rhogeq*rhodsol*w2i**3*w3i*w3r**2 - w1i**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**4 -& 2*w1i**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2*w3i**2 - w1i**2*Kdrag*rhogeq*rhodsol*w3r**4*w2r**2 -& w1i**2*Kdrag*rhogeq*rhodsol*w3r**2*w2r**4 + 2*w1i*Kdrag*rhogeq*rhodsol*w2r**4*w3r**2*w3i +& 4*w1i*Kdrag*rhogeq*rhodsol*w2r**2*w3i*w3r**2*w2i**2 + 2*w1i*Kdrag*rhogeq*rhodsol*w2r**4*w3i**3 +& 2*w1i*Kdrag*rhogeq*rhodsol*w2i**4*w3i**3 + 2*w1i*Kdrag*rhogeq*rhodsol*w2r**2*w2i*w3r**4 +& 4*w1i*Kdrag*rhogeq*rhodsol*w3i**2*w2r**2*w2i*w3r**2 + 4*w1i*Kdrag*rhogeq*rhodsol*w2i**3*w3i**2*w3r**2 -& 2*w1i*rhogsol*rhogeq*rhodeq*w3i**4*w2i**2*w2r**2 - w1i*rhogsol*rhogeq*rhodeq*w2r**4*w3i**4 -& w1i*rhogsol*rhogeq*rhodeq*w3i**4*w2i**4 + 2*w1i*Kdrag*rhogeq*rhodsol*w2i**3*w3r**4 -& 2*w1i*rhogsol*rhogeq*rhodeq*w2r**4*w3i**2*w3r**2 + 2*w1i*Kdrag*rhogeq*rhodsol*w2i**4*w3r**2*w3i +& 2*w1i*Kdrag*rhogeq*rhodsol*w2i*w2r**2*w3i**4 + 2*w1i*Kdrag*rhogeq*rhodsol*w3i**4*w2i**3 +& 4*w1i*Kdrag*rhogeq*rhodsol*w2r**2*w2i**2*w3i**3 - w1i**2*Kdrag*rhogeq*rhodsol*w3r**4*w2i**2 +& 2*w1r**2*rhogsol*rhogeq*rhodeq*w2r**2*w2i**2*w3i**3 - w1i*rhogsol*rhogeq*rhodeq*w3r**4*w2i**4 +& w1r**2*rhogsol*rhogeq*rhodeq*w2i**4*w3r**2*w3i + w1r**2*rhogsol*rhogeq*rhodeq*w2r**4*w3r**2*w3i +& w1r**2*rhogsol*rhogeq*rhodeq*w2i*w2r**2*w3i**4 + w1r**2*rhogsol*rhogeq*rhodeq*w2i**4*w3i**3 +& 2*w1r**2*rhogsol*rhogeq*rhodeq*w3i**2*w2r**2*w2i*w3r**2 +& 2*w1r**2*rhogsol*rhogeq*rhodeq*w2r**2*w3i*w3r**2*w2i**2 -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w2r**2*w2i**2 + 2*w1r**2*rhogsol*rhogeq*rhodeq*w2i**3*w3i**2*w3r**2& + w1r**2*rhogsol*rhogeq*rhodeq*w3i**4*w2i**3 - w1i*rhogsol*rhogeq*rhodeq*w3r**4*w2r**4 -& 2*w1i*rhogsol*rhogeq*rhodeq*w3r**4*w2i**2*w2r**2 - 4*w1i*rhogsol*rhogeq*rhodeq*w3r**2*w2i**2*w2r**2*w3i**2 -& 2*w1i*rhogsol*rhogeq*rhodeq*w3i**2*w2i**4*w3r**2 - w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w2i**4 -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2i**3*w3i**2 - 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2i**2*w3i**3 -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3r*w2i*w3i**2 - w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i**4*w2i -& w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w2r**4 - 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w3r*w2i**2*w2r -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w3r*w2r**3 -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2i*w2r**2*w3i**2 -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i**2*w2i*w3r**2 -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r**2*w2i**2*w3i + w1r**2*rhogsol*rhogeq*rhodeq*w2i**3*w3r**4 -& 2*w1r*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3r**3*w2i - vgsol*Kdrag*rhogeq*k**3*cs**2*w1i**3*rhodeq*w2r*w3i -& w1r*rhogsol*rhogeq*w1i**2*rhodeq*w3i**3*w2r**3 + rhogsol*w1r*k**4*cs**4*rhogeq*w1i**2*rhodeq*w2i*w3r -& w1r*rhogsol*rhogeq*w1i**2*rhodeq*w3i*w2r**3*w3r**2 - w1r*rhogsol*rhogeq*w1i**2*rhodeq*w3r*w2i**3*w3i**2 -& w1r*rhogsol*rhogeq*w1i**2*rhodeq*w3r*w2r**2*w2i*w3i**2 - w1r*rhogsol*rhogeq*w1i**2*rhodeq*w3r**3*w2i*w2r**2 -& w1r*rhogsol*rhogeq*w1i**2*rhodeq*w2i**3*w3r**3 + rhogsol*rhogeq*k**2*cs**2*w1i**4*rhodeq*w2r**2*w3i -& w1r*rhogsol*rhogeq*w1i**2*rhodeq*w3i*w2i**2*w3r**2*w2r - w1r*rhogsol*rhogeq*w1i**2*rhodeq*w2r*w2i**2*w3i**3) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & rhogsol*w1r*k**4*cs**4*rhogeq*w1i**2*rhodeq*w2r*w3i - vgsol*Kdrag*rhogeq*k**3*cs**2*w1i**3*rhodeq*w2i*w3r -& w1i*rhogsol*Kdrag*rhodeq*w2i*w2r**2*w3i**4 - w1i*rhogsol*Kdrag*rhodeq*w2i**4*w3i**3 -& w1i*rhogsol*Kdrag*rhodeq*w3i**4*w2i**3 + rhogsol*rhogeq*k**2*cs**2*w1i**4*rhodeq*w2i*w3r**2 -& 2*w1i*rhogsol*Kdrag*rhodeq*w2i**3*w3i**2*w3r**2 - w1i*rhogsol*Kdrag*rhodeq*w2i**4*w3r**2*w3i -& w1i*rhogsol*Kdrag*rhodeq*w2r**4*w3r**2*w3i - w1i*rhogsol*Kdrag*rhodeq*w2r**4*w3i**3 -& 2*w1i*rhogsol*Kdrag*rhodeq*w3i**2*w2r**2*w2i*w3r**2 - 2*w1i*rhogsol*Kdrag*rhodeq*w2r**2*w3i*w3r**2*w2i**2 -& 2*w1i*rhogsol*Kdrag*rhodeq*w2r**2*w2i**2*w3i**3 + rhogsol*rhogeq*k**2*cs**2*w1i**4*rhodeq*w2i**2*w3i +& rhogsol*rhogeq*k**2*cs**2*w1i**4*rhodeq*w2i*w3i**2 + rhogsol*rhogeq*k**4*cs**4*w1r**3*rhodeq*w2i*w3r +& rhogsol*rhogeq*k**4*cs**4*w1r**3*rhodeq*w2r*w3i + rhogsol*Kdrag*w1r**4*rhodeq*w3r**2*w2i**2 +& rhogsol*Kdrag*w1r**4*rhodeq*w3r**2*w2r**2 + rhogsol*Kdrag*w1r**4*rhodeq*w3i**2*w2i**2 +& rhogsol*Kdrag*w1r**4*rhodeq*w2r**2*w3i**2 - w1i*rhogsol*Kdrag*rhodeq*w2i**3*w3r**4 -& w1i*rhogsol*Kdrag*rhodeq*w2r**2*w2i*w3r**4 - vgsol*k**3*cs**2*rhogeq**2*w1r**4*rhodeq*w2i*w3r -& vgsol*k**3*cs**2*rhogeq**2*w1r**4*rhodeq*w2r*w3i + 2*w1r**3*Kdrag*rhogeq*rhodsol*w3r*w2i**2*w3i**2 +& 2*w1r**3*Kdrag*rhogeq*rhodsol*w3r*w2r**2*w3i**2 + 2*w1r**3*Kdrag*rhogeq*rhodsol*w2r**3*w3i**2 +& 2*w1r**3*Kdrag*rhogeq*rhodsol*w2r*w2i**2*w3i**2 + 2*w1r**3*Kdrag*rhogeq*rhodsol*w3r**3*w2i**2 +& 2*w1r**3*Kdrag*rhogeq*rhodsol*w3r**3*w2r**2 + 2*w1r**3*Kdrag*rhogeq*rhodsol*w2r**3*w3r**2 +& 2*w1r**3*Kdrag*rhogeq*rhodsol*w2r*w2i**2*w3r**2 + 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w3r**3*w2r**2 +& 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w2r**3*w3r**2 + 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w2r*w2i**2*w3r**2 +& 2*w1i**3*Kdrag*rhogeq*rhodsol*w2i**2*w3i**3 + 2*w1i**3*Kdrag*rhogeq*rhodsol*w2i**3*w3i**2 +& 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w3r**3*w2i**2 + 2*w1i**3*Kdrag*rhogeq*rhodsol*w3r**2*w2i**3 +& 2*w1i**3*Kdrag*rhogeq*rhodsol*w3r**2*w2r**2*w3i + 2*w1i**3*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2*w3i +& 2*w1i**3*Kdrag*rhogeq*rhodsol*w2i*w2r**2*w3i**2 + 2*w1i**3*Kdrag*rhogeq*rhodsol*w3r**2*w2i*w2r**2 +& 2*w1i**3*Kdrag*rhogeq*rhodsol*w2r**2*w3i**3 + 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w3r*w2i**2*w3i**2 +& 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w3r*w2r**2*w3i**2 + 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w2r**3*w3i**2 +& 2*w1r*w1i**2*Kdrag*rhogeq*rhodsol*w2r*w2i**2*w3i**2 + 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w2i**2*w3i**3 +& 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w2i*w2r**2*w3i**2 + 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w2i**3*w3i**2 +& 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w2r**2*w3i**3 - 2*w1r**2*w1i**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2 -& 2*w1r**2*w1i**2*Kdrag*rhogeq*rhodsol*w3r**2*w2r**2 - 2*w1r**2*w1i**2*Kdrag*rhogeq*rhodsol*w3i**2*w2i**2 -& 2*w1r**2*w1i**2*Kdrag*rhogeq*rhodsol*w2r**2*w3i**2 + 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i*w2r**2 +& 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**3 + 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2r**2*w3i +& 2*w1i*w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2*w3i - 2*w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2*w3i**2 -& 2*w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2r**2*w3i**2 - 4*w1r**2*Kdrag*rhogeq*rhodsol*w3r*w2r**3*w3i**2 -& w1r**2*Kdrag*rhogeq*rhodsol*w2r**4*w3i**2 - 2*w1r**2*Kdrag*rhogeq*rhodsol*w3i**2*w2i**2*w2r**2 -& w1r**2*Kdrag*rhogeq*rhodsol*w3i**2*w2i**4 - w1r**2*Kdrag*rhogeq*rhodsol*w3i**4*w2i**2 -& w1r**2*Kdrag*rhogeq*rhodsol*w3i**4*w2r**2 - w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2r**4 -& 2*w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2*w2r**2 - w1r**2*Kdrag*rhogeq*rhodsol*w3r**2*w2i**4 -& 4*w1r**2*Kdrag*rhogeq*rhodsol*w2r*w3r*w2i**2*w3i**2 - w1r**2*Kdrag*rhogeq*rhodsol*w3r**4*w2i**2 -& w1r**2*Kdrag*rhogeq*rhodsol*w3r**4*w2r**2 - 4*w1r**2*Kdrag*rhogeq*rhodsol*w2r*w3r**3*w2i**2 -& 4*w1r**2*Kdrag*rhogeq*rhodsol*w3r**3*w2r**3 + 2*w1r*Kdrag*rhogeq*rhodsol*w2r*w3i**4*w2i**2) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & 4*w1r*Kdrag*rhogeq*rhodsol*w3r**3*w2r**2*w2i**2 + 4*w1r*Kdrag*rhogeq*rhodsol*w2r**3*w3i**2*w3r**2 +& 4*w1r*Kdrag*rhogeq*rhodsol*w2r*w3i**2*w2i**2*w3r**2 + 2*w1r*Kdrag*rhogeq*rhodsol*w2r*w2i**2*w3r**4 +& 2*w1r*Kdrag*rhogeq*rhodsol*w3r**3*w2i**4 - 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w3r*w2r**2*w2i*w3i**2 -& 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w2r*w2i**2*w3i**3 - 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w3i**3*w2r**3 -& 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w3r*w2i**3*w3i**2 + 2*w1r*Kdrag*rhogeq*rhodsol*w2r**3*w3r**4 +& 2*w1r*Kdrag*rhogeq*rhodsol*w3r**3*w2r**4 + 2*w1r*Kdrag*rhogeq*rhodsol*w3r*w2r**4*w3i**2 +& 2*w1r*Kdrag*rhogeq*rhodsol*w3r*w2i**4*w3i**2 + 4*w1r*Kdrag*rhogeq*rhodsol*w3r*w2r**2*w3i**2*w2i**2 +& 2*w1r*Kdrag*rhogeq*rhodsol*w2r**3*w3i**4 - 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w2i**3*w3r**3 -& 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w3i*w2i**2*w3r**2*w2r - 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w3i*w2r**3*w3r**2 -& 4*w1i*w1r*Kdrag*rhogeq*rhodsol*w3r**3*w2i*w2r**2 - vdsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w3i**2*w2i**2 -& vdsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w2r**2*w3i**2 + vdsol*Kdrag*k**3*cs**2*rhogeq*w1r**3*rhodeq*w2i*w3i -& vdsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w3r**2*w2i**2 - vdsol*Kdrag*k**3*cs**2*rhogeq*w1r**3*rhodeq*w3r*w2r -& vdsol*Kdrag*k*rhogeq*w1r**3*rhodeq*w3r**2*w2r**2 - cs**2*k**2*rhogsol*Kdrag*w1r**2*rhodeq*w3r**2*w2i**2 -& cs**2*k**2*rhogsol*Kdrag*w1r**2*rhodeq*w3r**2*w2r**2 - cs**2*k**2*rhogsol*Kdrag*w1r**2*rhodeq*w3i**2*w2i**2 -& cs**2*k**2*rhogsol*Kdrag*w1r**2*rhodeq*w2r**2*w3i**2 - 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w3r*w2i*w3i**2& - 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w3i*w3r*w2i**2 -& 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w2r**3*w3i - 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w3r**3*w2i +& 2*vgsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r*w2i*w3i -& 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w2r*w2i*w3r**2 -& 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w3i*w3r*w2r**2 -& 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w2r*w3i*w2i**2 -& 2*rhogsol*rhogeq*k**2*cs**2*w1r**3*rhodeq*w2r*w2i*w3i**2 -& 2*vdsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w3r*w2i*w3i -& 2*vdsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r*w2i*w3i -& 2*vgsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r*w3r**2 -& 2*vgsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r**2*w3r +& 2*vgsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w3r*w2i*w3i +& 2*vdsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r*w3r**2 +& 2*vdsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r**2*w3r -& 2*rhogsol*k**4*cs**4*rhogeq*w1r**2*rhodeq*w3r*w2r*w2i - 2*rhogsol*k**4*cs**4*rhogeq*w1r**2*rhodeq*w3r*w2r*w3i -& 2*rhogsol*k**4*cs**4*rhogeq*w1r**2*rhodeq*w2r**2*w3i - vgsol*k**3*cs**2*rhogeq**2*w1r**3*rhodeq*w2i*w3i**2 -& 2*rhogsol*k**4*cs**4*rhogeq*w1r**2*rhodeq*w2i*w3r**2 + 2*vgsol*k**3*cs**2*rhogeq**2*w1r**3*rhodeq*w3r*w2r*w3i +& 2*vgsol*k**3*cs**2*rhogeq**2*w1r**3*rhodeq*w3r*w2r*w2i + vgsol*k**3*cs**2*rhogeq**2*w1r**3*rhodeq*w2r**2*w3i +& w1i*vdsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r*w3i) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & w1i*vdsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2i*w3r + vgsol*k**3*cs**2*rhogeq**2*w1r**3*rhodeq*w2i*w3r**2 -& vgsol*k**3*cs**2*rhogeq**2*w1r**3*rhodeq*w2i**2*w3i - w1i*vgsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2i*w3r -& w1i*vgsol*Kdrag*rhogeq*k**3*cs**2*w1r**2*rhodeq*w2r*w3i - w1r*rhogsol*Kdrag*rhodeq*w2r**3*w3i**4 -& w1r*rhogsol*Kdrag*rhodeq*w2r*w3i**4*w2i**2 - w1r*rhogsol*Kdrag*rhodeq*w3r*w2r**4*w3i**2 -& w1r*rhogsol*Kdrag*rhodeq*w3r*w2i**4*w3i**2 - 2*w1r*rhogsol*Kdrag*rhodeq*w3r*w2r**2*w3i**2*w2i**2 -& 2*w1r*rhogsol*Kdrag*rhodeq*w3r**3*w2r**2*w2i**2 - 2*w1r*rhogsol*Kdrag*rhodeq*w2r**3*w3i**2*w3r**2 -& 2*w1r*rhogsol*Kdrag*rhodeq*w2r*w3i**2*w2i**2*w3r**2 - w1r*rhogsol*Kdrag*rhodeq*w2r**3*w3r**4 -& w1r*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3r**4 - w1r*rhogsol*Kdrag*rhodeq*w3r**3*w2i**4 -& w1r*rhogsol*Kdrag*rhodeq*w3r**3*w2r**4 - 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3r**2 -& 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w3r*w2i**2*w3i**2 - 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w2r**3*w3i**2 -& 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w3r**3*w2i**2 - 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w3r**3*w2r**2 +& w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r*w2r**2*w3i**2 + w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2r**3*w3i**2 +& w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3i**2 + w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r*w2i**2*w3i**2 -& 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w2r**3*w3r**2 - 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w3r*w2r**2*w3i**2 -& 2*w1r*w1i**2*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3i**2 + w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r**3*w2r**2 +& w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2r**3*w3r**2 + w1r*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3r**2 -& 2*w1r**3*rhogsol*Kdrag*rhodeq*w2r**3*w3r**2 - 2*w1r**3*rhogsol*Kdrag*rhodeq*w3r*w2i**2*w3i**2 -& 2*w1r**3*rhogsol*Kdrag*rhodeq*w3r*w2r**2*w3i**2 - 2*w1r**3*rhogsol*Kdrag*rhodeq*w2r*w2i**2*w3i**2 -& 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w3r**3*w2i**2 - 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w3r**3*w2r**2 -& 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w2r**3*w3r**2 - 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w2r*w2i**2*w3r**2 -& 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w3r*w2i**2*w3i**2 - 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w3r*w2r**2*w3i**2& - 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w2r**3*w3i**2 - 2*w1i**2*vgsol*rhogeq*k*Kdrag*rhodeq*w2r*w2i**2*w3i**2 +& w1i*k*vgsol*rhogeq**2*rhodeq*w2r*w3i**4*w2i**2 + w1i*k*vgsol*rhogeq**2*rhodeq*w2r**3*w3i**4 +& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*w1i**2*rhodeq*w3r*w2r -& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*w1i**2*rhodeq*w2i*w3i - vgsol*k**3*cs**2*rhogeq**2*w1i**4*rhodeq*w2i*w3r -& vgsol*k**3*cs**2*rhogeq**2*w1i**4*rhodeq*w2r*w3i + w1i*k*vgsol*rhogeq**2*rhodeq*w3r*w2r**4*w3i**2 +& w1i*k*vgsol*rhogeq**2*rhodeq*w3r*w2i**4*w3i**2 + 2*w1i*k*vgsol*rhogeq**2*rhodeq*w3r*w2r**2*w3i**2*w2i**2 +& w1i*k*vgsol*rhogeq**2*rhodeq*w2r**3*w3r**4 + w1i*k*vgsol*rhogeq**2*rhodeq*w2r*w2i**2*w3r**4 +& w1i*k*vgsol*rhogeq**2*rhodeq*w3r**3*w2i**4 - vdsol*Kdrag*k*w1r*rhogeq*w1i**2*rhodeq*w3i**2*w2i**2 -& vdsol*Kdrag*k*w1r*rhogeq*w1i**2*rhodeq*w2r**2*w3i**2 - vdsol*Kdrag*k*w1r*rhogeq*w1i**2*rhodeq*w3r**2*w2r**2 +& w1i*k*vgsol*rhogeq**2*rhodeq*w3r**3*w2r**4 + 2*w1i*k*vgsol*rhogeq**2*rhodeq*w3r**3*w2r**2*w2i**2 +& 2*w1i*k*vgsol*rhogeq**2*rhodeq*w2r**3*w3i**2*w3r**2 + 2*w1i*k*vgsol*rhogeq**2*rhodeq*w2r*w3i**2*w2i**2*w3r**2 -& 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w2i**2*w3i**3 - 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w2i*w2r**2*w3i**2 -& 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i**2 - 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w2r**2*w3i**3 -& 2*vgsol*w1r**2*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2i*w3r -& 2*vgsol*w1r**2*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2r*w3i -& vdsol*Kdrag*k*w1r*rhogeq*w1i**2*rhodeq*w3r**2*w2i**2 - 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i*w2r**2 -& 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**3 - 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2r**2*w3i -& 2*w1i*w1r**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**2*w3i - vgsol*k*w1r*rhogeq**2*rhodeq*w3i**4*w2i**3 -& 2*vgsol*k*w1r*rhogeq**2*rhodeq*w2r**2*w2i**2*w3i**3 - 2*vgsol*k*w1r*rhogeq**2*rhodeq*w2r**2*w3i*w3r**2*w2i**2 -& vgsol*k*w1r*rhogeq**2*rhodeq*w2r**4*w3i**3 - vgsol*k*w1r*rhogeq**2*rhodeq*w2i**4*w3i**3 -& vgsol*k*w1r*rhogeq**2*rhodeq*w2i**4*w3r**2*w3i - vgsol*k*w1r*rhogeq**2*rhodeq*w2r**4*w3r**2*w3i -& vgsol*k*w1r*rhogeq**2*rhodeq*w2i*w2r**2*w3i**4 - vgsol*k*w1r*rhogeq**2*rhodeq*w2r**2*w2i*w3r**4 -& 2*vgsol*k*w1r*rhogeq**2*rhodeq*w3i**2*w2r**2*w2i*w3r**2 - 2*vgsol*k*w1r*rhogeq**2*rhodeq*w2i**3*w3i**2*w3r**2 +& rhogsol*w1i*k**4*cs**4*rhogeq*w1r**2*rhodeq*w3r*w2r - rhogsol*w1i*k**4*cs**4*rhogeq*w1r**2*rhodeq*w2i*w3i) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & 2*w1i**2*rhogsol*Kdrag*rhodeq*w3i**2*w2i**2*w2r**2 - vgsol*k*w1r*rhogeq**2*rhodeq*w2i**3*w3r**4 +& 2*w1i**2*rhogsol*Kdrag*rhodeq*w3r**2*w2r**2*w3i**2 + w1i**2*rhogsol*Kdrag*rhodeq*w3r**2*w2r**4 +& 2*w1i**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**2*w2r**2 + w1i**2*rhogsol*Kdrag*rhodeq*w3r*w2r**3*w3i**2 +& w1i**2*rhogsol*Kdrag*rhodeq*w2r*w3r*w2i**2*w3i**2 + w1i**2*rhogsol*Kdrag*rhodeq*w3r**3*w2r**3 +& 3*w1i**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i*w3r**2 + w1i**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**4 +& 3*w1i**2*rhogsol*Kdrag*rhodeq*w2i*w3i*w2r**2*w3r**2 + w1i**2*rhogsol*Kdrag*rhodeq*w3r**4*w2r**2 +& 2*w1i**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**2*w3i**2 + w1i**2*rhogsol*Kdrag*rhodeq*w2r**4*w3i**2 +& w1i**2*rhogsol*Kdrag*rhodeq*w3i**2*w2i**4 + w1i**2*rhogsol*Kdrag*rhodeq*w3i**4*w2i**2 +& w1i**2*rhogsol*Kdrag*rhodeq*w3i**4*w2r**2 + 3*w1i**2*rhogsol*Kdrag*rhodeq*w2i*w2r**2*w3i**3 +& 3*w1i**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i**3 + 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w2i**3*w3i +& 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w2i*w3i*w2r**2 +& 4*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w3i**2*w2i**2 -& 8*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2r*w2i*w3i + w1i**2*rhogsol*Kdrag*rhodeq*w2r*w3r**3*w2i**2 +& 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3r**3 +& 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w3i*w2i*w3r**2 +& 4*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w3r**2*w2r**2 - w1r*vgsol*k*Kdrag**2*rhodeq*w2i**2*w3i**3 -& w1r*vgsol*k*Kdrag**2*rhodeq*w2i**3*w3i**2 - w1r*vgsol*k*Kdrag**2*rhodeq*w2r**2*w3i**3 +& 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3r*w3i**2 +& 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2r*w2i**2 +& 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2r**3 + 2*w1i*vgsol*w1r*k**3*cs**2*rhogeq**2*rhodeq*w3i**3*w2i& - w1i*rhogsol*w1r**2*rhogeq*rhodeq*w2i**3*w3i**3 + w1i**2*rhogsol*Kdrag*rhodeq*w3r**4*w2i**2 -& w1i*rhogsol*w1r**2*rhogeq*rhodeq*w2i*w3i*w2r**2*w3r**2 + w1i*rhogsol*w1r**2*rhogeq*rhodeq*w3r*w2r**3*w3i**2 +& w1i*rhogsol*w1r**2*rhogeq*rhodeq*w2r*w3r*w2i**2*w3i**2 - w1i*rhogsol*w1r**2*rhogeq*rhodeq*w2i**3*w3i*w3r**2 -& w1i*rhogsol*w1r**2*rhogeq*rhodeq*w2i*w2r**2*w3i**3 - w1r*vgsol*k*Kdrag**2*rhodeq*w3r**2*w2i*w2r**2 -& w1r*vgsol*k*Kdrag**2*rhodeq*w3r**2*w2i**3 - w1r*vgsol*k*Kdrag**2*rhodeq*w3r**2*w2r**2*w3i -& w1r*vgsol*k*Kdrag**2*rhodeq*w3r**2*w2i**2*w3i - w1r*vgsol*k*Kdrag**2*rhodeq*w2i*w2r**2*w3i**2 +& w1i*rhogsol*w1r**2*rhogeq*rhodeq*w3r**3*w2r**3 + w1i*rhogsol*w1r**2*rhogeq*rhodeq*w2r*w3r**3*w2i**2 +& vgsol*Kdrag**2*k*rhodeq*w3r*w2r**2*w2i*w3i**2 + vgsol*Kdrag**2*k*rhodeq*w2r*w2i**2*w3i**3 +& vgsol*Kdrag**2*k*rhodeq*w3i**3*w2r**3 + vgsol*Kdrag**2*k*rhodeq*w3r**3*w2i*w2r**2 +& vgsol*Kdrag**2*k*rhodeq*w3i*w2r**3*w3r**2 + vgsol*Kdrag**2*k*rhodeq*w3r*w2i**3*w3i**2 -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w3i*w3r*w2i**2 -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w3i*w3r*w2r**2 + vgsol*Kdrag**2*k*rhodeq*w2i**3*w3r**3 -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w2r*w2i*w3r**2 + vgsol*Kdrag**2*k*rhodeq*w3i*w2i**2*w3r**2*w2r -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w3r**3*w2i -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w3r*w2i*w3i**2 -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w2r**3*w3i -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w2r*w3i*w2i**2 -& 2*w1r*rhogsol*k**2*cs**2*rhogeq*w1i**2*rhodeq*w2r*w2i*w3i**2 + 2*w1i*w1r*vgsol*k*Kdrag**2*rhodeq*w3r**2*w2r**2& + 2*w1i*w1r*vgsol*k*Kdrag**2*rhodeq*w3i**2*w2i**2 + 2*w1i*w1r*vgsol*k*Kdrag**2*rhodeq*w3r**2*w2i**2 +& 2*w1i*w1r*vgsol*k*Kdrag**2*rhodeq*w2r**2*w3i**2 + vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2r*w3i**3 -& 2*vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2r*w2i*w3i**2) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & 2*vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w3i*w3r*w2r**2 - vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2r**3*w3i& - vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2r*w3i*w2i**2 + vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w3r*w2i**3& - 2*vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w3i*w3r*w2i**2 -& vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w3r**3*w2i + vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w3r*w2i*w2r**2 -& vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w3r*w2i*w3i**2 - w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w3r*w2r**2*w2i*w3i**2& - w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w2r*w2i**2*w3i**3 + vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2r*w3i*w3r**2 -& w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w3r*w2i**3*w3i**2 - w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w3i**3*w2r**3 +& 2*vgsol*k**3*cs**2*rhogeq**2*w1i**2*rhodeq*w2r*w2i*w3r**2 - w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w3r**3*w2i*w2r**2 -& w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w2i**3*w3r**3 - w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w3i*w2i**2*w3r**2*w2r -& w1i*rhogeq*k*Kdrag*vdsol*rhodeq*w3i*w2r**3*w3r**2 + vdsol*Kdrag*k**3*cs**2*rhogeq*w1i**3*rhodeq*w2i*w3r +& vdsol*Kdrag*k**3*cs**2*rhogeq*w1i**3*rhodeq*w2r*w3i +& 2*w1r*vgsol*rhogeq**2*k**3*cs**2*w1i**2*rhodeq*w3r*w2r*w2i -& w1r*vgsol*rhogeq**2*k**3*cs**2*w1i**2*rhodeq*w2i**2*w3i -& w1r*vgsol*rhogeq**2*k**3*cs**2*w1i**2*rhodeq*w2i*w3i**2 +& w1r*vgsol*rhogeq**2*k**3*cs**2*w1i**2*rhodeq*w2i*w3r**2 +& 2*w1r*vgsol*rhogeq**2*k**3*cs**2*w1i**2*rhodeq*w3r*w2r*w3i +& w1r*vgsol*rhogeq**2*k**3*cs**2*w1i**2*rhodeq*w2r**2*w3i - vgsol*k**3*cs**2*rhogeq**2*w1i**3*rhodeq*w2r*w3r**2 -& vgsol*k**3*cs**2*rhogeq**2*w1i**3*rhodeq*w2r**2*w3r - w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i**2 +& vgsol*k**3*cs**2*rhogeq**2*w1i**3*rhodeq*w2i**2*w3r + 2*vgsol*k**3*cs**2*rhogeq**2*w1i**3*rhodeq*w2r*w2i*w3i +& vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r**3*w2r**2 - vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r**3*w2i**2 +& vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r**3*w3r**2 - w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**2*w3i -& w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2r**2*w3i**3 - w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2i**2*w3i**3 -& w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w2i*w2r**2*w3i**2 +& 4*w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w2i*w3i**2 -& w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i*w2r**2 - w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r**2*w2r**2*w3i +& w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2i*w2r**2 +& 4*w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3i*w3r*w2i**2 +& w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w3i*w3r**2 +& w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2i*w3i**2 - w1i*cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r**2*w2i**3 +& vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i**2*w3i**3 + 2*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3i**4*w2i +& w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r**3*w2i + w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2i**3 +& w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r**3*w3i + w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w3i*w2i**2 +& w1i*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w3i**3 + vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2i**3*w3i**2 +& vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2r**2*w2i*w3i**2 + 2*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w3r*w2i**4 +& vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r**3*w2i*w2r**2 + vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w2r**3*w3r**2 +& 4*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i*w3i**2*w3r**2 + 2*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i*w3r**4& + vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r*w2i**2*w3i**2 + vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2i**3*w3r**3 +& vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i*w2i**2*w3r**2*w2r +& 4*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r*w3i*w2r**2*w2i**2 + 2*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r**4*w3i*w3r& + vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3i**3*w2r**3 + 2*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r*w2i*w3r**2*w3i -& vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r*w2r**2*w3i**2 - vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r*w2i**2*w3r**2& + vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r*w2i**2*w3i**2) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & 2*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i*w3i*w3r*w2r**2 +& 2*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i**3*w3i*w3r + vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r**3*w3i**2 +& 2*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r*w2i*w3i**3 - vdsol*Kdrag**2*k*rhodeq*w3r*w2r**2*w2i*w3i**2 -& vdsol*Kdrag**2*k*rhodeq*w2r*w2i**2*w3i**3 - vdsol*Kdrag**2*k*rhodeq*w3r**3*w2i*w2r**2 -& vdsol*Kdrag**2*k*rhodeq*w3i*w2i**2*w3r**2*w2r - vdsol*Kdrag**2*k*rhodeq*w3i*w2r**3*w3r**2 -& vdsol*Kdrag**2*k*rhodeq*w3r*w2i**3*w3i**2 - vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r**3*w2r**2 +& vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w3r**3*w2i**2 - vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r**3*w3r**2 -& w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w3r**3*w2r**2 - w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w2r**3*w3r**2 -& w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w2r*w2i**2*w3r**2 +& 2*w1i*w1r*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i*w3i**2 +& 2*w1i*w1r*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r**2*w3i +& 2*w1i*w1r*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i**2*w3i -& w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w3r*w2i**2*w3i**2 - w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w3r*w2r**2*w3i**2 -& w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w2r**3*w3i**2 - w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w2r*w2i**2*w3i**2 -& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2i*w3i*w2r**2 - w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2i**3*w3i -& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3i**2*w2i**2 - w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r**2*w3i**2& + 2*w1i*w1r*vgsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i*w3r**2 -& 4*w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2r*w2i*w3i -& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3i**3*w2i - w1i*w1r**2*vgsol*k*rhogeq**2*rhodeq*w3r**3*w2i**2 -& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3i*w2i*w3r**2 -& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r**2*w2i**2 +& 3*w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r**2*w2r**2 - vgsol*k*rhogeq**2*w1i**3*rhodeq*w2r*w2i**2*w3i**2 +& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w3r**3 - vgsol*k*rhogeq**2*w1i**3*rhodeq*w2r**3*w3r**2 -& vgsol*k*rhogeq**2*w1i**3*rhodeq*w2r*w2i**2*w3r**2 - vgsol*k*rhogeq**2*w1i**3*rhodeq*w3r*w2i**2*w3i**2 -& vgsol*k*rhogeq**2*w1i**3*rhodeq*w3r*w2r**2*w3i**2 - vdsol*Kdrag**2*k*rhodeq*w2i**3*w3r**3 -& vgsol*k*rhogeq**2*w1i**3*rhodeq*w3r**3*w2r**2 - vgsol*k*rhogeq**2*w1i**3*rhodeq*w2r**3*w3i**2 +& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w3r*w3i**2 +& w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2r*w2i**2 + w1r*vgsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2r**3 -& vgsol*k*rhogeq**2*w1i**3*rhodeq*w3r**3*w2i**2 - vdsol*Kdrag**2*k*rhodeq*w3i**3*w2r**3 +& w1r*vdsol*k*Kdrag**2*rhodeq*w2i**2*w3i**3 + w1r*vdsol*k*Kdrag**2*rhodeq*w2i*w2r**2*w3i**2 +& w1r*vdsol*k*Kdrag**2*rhodeq*w2i**3*w3i**2 + w1r*vdsol*k*Kdrag**2*rhodeq*w3r**2*w2r**2*w3i +& w1r*vdsol*k*Kdrag**2*rhodeq*w3r**2*w2i**2*w3i + w1r*vdsol*k*Kdrag**2*rhodeq*w2r**2*w3i**3 +& w1r*vdsol*k*Kdrag**2*rhodeq*w3r**2*w2i*w2r**2 + w1r*vdsol*k*Kdrag**2*rhodeq*w3r**2*w2i**3 +& cs**2*k**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i*w3r**2 - cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r*w2r**3*w3i**2 -& cs**2*k**2*rhogsol*Kdrag*rhodeq*w2r*w3r*w2i**2*w3i**2 - cs**2*k**2*rhogsol*Kdrag*rhodeq*w3r**3*w2r**3 +& cs**2*k**2*rhogsol*Kdrag*rhodeq*w2i*w3i*w2r**2*w3r**2 - w1r**4*Kdrag*rhogeq*rhodsol*w2r**2*w3i**2 +& vgsol*Kdrag*k**3*cs**2*rhogeq*w1r**3*rhodeq*w3r*w2r - w1r**4*Kdrag*rhogeq*rhodsol*w3i**2*w2i**2 -& vgsol*Kdrag*k**3*cs**2*rhogeq*w1r**3*rhodeq*w2i*w3i - cs**2*k**2*rhogsol*Kdrag*rhodeq*w2r*w3r**3*w2i**2 +& cs**2*k**2*rhogsol*Kdrag*rhodeq*w2i*w2r**2*w3i**3 + cs**2*k**2*rhogsol*Kdrag*rhodeq*w2i**3*w3i**3 +& 2*w1i**2*rhogsol*rhogeq*rhodeq*w2i**3*w3i**2*w3r**2 + w1i**2*rhogsol*rhogeq*rhodeq*w2i**4*w3r**2*w3i +& w1i**2*rhogsol*rhogeq*rhodeq*w2r**4*w3r**2*w3i + w1i**2*rhogsol*rhogeq*rhodeq*w2r**4*w3i**3 +& 2*w1i**2*rhogsol*rhogeq*rhodeq*w3i**2*w2r**2*w2i*w3r**2) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & 2*w1i**2*rhogsol*rhogeq*rhodeq*w2r**2*w3i*w3r**2*w2i**2 + w1i**2*rhogsol*rhogeq*rhodeq*w2i*w2r**2*w3i**4 +& w1i**2*rhogsol*rhogeq*rhodeq*w2i**4*w3i**3 + w1i**2*rhogsol*rhogeq*rhodeq*w3i**4*w2i**3 +& 2*w1i**2*rhogsol*rhogeq*rhodeq*w2r**2*w2i**2*w3i**3 - w1r**4*Kdrag*rhogeq*rhodsol*w3r**2*w2i**2 -& w1r**4*Kdrag*rhogeq*rhodsol*w3r**2*w2r**2 + w1r**3*vgsol*k*rhogeq**2*rhodeq*w2i**2*w3i**3 +& w1r**3*vgsol*k*rhogeq**2*rhodeq*w2i*w2r**2*w3i**2 + w1r**3*vgsol*k*rhogeq**2*rhodeq*w2i**3*w3i**2 +& w1r**3*vgsol*k*rhogeq**2*rhodeq*w2r**2*w3i**3 + w1i**2*rhogsol*rhogeq*rhodeq*w2i**3*w3r**4 +& w1i**2*rhogsol*rhogeq*rhodeq*w2r**2*w2i*w3r**4 + w1r**3*vgsol*k*rhogeq**2*rhodeq*w3r**2*w2i*w2r**2 +& w1r**3*vgsol*k*rhogeq**2*rhodeq*w3r**2*w2r**2*w3i + w1r**3*vgsol*k*rhogeq**2*rhodeq*w3r**2*w2i**2*w3i +& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*w1i**2*rhodeq*w2i*w3i +& 2*w1r**2*rhogsol*rhogeq*k**2*cs**2*w1i**2*rhodeq*w2i*w3r**2 +& 2*w1r**2*rhogsol*rhogeq*k**2*cs**2*w1i**2*rhodeq*w2i**2*w3i -& w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*w1i**2*rhodeq*w3r*w2r - 2*rhogsol*rhogeq*k**4*cs**4*w1i**2*rhodeq*w3r*w2r*w3i& + 2*rhogsol*rhogeq*k**4*cs**4*w1i**2*rhodeq*w2i**2*w3i + 2*rhogsol*rhogeq*k**4*cs**4*w1i**2*rhodeq*w2i*w3i**2 +& 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2i**2*w3i**3 + 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2i*w2r**2*w3i**2 +& 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2i**3*w3i**2 + 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2i**2*w3i -& 2*rhogsol*rhogeq*k**4*cs**4*w1i**2*rhodeq*w3r*w2r*w2i +& 2*w1r**2*rhogsol*rhogeq*k**2*cs**2*w1i**2*rhodeq*w2i*w3i**2 +& 2*w1r**2*rhogsol*rhogeq*k**2*cs**2*w1i**2*rhodeq*w2r**2*w3i +& 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2i**3 + 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2r**2*w3i +& 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2r**2*w3i**3 + 2*Kdrag*vgsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w2r*w2i*w3i& + 2*Kdrag*vgsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w2r*w3i**2 -& 2*Kdrag*vdsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w2r*w3i**2 +& 2*Kdrag*vgsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w2i**2*w3r -& 2*Kdrag*vdsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w2i**2*w3r -& 2*Kdrag*vdsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w3r*w2i*w3i + w1r**3*vgsol*k*rhogeq**2*rhodeq*w3r**2*w2i**3 -& 2*Kdrag*vdsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w2r*w2i*w3i +& 2*Kdrag*vgsol*rhogeq*k**3*cs**2*w1i**2*rhodeq*w3r*w2i*w3i +& 2*w1i*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2i*w2r**2 - w1i*vgsol*Kdrag**2*k*rhodeq*w3r**3*w2i**2 -& w1i*vgsol*Kdrag**2*k*rhodeq*w3r**3*w2r**2 - w1i*vgsol*Kdrag**2*k*rhodeq*w2r**3*w3r**2 -& w1i*vgsol*Kdrag**2*k*rhodeq*w2r*w2i**2*w3r**2 - w1i*vgsol*Kdrag**2*k*rhodeq*w2r*w2i**2*w3i**2 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r**3*w2r**2 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i**2*w3r**2 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i*w3r**2*w3i -& 2*w1i*w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r*w3r**2 - 2*w1i*w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2i**2*w3r -& 2*w1i*w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r**2*w3r - 2*w1i*w1r*rhogsol*rhogeq*k**4*cs**4*rhodeq*w2r*w3i**2 -& w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w2i**3*w3i - 3*w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3i**2*w2i**2) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w2r**2*w3i**2 + 2*w1r**2*rhogsol*Kdrag*w1i**2*rhodeq*w3r**2*w2r**2 +& 2*w1r**2*rhogsol*Kdrag*w1i**2*rhodeq*w3i**2*w2i**2 + 2*w1r**2*rhogsol*Kdrag*w1i**2*rhodeq*w2r**2*w3i**2 -& w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3i*w2i*w3r**2 + w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r**2*w2r**2 +& w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w2r*w3r*w3i**2 + w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r**2*w2i**2 +& 4*w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r*w2r*w2i*w3i + w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r*w2r**3 +& w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r*w2r*w2i**2 - w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3i**3*w2i -& w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w2i*w3i*w2r**2 - 2*w1i*w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i*w3r**2& - 2*w1i*w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i**2*w3i -& 2*w1i*w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2i*w3i**2 -& 2*w1i*w1r*vdsol*Kdrag*rhogeq*k**3*cs**2*rhodeq*w2r**2*w3i + 2*w1r**2*rhogsol*Kdrag*w1i**2*rhodeq*w3r**2*w2i**2& + rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r**2*w2i**2*w3i - 2*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3i*w3r*w2r**3 -& 2*rhogsol*k**4*cs**4*rhogeq*rhodeq*w2r*w3r*w2i*w3i**2 + rhogsol*k**4*cs**4*rhogeq*rhodeq*w2i**3*w3i**2 +& rhogsol*k**4*cs**4*rhogeq*rhodeq*w2i*w2r**2*w3i**2 - rhogsol*k**4*cs**4*rhogeq*rhodeq*w2r**2*w3i**3 +& w1i*rhogsol*k**4*cs**4*rhogeq*rhodeq*w2r*w3r**3 + w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**4*w2i -& 2*rhogsol*k**4*cs**4*rhogeq*rhodeq*w2r*w3r**3*w2i - rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r**2*w2i*w2r**2 -& rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r**2*w2r**2*w3i - 2*rhogsol*k**4*cs**4*rhogeq*rhodeq*w3i*w3r*w2i**2*w2r +& w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i*w2r**4 + w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i*w2i**4 +& 2*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i*w2r**2*w2i**2 +& w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3r**4*w2i + 4*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w2r*w3r**3*w2i +& 2*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i**2*w2i*w3r**2 + vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w2i*w2r**2*w3i**3& + rhogsol*k**4*cs**4*rhogeq*rhodeq*w2i**2*w3i**3 - vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w2r*w3r*w2i**2*w3i**2 +& 4*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i*w3r*w2i**2*w2r +& 4*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w3i*w3r*w2r**3 +& 4*w1r**2*rhogsol*rhogeq*k**2*cs**2*rhodeq*w2r*w3r*w2i*w3i**2 - rhogsol*k**4*cs**4*rhogeq*rhodeq*w3r**2*w2i**3 -& vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w3r**3*w2r**3 + w1i*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3i**2 -& vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w2r*w3r**3*w2i**2 + vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w2i**3*w3i*w3r**2 +& vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w2i*w3i*w2r**2*w3r**2 - vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w3r*w2r**3*w3i**2 +& vdsol*Kdrag*k*w1r*rhogeq*rhodeq*w2i**3*w3i**3 + Kdrag*rhogeq*k*vgsol*rhodeq*w2r**3*w3i**4 +& Kdrag*rhogeq*k*vgsol*rhodeq*w2r*w3i**4*w2i**2 + 2*Kdrag*rhogeq*k*vgsol*rhodeq*w3r*w2r**2*w3i**2*w2i**2 -& w1i*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3r**2 -& w1i*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r**2*w3r +& w1i*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2i**2*w3r +& 2*w1i*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2i*w3i +& 2*w1i*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i*w3i +& 2*Kdrag*rhogeq*k*vgsol*rhodeq*w2r*w3i**2*w2i**2*w3r**2 + Kdrag*rhogeq*k*vgsol*rhodeq*w3r*w2r**4*w3i**2 +& Kdrag*rhogeq*k*vgsol*rhodeq*w3r*w2i**4*w3i**2 + Kdrag*rhogeq*k*vgsol*rhodeq*w3r**3*w2i**4 +& Kdrag*rhogeq*k*vgsol*rhodeq*w3r**3*w2r**4 + 2*Kdrag*rhogeq*k*vgsol*rhodeq*w2r**3*w3i**2*w3r**2 +& Kdrag*rhogeq*k*vgsol*rhodeq*w2r*w2i**2*w3r**4 + 2*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**3*w2r**2*w2i**2 -& vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3i**3 + vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3i*w2i**2 +& 2*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i*w3i**2 -& 2*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w3i*w3r*w2r**2 + vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r**3*w3i& - vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2i**3) !--break to avoid too many continuation lines rhod1i = rhod1i - ( & 2*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w3i*w3r*w2i**2 +& 2*w1r*cs**2*k**2*rhogsol*w1i*rhogeq*rhodeq*w2r**3*w3i**2 -& vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3i*w3r**2 -& vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2i*w2r**2 + vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w3r**3*w2i -& 2*vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i*w3r**2 -& vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w2i**2*w3i**2 + vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2r**2*w3i**2& - vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w3r*w2i**2*w3i**2 -& 2*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2i*w3i*w3r*w2r**2 -& 2*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w2i*w3r**2*w3i -& 2*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2i**3*w3i*w3r - vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r**3*w3i**2 -& 2*vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w2i*w3i**3 + vdsol*Kdrag*k**3*cs**2*rhogeq*rhodeq*w2r*w2i**2*w3r**2& + 2*vgsol*k**3*cs**2*rhogeq**2*w1i**3*rhodeq*w3r*w2i*w3i + vgsol*k**3*cs**2*rhogeq**2*w1i**3*rhodeq*w2r*w3i**2& + w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w3i**3*w2r**3 + w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w3i*w2i**2*w3r**2*w2r +& w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w3r*w2i**3*w3i**2 + w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w3r*w2r**2*w2i*w3i**2 +& w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w2r*w2i**2*w3i**3 - 2*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3i**2*w2i**2*w2r**2 +& w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w2i**3*w3r**3 + w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**3*w2i*w2r**2 +& w1i*Kdrag*rhogeq*k*vgsol*rhodeq*w3i*w2r**3*w3r**2 - w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3i**2*w2i**4 -& w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3i**4*w2i**2 - 3*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2i*w3i*w2r**2*w3r**2 -& 2*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2i**2*w2r**2 - w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2r**4*w3i**2 -& w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3i**4*w2r**2 - 3*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2i*w2r**2*w3i**3 -& 3*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2i**3*w3i**3 + vgsol*w1r**2*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2i*w3i**2 +& Kdrag*rhogeq*k*vgsol*rhodeq*w2r**3*w3r**4 - 2*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2i**2*w3i**2 -& 2*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2r**2*w3i**2 - w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2r*w3r*w2i**2*w3i**2& - 3*w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2i**3*w3i*w3r**2 - w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2i**4 -& w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**2*w2r**4 - w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**4*w2r**2 -& w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**3*w2r**3 - w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w2r*w3r**3*w2i**2 +& rhogsol*rhogeq*k**2*cs**2*w1r**4*rhodeq*w2i*w3r**2 + rhogsol*rhogeq*k**2*cs**2*w1r**4*rhodeq*w2i**2*w3i +& rhogsol*rhogeq*k**2*cs**2*w1r**4*rhodeq*w2i*w3i**2 + rhogsol*rhogeq*k**2*cs**2*w1r**4*rhodeq*w2r**2*w3i -& w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r**4*w2i**2 - w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r**4*w3r -& w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2i**4 - 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2i**3*w3i*w3r -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2i**2*w3r*w2r**2 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2i*w3i*w3r*w2r**2 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w3r*w2r**2*w3i**2 - w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3i**4 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w2i*w3i**3 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3i**2*w3r**2 -& 2*w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r**3*w3r**2 - w1i*vgsol*k**3*cs**2*rhogeq**2*rhodeq*w2r*w3r**4 -& w1i*vgsol*Kdrag**2*k*rhodeq*w3r*w2i**2*w3i**2 - w1i*vgsol*Kdrag**2*k*rhodeq*w3r*w2r**2*w3i**2 -& w1i*vgsol*Kdrag**2*k*rhodeq*w2r**3*w3i**2 - w1r*Kdrag*rhogeq*k*vgsol*rhodeq*w3r*w2r**3*w3i**2) rhod1i = rhod1i/(w1i**2 -& 2*w3i*w1i + w3r**2 + w1r**2 + w3i**2 - 2*w3r*w1r)/(w3r**2 + w3i**2)/Kdrag/(w2r**2 + w1r**2 + w2i**2 - 2*w2i*w1i& - 2*w2r*w1r + w1i**2)/rhogeq/(w2i**2 + w2r**2) endif !print*,'w1 = ',w1r,w1i !print*,'w2 = ',w2r,w2i !print*,'w3 = ',w3r,w3i !if (iplot.eq.2) then ! print "(a,3('(',es10.3,',',es10.3,') '))",' vgas = ',vg1r,vg1i,vg2r,vg2i,vg3r,vg3i ! if (Kdrag.gt.0.) then ! print "(a,3('(',es10.3,',',es10.3,') '))",' vdust = ',vd1r,vd1i,vd2r,vd2i,vd3r,vd3i ! endif !else ! print "(a,3('(',es10.3,',',es10.3,') '))",' rhog = ',rhog1r,rhog1i,rhog2r,rhog2i,rhog3r,rhog3i ! if (Kdrag.gt.0.) then ! print "(a,3('(',es10.3,',',es10.3,') '))",' rhod = ',rhod1r,rhod1i,rhod2r,rhod2i,rhod3r,rhod3i ! endif !endif !------------------------------- ! F I N A L S O L U T I O N !------------------------------- do i=1,size(xplot) xk = 2.*pi/lambda*(xplot(i)-x0) arg1 = xk - w1r*time arg2 = xk - w2r*time arg3 = xk - w3r*time vgas = vgeq & + vg1r*exp(w1i*time)*cos(arg1) - vg1i*exp(w1i*time)*sin(arg1) & + vg2r*exp(w2i*time)*cos(arg2) - vg2i*exp(w2i*time)*sin(arg2) & + vg3r*exp(w3i*time)*cos(arg3) - vg3i*exp(w3i*time)*sin(arg3) vdust = vdeq & + vd1r*exp(w1i*time)*cos(arg1) - vd1i*exp(w1i*time)*sin(arg1) & + vd2r*exp(w2i*time)*cos(arg2) - vd2i*exp(w2i*time)*sin(arg2) & + vd3r*exp(w3i*time)*cos(arg3) - vd3i*exp(w3i*time)*sin(arg3) rhogas = rhogeq & + rhog1r*exp(w1i*time)*cos(arg1) - rhog1i*exp(w1i*time)*sin(arg1) & + rhog2r*exp(w2i*time)*cos(arg2) - rhog2i*exp(w2i*time)*sin(arg2) & + rhog3r*exp(w3i*time)*cos(arg3) - rhog3i*exp(w3i*time)*sin(arg3) rhodust = rhodeq & + rhod1r*exp(w1i*time)*cos(arg1) - rhod1i*exp(w1i*time)*sin(arg1) & + rhod2r*exp(w2i*time)*cos(arg2) - rhod2i*exp(w2i*time)*sin(arg2) & + rhod3r*exp(w3i*time)*cos(arg3) - rhod3i*exp(w3i*time)*sin(arg3) select case(iplot) case(4) yplot(i) = rhodust case(3) yplot(i) = rhogas case(2) yplot(i) = vdust case default yplot(i) = vgas end select enddo return end subroutine exact_dustywave end module dustywaves splash/src/exact_fromfile.f90000644 000770 000000 00000005522 12333061015 017044 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------ ! reads an exact solution from a file ! ! file should contain two or more columns containing ! x axis data and y axis data ! ! this is plotted as a line on the chosen graph !------------------------------------------------ module exactfromfile implicit none contains subroutine exact_fromfile(filename,xexact,yexact,ixcolfile,iycolfile,iexactpts,ierr) use asciiutils, only:get_ncolumns implicit none character(len=*), intent(in) :: filename real, intent(out), dimension(:) :: xexact, yexact integer, intent(in) :: ixcolfile,iycolfile integer, intent(out) :: iexactpts, ierr integer :: i,j,ncolumns,nheaderlines integer, parameter :: lu = 33 character(len=10) :: str real :: dum ierr = 0 open(unit=lu,file=filename,iostat=ierr,status='old',form='formatted') if (ierr /= 0) then ierr = 1 print*,'error opening ',filename return endif !--query number of header lines call get_ncolumns(lu,ncolumns,nheaderlines) !--skip header lines do i=1,nheaderlines read(lu,*) enddo !--read data from file do i=1,size(xexact) if (ixcolfile.gt.iycolfile) then read(lu,*,end=10,err=20) (dum,j=1,iycolfile-1),yexact(i),(dum,j=iycolfile+1,ixcolfile-1),xexact(i) elseif (ixcolfile.eq.iycolfile) then read(lu,*,end=10,err=20) (dum,j=1,ixcolfile-1),xexact(i) yexact(i) = xexact(i) else read(lu,*,end=10,err=20) (dum,j=1,ixcolfile-1),xexact(i),(dum,j=ixcolfile+1,iycolfile-1),yexact(i) endif enddo print*,'WARNING: reached array limits in ',trim(filename),': partial solution read' ierr = -1 close(lu) return 10 continue iexactpts = i-1 write(str,"(i10)") iexactpts print "(a)",' finished reading '//trim(filename)//': '//trim(adjustl(str))//' read' close(lu) return 20 print*,'error reading ',trim(filename),': partial solution read' iexactpts = i - 1 ierr = -2 close(lu) return end subroutine exact_fromfile end module exactfromfile splash/src/exact_function.f90000644 000770 000000 00000015721 12036727762 017112 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! Plots arbitrary analytic function y = f(x) ! Uses the function parser module !---------------------------------------------------------------------- module exactfunction implicit none contains subroutine exact_function(string,xplot,yplot,time,ierr) use fparser, only:initf,evalf,endf,EvalErrType,EvalErrMsg,rn implicit none character(len=*), intent(in) :: string real, intent(in), dimension(:) :: xplot real, intent(in) :: time real, intent(out), dimension(size(xplot)) :: yplot integer, intent(out) :: ierr integer :: i,j,nvars real(kind=rn), dimension(:), allocatable :: val print "(a)",' Plotting function f(x) = '//trim(string) if (len_trim(string).le.0) then print "(a)",' *** ERROR: blank function string in exact_function call' ierr = 1 return endif ierr = 0 ! !--work out how many subfunctions the string contains ! and allocate memory for the sub function values appropriately ! call get_nvars(string,nvars) allocate(val(nvars),stat=ierr) if (ierr /= 0) then print "(a)",' ERROR allocating memory for ',nvars,' sub-functions in exact_function' if (allocated(val)) deallocate(val) return endif call initf(nvars) call parse_subfunctions(string,nvars,.false.,ierr) if (EvalErrType.ne.0) then print "(a)",' *** ERROR parsing function: '//trim(EvalerrMsg())//' ***' ierr = EvalErrType else do i=1,size(xplot) val(1) = xplot(i) ! type conversion here val(2) = time ! type conversion here !--evaluate sub-functions in order of dependency do j=3,nvars val(j) = evalf(j,val(1:j-1)) enddo yplot(i) = real(evalf(1,val(1:nvars))) ! type conversion back if (EvalErrType /= 0) ierr = EvalErrType enddo if (ierr.ne.0) then print "(a)",' *** WARNING: errors during function evaluation: '//trim(EvalerrMsg()) !--set exit error to zero so we plot the results anyway ierr = 0 endif endif call endf if (allocated(val)) deallocate(val) return end subroutine exact_function !---------------------------------------------------------------- ! check syntax in the function string - this subroutine ! mainly just an interface to checking routines in fparser !---------------------------------------------------------------- subroutine check_function(string,ierr,verbose) ! use fparser, only:checkf implicit none character(len=*), intent(in) :: string integer, intent(out) :: ierr logical, intent(in), optional :: verbose integer :: nvars call get_nvars(string,nvars) if (present(verbose)) then call parse_subfunctions(string,nvars,.true.,ierr,verbose=verbose) else call parse_subfunctions(string,nvars,.true.,ierr) endif ! ierr = checkf(string,(/'x'/)) end subroutine check_function !---------------------------------------------------------------- ! allow sub-function syntax (f(x) = y, y = 24*x) !---------------------------------------------------------------- subroutine parse_subfunctions(string,nvars,check,ierr,verbose) use fparser, only:checkf,parsef,EvalErrMsg,EvalErrType implicit none character(len=*), intent(in) :: string integer, intent(in) :: nvars logical, intent(in) :: check integer, intent(out) :: ierr logical, intent(in), optional :: verbose character(len=len(string)), dimension(nvars) :: var integer :: ieq,ivars,ivarsinit,lstr,j,icommaprev logical :: iverb iverb = .true. if (present(verbose)) iverb = verbose var(1) = 'x' var(2) = 't' ivarsinit = 2 ivars = ivarsinit lstr = len_trim(string) icommaprev = lstr+1 do j=lstr,1,-1 ! !--split the string according to commas ! if (string(j:j)==',') then !--sub functions must be of the form f(var) = val ieq = j + index(string(j+1:lstr),'=') if (ieq.eq.j) then print "(a)",'*** Error in sub-function syntax, missing equals sign in comma-separated function list' ierr = 4 return endif !--variable is what lies to left of equals sign ivars = ivars + 1 var(ivars) = string(j+1:ieq-1) if (len_trim(var(ivars)).le.0) then print "(a)",'*** Error in sub-function syntax, blank variable ' ierr = 3 return endif !--function is what lies to right of equals sign if (check) then if (iverb) then if (ivars.eq.ivarsinit+1) print "(a)",'Evaluating sub-functions in the order:' print "(a)",trim(var(ivars))//' = '//string(ieq+1:icommaprev-1) endif ierr = checkf(string(ieq+1:icommaprev-1),var(1:ivars-1)) if (ierr /= 0) return else call parsef(ivars,string(ieq+1:icommaprev-1),var(1:ivars-1)) if (EvalErrType.ne.0) then print "(a)",' *** ERROR parsing function: '//trim(EvalerrMsg())//' ***' ierr = EvalErrType return endif endif icommaprev = j endif enddo if (ivars.ne.nvars) then print "(a)",' Internal consistency error in parse_subfunctions:' print*,' nvars ',ivars,' not equal to that obtained in get_nvars, ',nvars endif ! !--finally, check/parse combined function ! if (check) then if (ivars.ge.ivarsinit .and. iverb) print "(1x,a)",'f('//trim(var(1))//') = '//string(1:icommaprev-1) ierr = checkf(string(1:icommaprev-1),var(1:ivars)) else call parsef(1,string(1:icommaprev-1),var(1:ivars)) if (EvalErrType.ne.0) then print "(a)",' *** ERROR parsing function: '//trim(EvalerrMsg())//' ***' ierr = EvalErrType endif endif end subroutine parse_subfunctions !---------------------------------------------------------------- ! query the number of sub-functions (number of commas) !---------------------------------------------------------------- subroutine get_nvars(string,nvars) implicit none character(len=*), intent(in) :: string integer, intent(out) :: nvars integer :: j nvars = 2 do j=1,len_trim(string) if (string(j:j)==',') nvars = nvars + 1 enddo end subroutine get_nvars end module exactfunction splash/src/exact_gresho.f90000644 000770 000000 00000003570 12042421356 016536 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! compute exact solution for gresho vortex problem ! ---------------------------------------------------------------------- module gresho implicit none contains subroutine exact_gresho(iplot,xplot,yplot,ierr) implicit none integer, intent(in) :: iplot real, intent(in), dimension(:) :: xplot real, intent(out), dimension(size(xplot)) :: yplot integer, intent(out) :: ierr print*,'plotting gresho vortex ' ! ! check for errors ! ierr = 0 select case(iplot) case(2) ! pressure where (xplot < 0.2) yplot = 5. + 12.5*xplot**2 elsewhere (xplot < 0.4) yplot = 9. + 12.5*xplot**2 - 20.*xplot + 4.*log(5.*xplot) elsewhere yplot = 3. + 4.*log(2.) end where case(1) ! vphi where (xplot < 0.2) yplot = 5.*xplot elsewhere (xplot < 0.4) yplot = 2. - 5.*xplot elsewhere yplot = 0. end where end select return end subroutine exact_gresho end module gresho splash/src/exact_mhdshock.f90000644 000770 000000 00000025467 12062232512 017054 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! Plot exact solution for a magnetohydrodynamic shock ! (ie. one dimensional MHD Riemann problem) ! ! For want of a better solution these are just taken from the tables in ! Ryu & Jones (1995), ApJ 442, 228 or from ruler and pencil ! on the results in Balsara (1998), or from running the Athena code via ! http://rainman.astro.illinois.edu/ddr/oned/cgi-bin/athena.pl ! ! ---------------------------------------------------------------------- module mhdshock implicit none public :: exact_mhdshock integer, parameter, public :: nmhdshocksolns = 7 character(len=23), dimension(nmhdshocksolns), parameter, public :: mhdprob = & (/'Brio/Wu (gamma=2) ', & 'fast/slow shock (RJ95)', & '7 jump shock (RJ95)', & 'isothermal shock (B98) ', & 'rarefaction wave (RJ95)', & 'Mach 25 shock (DW94)', & 'Toth shock (RJ95/T00)'/) contains subroutine exact_mhdshock(iplot,ishk,time,gamma,xmin,xmax,xshock,xpts,ypts,npts,ierr) implicit none integer, intent(in) :: iplot,ishk integer, intent(out) :: npts,ierr real, intent(in) :: time,gamma,xmin,xmax,xshock real, dimension(:), intent(inout) :: xpts real, dimension(size(xpts)), intent(out) :: ypts real, dimension(16) :: rho,pr,vx,vy,vz,By,Bz real :: const, Bxzero,tfac print*,' Plotting exact mhd shock #',ishk,' at t = ',time ! !--set up grid for exact solution ! const = 1./SQRT(4.*3.1415926536) ierr = 0 select case(ishk) ! which solution to plot case(1) ! !--Brio & Wu problem with gamma = 2 ! tfac = time/0.1 vz = 0. Bz = 0. Bxzero = 0.75 npts = 14 xpts(1) = xmin xpts(2) = -0.18*tfac xpts(3) = -0.08*tfac xpts(4:6) = -0.03*tfac xpts(7) = -0.005*tfac xpts(8:9) = 0.06*tfac xpts(10:11) = 0.147*tfac xpts(12) = 0.33*tfac xpts(13) = 0.36*tfac xpts(14) = xmax rho(1:2) = 1.0 rho(3:4) = 0.67623 rho(5) = 0.827 rho(6) = 0.775 rho(7:8) = 0.6962 rho(9:10) = 0.2352 rho(11:12) = 0.117 rho(13:14) = 0.125 pr(1:2) = 1.0 pr(3:4) = 0.447 pr(5) = 0.727219 pr(6) = 0.6 pr(7:10) = 0.5160 pr(11:12) = 0.0876 pr(13:14) = 0.1 vx(1:2) = 0.0 vx(3:4) = 0.63721 vx(5) = 0.48 vx(6) = 0.52 vx(7:10) = 0.600 vx(11:12) = -0.24 vx(13:14) = 0.0 vy(1:2) = 0.0 vy(3:4) = -0.23345 vy(5) = -1.3 vy(6) = -1.4 vy(7:10) = -1.584 vy(11:12) = -0.166 vy(13:14) = 0. By(1:2) = 1.0 By(3:4) = 2.1*const By(5) = -1.2*const By(6) = -1.3*const By(7:10) = -1.9*const By(11:12) = -3.25*const By(13:14) = -1.0 case(2) ! !--fast/slow shock from RJ95 ! tfac = time/0.15 vz = 0. Bz = 0. Bxzero = 1.0 npts = 12 xpts(1) = xmin xpts(2) = -0.27*tfac xpts(3) = -0.09*tfac xpts(4) = -0.03*tfac xpts(5) = -0.01*tfac xpts(6:7) = 0.135*tfac xpts(8:9) = 0.25*tfac xpts(10:11) = 0.35*tfac xpts(12) = xmax rho(1:2) = 1.0 rho(3:4) = 0.5955 rho(5:6) = 0.55151 rho(7:8) = 0.41272 rho(9:10) = 0.2337 rho(11:12) = 0.2 pr(1:2) = 1.0 pr(3:4) = 0.42629 pr(5:8) = 0.37090 pr(9:10) = 0.12402 pr(11:12) = 0.1 vx(1:2) = 0.0 vx(3:4) = 0.81237 vx(5:8) = 0.89416 vx(9:10) = 0.24722 vx(11:12) = 0.0 vy(1:2) = 0.0 vy(3:4) = -0.59961 vy(5:8) = -0.5447 vy(9:10) = -0.91164 vy(11:12) = 0. By(1:2) = 1.0 By(3:4) = 0.28431 By(5:8) = 0.31528 By(9:10) = 0.43086 By(11:12) = 0.0 case(3) ! !--problem with 7 discontinuities from RJ95 ! tfac = time/0.2 Bxzero = 2.*const npts = 16 xpts(1) = xmin xpts(2:3) = -0.19*tfac xpts(4:5) = 0.03*tfac xpts(6:7) = 0.051*tfac xpts(8:9) = 0.12*tfac ! contact discontinuity xpts(10:11) = 0.18*tfac xpts(12:13) = 0.205*tfac xpts(14:15) = 0.45*tfac xpts(16) = xmax rho(1:2) = 1.08 rho(3:4) = 1.4903 rho(5:8) = 1.6343 rho(9:10) = 1.4735 rho(11:14) = 1.3090 rho(15:16) = 1.0 pr(1:2) = 0.95 pr(3:4) = 1.6558 pr(5:10) = 1.9317 pr(11:14) = 1.5844 pr(15:16) = 1.0 vx(1:2) = 1.2 vx(3:5) = 0.60588 vx(6:11) = 0.57538 vx(12:14) = 0.53432 vx(15:16) = 0.0 vy(1:2) = 0.01 vy(3:4) = 0.11235 vy(5:6) = 0.22157 vy(7:8) = 0.047602 vy(9:10) = 0.047601 vy(11:12) = -0.18411 vy(13:14) = -0.094572 vy(15:16) = 0.0 vz(1:2) = 0.5 vz(3:4) = 0.55686 vz(5:6) = 0.30125 vz(7:10) = 0.24734 vz(11:12) = 0.17554 vz(13:14) = -0.047286 vz(15:16) = 0.0 By(1:2) = 1.0155 By(3:4) = 1.4383 By(5:6) = 1.5716 By(7:10) = 1.4126 By(11:12) = 1.6103 By(13:14) = 1.5078 By(15:16) = 1.1284 Bz(1:2) = 0.56419 Bz(3:4) = 0.79907 Bz(5:6) = 0.48702 Bz(7:10) = 0.43772 Bz(11:12) = 0.49899 Bz(13:14) = 0.75392 Bz(15:16) = 0.56419 case(4) ! !--isothermal MHD problem from Balsara (1998) ! tfac = time/0.2 Bxzero = 2.*const npts = 14 xpts(1) = xmin xpts(2:3) = -0.15*tfac xpts(4:5) = 0.035*tfac xpts(6:7) = 0.07*tfac xpts(8:9) = 0.17*tfac xpts(10:11) = 0.2*tfac xpts(12:13) = 0.41*tfac xpts(14) = xmax rho(1:2) = 1.08 rho(3:6) = 1.515 rho(7:8) = 1.745 rho(9:12) = 1.36 rho(13:14) = 1.0 vx(1:2) = 1.2 vx(3:6) = 0.65 vx(7:8) = 0.62 vx(9:12) = 0.54 vx(13:14) = 0.0 vy(1:2) = 0.01 vy(3:4) = 0.13 vy(5:6) = 0.24 vy(7:8) = 0.071 vy(9:10) = -0.215 vy(11:12) = -0.125 vy(13:14) = 0.0 vz(1:2) = 0.5 vz(3:4) = 0.57 vz(5:6) = 0.31 vz(7:8) = 0.255 vz(9:10) = 0.165 vz(11:12) = -0.06 vz(13:14) = 0.0 By(1:2) = 3.6*const By(3:4) = 5.2*const By(5:6) = 5.7*const By(7:8) = 5.22*const By(9:10) = 5.96*const By(11:12) = 5.58*const By(13:14) = 4.0*const Bz(1:2) = 2.0*const Bz(3:4) = 2.885*const Bz(5:6) = 1.76*const Bz(7:8) = 1.62*const Bz(9:10) = 1.85*const Bz(11:12) = 2.79*const Bz(13:14) = 2.0*const pr = rho case(5) ! !--rarefaction from RJ95 ! tfac = time/0.1 npts = 6 vy = 0. vz = 0. Bz = 0. Bxzero = 0. xpts(1) = xmin xpts(2) = -0.27*tfac xpts(3) = -0.12*tfac xpts(4) = 0.12*tfac xpts(5) = 0.27*tfac xpts(6) = xmax rho(1:2) = 1.0 rho(3:4) = 0.49653 rho(5:6) = 1.0 pr(1:2) = 1.0 pr(3:4) = 0.31134 pr(5:6) = 1.0 vx(1:2) = -1.0 vx(3:4) = 0. ! this is approximate (to 10-7) vx(5:6) = 1.0 By(1:2) = 1.0 By(3:4) = 0.49638 By(5:6) = 1.0 case(6) ! !--mach 25 shocks from Dai and Woodward (1994) ! tfac = time/0.03 Bxzero = 4.*const npts = 6 rho(1:2) = 1.0 rho(3:4) = 3.982 rho(5:6) = 0.1 pr(1:2) = 1.0 pr(3:4) = 1806.0 pr(5:6) = 1.0 ! machno = 0.5*25.5 ! vs = SQRT(gamma*pr(1)/rho(1)) ! xpts(1) = xmin xpts(2:3) = -0.35*tfac xpts(4:5) = 0.35*tfac xpts(6) = xmax vx(1:2) = 36.87 vx(3:4) = 0.0 vx(5:6) = -36.87 vy(1:2) = -0.1546 vy(3:4) = -0.07727 vy(5:6) = 0.0 vz(1:2) = -0.03864 vz(3:4) = -0.01932 vz(5:6) = 0.0 By(1:2) = 4.0*const By(3:4) = 15.95*const By(5:6) = 4.0*const Bz(1:2) = 1.0*const Bz(3:4) = 3.988*const Bz(5:6) = 1.0*const case(7) ! !--Problem 1A in Ryu and Jones (1995) ! Bxzero = 5.*const npts = 12 tfac = time/0.08 xpts(1) = xmin xpts(2:3) = -0.386*tfac xpts(4:5) = -0.01*tfac xpts(6:7) = 0.0505*tfac xpts(8:9) = 0.12*tfac xpts(10:11) = 0.37*tfac xpts(12) = xmax rho(1:2) = 1.0 rho(3:4) = 2.6797 rho(5:6) = 2.6713 rho(7:8) = 3.8508 rho(9:10) = 3.7481 rho(11:12) = 1.0 pr(1:2) = 20.0 pr(3:4) = 150.98 pr(5:8) = 150.19 pr(9:10) = 143.57 pr(11:12) = 1.0 vx(1:2) = 10.0 vx(3:4) = 0.72113 vx(5:8) = 0.72376 vx(9:10) = 0.70505 vx(11:12) = -10.0 vy(1:2) = 0.0 vy(3:4) = 0.23139 vy(5:8) = 0.35684 vy(9:10) = -0.38804 vy(11:12) = 0.0 vz(1:12) = 0.0 By(1:2) = 1.4105 By(3:4) = 3.8389 By(5:8) = 4.0380 By(9:10) = 5.4272 By(11:12) = 1.4105 Bz(1:12) = 0.0 case default ierr = 1 npts = 0 ypts = 0. xpts = 0. return end select ! !--plot just the initial conditions at t=0 ! if (abs(time).le.0.) then rho(1:2) = rho(1) pr(1:2) = pr(1) vx(1:2) = vx(1) vy(1:2) = vy(1) vz(1:2) = vz(1) By(1:2) = By(1) Bz(1:2) = Bz(1) xpts(3) = 0. xpts(4) = xpts(npts) rho(3:4) = rho(npts) pr(3:4) = pr(npts) vx(3:4) = vx(npts) vy(3:4) = vy(npts) vz(3:4) = vz(npts) By(3:4) = By(npts) Bz(3:4) = Bz(npts) npts = 4 endif ! !--translate positions if shock is not at x=0 ! xpts(:) = xpts(:) + xshock ! !--determine which parameter to plot ! select case(iplot) case(1) ypts(1:npts) = rho(1:npts) case(2) ypts(1:npts) = pr(1:npts) case(3) ypts(1:npts) = vx(1:npts) case(4) ypts(1:npts) = vy(1:npts) case(5) ypts(1:npts) = vz(1:npts) case(6) ypts(1:npts) = By(1:npts) case(7) ypts(1:npts) = Bz(1:npts) case(8) print*,'gamma = ',gamma if (abs(gamma-1.).gt.1.e-5) then where (abs(rho(1:npts)) > 0.) ypts(1:npts) = pr(1:npts) / ((gamma-1.)*rho(1:npts)) end where else print*,' ***isothermal: utherm solution not valid' ypts(1:npts) = 0. endif case(9) ypts(1:npts) = Bxzero case default print*,'error: unknown solution to plot' end select return end subroutine exact_mhdshock end module mhdshock splash/src/exact_polytrope.f90000644 000770 000000 00000006262 12276336061 017314 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !--------------------------------------- ! numerically integrate a polytrope ! with the density = 1 at the centre ! This uses scaled variables (no sigma in the equation) ! then the radius is scaled to give the correct mass ! Based on an old subroutine from Joe Monaghan !----------------------------------------- module polytrope implicit none public :: exact_polytrope contains subroutine exact_polytrope(gamma,polyk,totmass,rplot,denplot,npts,ierr) implicit none integer, intent(out) :: npts,ierr real, intent(in) :: gamma real, intent(in) :: polyk,totmass real, dimension(:), intent(inout) :: rplot real, dimension(size(rplot)), intent(out) :: denplot integer :: i,j real, parameter :: pi = 3.1415926536 real, dimension(size(rplot)) :: r,v,den real :: dr,an,rhs,rstar,totmassf real :: rhocentre,fac,rfac,G ierr = 0 print*,' gamma :',gamma dr = 0.001 G = 1. an = 1./(gamma-1.) v(1) = 0.0 v(2) = dr*(1.0 - dr*dr/6. ) r(1) = 0. i = 2 do while (v(i).ge.0.) r(i) = (i-1)*dr rhs = - r(i)*(v(i)/r(i))**an v(i+1) = 2*v(i) - v(i-1) + dr*dr*rhs i = i + 1 if (i+1.gt.size(rplot)) then dr = dr*2. r(2) = dr v(2) = dr*(1.0 - dr*dr/6. ) i = 2 endif enddo npts = i-1 rstar = r(npts) !-------------------------------------- ! calculate the mass out to radius r ! using the density without the central ! density multiplier- call this totmassf ! the true scaled totmass = 1. !---------------------------------------- den(1) = 1.0 totmassf = 0. do j = 2,npts den(j) = (v(j)/r(j))**an totmassf = totmassf + 4.*pi*r(j)*r(j)*den(j)*dr enddo !--------------------------------------------------- ! rescale the central density to give desired massq ! then rescale the radius to match this !--------------------------------------------------- fac = (gamma*polyk)/(4.*pi*G*(gamma - 1.)) rhocentre = ((totmass/totmassf)/fac**1.5)**(2./(3.*gamma - 4.)) rfac = sqrt(fac*rhocentre**(gamma - 2.)) print*,' Rstar = ',rstar*rfac print*,' central density :',rhocentre print*,' total mass :',totmass rplot = r * rfac denplot = rhocentre * den return end subroutine exact_polytrope end module polytrope splash/src/exact_rhoh.f90000644 000770 000000 00000004153 12017334030 016177 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !---------------------------------------------------------- ! plots the relation between smoothing length and density ! ! ie. h = h_fact*(pmass/rho)^(1/ndim) ! !---------------------------------------------------------- module rhoh implicit none public :: exact_rhoh contains subroutine exact_rhoh(iplot,ndim,hfact,pmassval,xplot,yplot,ierr) implicit none integer, intent(in) :: iplot,ndim integer, intent(out) :: ierr real, intent(in) :: hfact,pmassval real, dimension(:), intent(in) :: xplot real, dimension(size(xplot)), intent(out) :: yplot if (hfact.gt.0.01) then ierr = 0 if (iplot.eq.2) then ! x axis is h where (xplot > tiny(xplot)) yplot(:) = pmassval*(hfact/xplot(:))**ndim elsewhere yplot(:) = huge(yplot) end where else ! y axis is h where (xplot > tiny(xplot)) yplot(:) = hfact*(pmassval/xplot(:))**(1./FLOAT(ndim)) elsewhere yplot(:) = huge(yplot) end where endif write(*,"(a,f5.2,a,es9.2,a,i1,a)") ' plotting h = ',hfact, & '*(',pmassval,'/rho)**(1/',ndim,')' else print "(a)",'error: hfact = 0: can''t plot h vs rho exact solution' ierr = 1 endif return end subroutine exact_rhoh end module rhoh splash/src/exact_ringspread.f90000644 000770 000000 00000022542 12371072540 017407 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! Plots Lynden-Bell & Pringle (1978) solution for viscous ! ring spreading in an accretion disk. ! ! Input: radius in disk ! Output: surface density ! ! D. Price, UofExeter 25.2.08 !---------------------------------------------------------------------- module ringspread implicit none public :: exact_ringspread, ringspreadfunc private contains subroutine exact_ringspread(iplot,time,Mdisk,Rdisk,viscnu,xplot,yplot,ierr) implicit none integer, intent(in) :: iplot real, intent(in) :: time,Mdisk,Rdisk,viscnu real, intent(in), dimension(:) :: xplot real, intent(out), dimension(size(xplot)) :: yplot integer, intent(out) :: ierr real, parameter :: pi = 3.1415926536 integer :: i real :: R2,sigma,tvisc double precision :: tau,x ! ! check for errors in input parameters ! ierr = 0 if (Mdisk.le.0.) then print*,'error: mass <= 0 in exact_ringspread' ierr = 2 return elseif (Rdisk.le.0.) then print*,'error: rdisk < 0 in exact_ringspread' ierr = 3 return elseif (viscnu.le.tiny(viscnu)) then print*,'error: viscosity <= 0 in ringspreading solution' ierr = 4 return endif R2 = Rdisk*Rdisk tvisc = R2/(12.*viscnu) tau = time/tvisc print "(a,1pe9.2,a,1pe9.2,a,0pf6.2,a,f6.2)", & ' Plotting ring spreading solution: tau = ',tau,' nu = ',viscnu,' R0 = ',Rdisk,' M = ',Mdisk do i=1,size(xplot) x = xplot(i)/Rdisk sigma = Mdisk/real((pi*R2))*ringspreadfunc(x,tau) !print*,'x = ',xplot(i),Rdisk,tau,sigma select case(iplot) case(1) !--density yplot(i) = sigma case default !--pressure yplot(i) = 0. end select enddo return end subroutine exact_ringspread !---------------------------------------------------------------------- ! evaluates the surface density as a function of x and tau !---------------------------------------------------------------------- double precision function ringspreadfunc(x,tau) implicit none double precision, intent(in) :: x, tau double precision :: xfunc,besfunc,dummy,term if (tau.le.epsilon(tau) .or. x.le.tiny(x)) then ringspreadfunc = 0. else xfunc = 2.*x/tau term = exp(-(1.+x*x)/tau) !--prevent blowups at t=0: no point evaluating ! the Bessel function if the exp term is zero. if (term.gt.tiny(term)) then call bessik(xfunc,0.25d0,besfunc,dummy,dummy,dummy) else besfunc = 0. endif ringspreadfunc = 1./(tau*x**0.25)*term*besfunc !print*,'ringspreadfunc = ',x,xfunc,-(1.+x*x)/tau,exp(-(1.+x*x)/tau),ringspreadfunc,xfunc,tau,besfunc endif return end function ringspreadfunc !---------------------------------------------------------------------- ! remainder of this file are routines for evaluating the modified ! Bessel function in the above solution !---------------------------------------------------------------------- subroutine bessik(x,xnu,ri,rk,rip,rkp) implicit none integer, parameter :: maxit = 10000 double precision, intent(in) :: x, xnu double precision, intent(out) :: ri,rip,rk,rkp double precision, parameter :: eps = 1.e-10, fpmin = 1.e-30, & xmin = 2., pi = 3.141592653589793d0 ! Returns the modified Bessel functions ri = I\nu, rk = K\nu and their ! derivatives rip = I'\nu and rkp = K'\nu, for positive x and for ! xn = \nu .ge. 0. The relative accuracy is within one or two significant ! digits of eps. ! ! All internal arithmetic in double precision ! ! This routine written by Daniel Price, UofExeter 25/2/08 ! Adapted from Press et. al. (1992) Numerical Recipes in FORTRAN 77 ! integer:: i,l,nl double precision :: a,a1,b,c,d,del,del1,delh,dels,e,f,fact,fact2, & ff,gam1,gam2,gammi,gampl,h,p,pimu,q,q1,q2,qnew,ril,ril1,rimu,rip1,ripl, & ritemp,rk1,rkmu,rkmup,rktemp,s,sum,sum1,x2,xi,xi2,xmu,xmu2 if (x <= 0. .or. xnu < 0.) then print*,' bad arguments in bessik ',x,xnu ! return endif nl = int(xnu+0.5d0) ! nl is the number of downward recurrences of the I's xmu = xnu - nl ! and upward recurrences of K's. xmu lies between xmu2 = xmu*xmu ! -1/2 and 1/2 xi = 1.d0/x xi2 = 2.d0*xi h = xnu*xi if (h.lt.fpmin) h = fpmin b = xi2*xnu d = 0.d0 c = h do i=1,maxit b = b + xi2 d = 1.d0/(b + d) c = b + 1.d0/c del = c*d h = del*h if (abs(del-1.d0).lt.eps) goto 1 enddo print*,'x too large in bessik; try asymptotic expansion' 1 continue ril = fpmin ripl = h*ril ril1 = ril rip1 = ripl fact = xnu*xi do l=nl,1,-1 ritemp = fact*ril + ripl fact = fact - xi ripl = fact*ritemp + ril ril = ritemp enddo f = ripl/ril if (x < xmin) then x2 = 0.5d0*x pimu = pi*xmu if (abs(pimu).lt.eps) then fact = 1.d0 else fact = pimu/sin(pimu) endif d = -log(x2) e = xmu*d if (abs(e).lt.eps) then fact2 = 1.d0 else fact2 = sinh(e)/e endif ! Chebyshev evaluation of Gamma1, Gamma2 call beschb(xmu,gam1,gam2,gampl,gammi) ff = fact*(gam1*cosh(e) + gam2*fact2*d) ! f0 sum = ff e = exp(e) p = 0.5d0*e/gampl q = 0.5d0/(e*gammi) c = 1.d0 d = x2*x2 sum1 = p do i=1,maxit ff = (i*ff + p + q)/(i*i - xmu2) c = c*d/i p = p/(i - xmu) q = q/(i + xmu) del = c*ff sum = sum + del del1 = c*(p - i*ff) sum1 = sum1 + del1 if (abs(del).lt.abs(sum)*eps) goto 2 enddo print*,' bessk series failed to converge' 2 continue rkmu = sum rk1 = sum1*xi2 else b = 2.d0*(1.d0 + x) d = 1.d0/b delh = d h = delh q1 = 0.d0 q2 = 1.d0 a1 = 0.25d0 - xmu2 c = a1 q = c a = -a1 s = 1.d0 + q*delh do i=2,maxit a = a - 2*(i-1) c = -a*c/i qnew = (q1 - b*q2)/a q1 = q2 q2 = qnew q = q + c*qnew b = b + 2.d0 d = 1.d0/(b + a*d) delh = (b*d - 1.d0)*delh h = h + delh dels = q*delh s = s + dels if (abs(dels/s).lt.eps) goto 3 enddo print*,'bessik: failure to converge in cf2' 3 continue h = a1*h rkmu = sqrt(pi/(2.d0*x))*exp(-x)/s rk1 = rkmu*(xmu + x + 0.5d0 - h)*xi endif rkmup = xmu*xi*rkmu - rk1 rimu = xi/(f*rkmu - rkmup) ri = (rimu*ril1)/ril rip = (rimu*rip1)/ril do i=1,nl rktemp = (xmu + i)*xi2*rk1 + rkmu rkmu = rk1 rk1 = rktemp enddo rk = rkmu rkp = xnu*xi*rkmu - rk1 return end subroutine bessik subroutine beschb(x,gam1,gam2,gampl,gammi) implicit none integer, parameter :: nuse1=7,nuse2=8 double precision, intent(in) :: x double precision, intent(out) :: gam1,gam2,gammi,gampl ! ! Evaluates Gamma_1 and Gamma_2 by Chebyshev expansion for |x| < 1/2. ! Also returns 1/Gamma(1 + x) and 1/Gamma(1-x). ! ! In double precision, set NUSE1 = 7, NUSE2 = 8. ! In single precision, set NUSE1 = 2, NUSE2 = 5. ! ! This routine written by Daniel Price, UofExeter 25/2/08 ! Adapted from Press et. al. (1992) Numerical Recipes in FORTRAN 77 ! double precision :: xx,c1(7),c2(8) save c1,c2 data c1/-1.142022680371168d0, 6.5165112670737d-3, & 3.087090173086d-4, -3.4706269649d-6,6.9437664d-9, & 3.67795d-11,-1.356d-13/ data c2/1.843740587300905d0, -7.68528408447867d-2, & 1.2719271366546d-3, -4.9717367042d-6, -3.31261198d-8, & 2.423096d-10, -1.702d-13, -1.49d-15/ xx = 8.d0*x*x - 1.d0 ! multiply x by 2 to make range be -1 to 1, gam1 = chebev(-1.d0,1.d0,c1,NUSE1,xx) ! and then apply transformation for gam2 = chebev(-1.d0,1.d0,c2,NUSE2,xx) ! evaluating even Chebyshev series gampl = gam2 - x*gam1 gammi = gam2 + x*gam1 return end subroutine beschb double precision function chebev(a,b,c,m,x) implicit none integer, intent(in) :: m double precision, intent(in) :: a,b,x,c(m) ! ! Chebyshev evaluation: All arguments are input. c(1:m) is an array of ! Chebyshev coefficients, the first m elements of c output from chebft ! (which must have been called with the same a and b). The Chebyshev ! polynomial \sum_{k=1}^m c_k T_{k-1}(y) - c1/2 is evaluated at a ! point y = [ x - (b + a)/2 ] / [(b - a)/2], and the result is returned ! as the function value. ! ! This routine written by Daniel Price, UofExeter 25/2/08 ! Adapted from Press et. al. (1992) Numerical Recipes in FORTRAN 77 ! integer :: j double precision :: d, dd, sv, y, y2 if ((x-a)*(x-b).gt.0.) then print*,'error: x not in range in chebev' chebev = 0. return endif d = 0. dd = 0. y = (2.*x - a - b)/(b - a) ! change of variable y2 = 2.*y do j=m,2,-1 ! Clenshaw's recurrence sv = d d = y2*d - dd + c(j) dd = sv enddo chebev = y*d - dd + 0.5*c(1) ! last step is different end function chebev end module ringspread splash/src/exact_rochelobe.f90000644 000770 000000 00000017350 12307565255 017225 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------------- ! Plots Roche Lobes (equipotential surface) for a binary system ! Guts of it adapted from an original C routine by Simon Portugies-Zwart !----------------------------------------------------------------------- module rochelobe implicit none real, parameter :: roche_accuracy = 1.e-6 integer, parameter :: maxits = 100 contains !----------------------------------------------------------------------- ! Plot Roche Lobe ! ! INPUT: ! x1, y1 : position of primary ! x2, y2 : position of secondary ! m1, m2 : masses of components ! ! OUTPUT: ! xplot, yplot: contains (half of) the Roche lobe solution ! ierr : error condition to splash indicating plotting was done here !----------------------------------------------------------------------- subroutine exact_rochelobe(x1,y1,x2,y2,m1,m2,xplot,yplot,ierr) use plotlib, only:plot_line real, intent(in) :: x1,y1,x2,y2,m1,m2 real, dimension(:), intent(inout) :: xplot,yplot integer, intent(out) :: ierr real :: roche_radius1,roche_radius2,q,L1 real :: rlimit,llimit,xmax,xmin,ymax,xtmp real :: angle,cosangle,sinangle,dx,dy,sep integer :: i,npts npts = (size(xplot)-1)/2 if (npts < 1) return sep = sqrt((x2 - x1)**2 + (y2 - y1)**2) print "(4(a,es10.3))",' plotting Roche potential, m1 = ',m1,' m2 = ',m2,' sep = ',sep roche_radius1 = roche_radius(m1, m2) roche_radius2 = roche_radius(m2, m1) q = m2/m1 L1 = first_Lagrangian_point(1./q) ! We assume primary on the left if (m1 < m2) then q = 1/q L1 = first_Lagrangian_point(1./q) endif rlimit = right_limit(q, L1) llimit = left_limit(q, L1) call compute_lobes(q, L1, npts, xplot, yplot) xmin = xplot(1) xmax = xplot(2*npts) if (m1 < m2) then xtmp = xmin xmin = 1.-xmax xmax = 1.-xtmp endif ymax = -1000. do i=1,2*npts ymax = max(ymax,yplot(i)) enddo ! some tedious fiddling for q>1 case if (m1 < m2) then xplot(:) = 1. - xplot(:) endif ! scale to actual separation xplot = xplot*sep yplot = yplot*sep ! work out angle needed to rotate into corotating frame dx = x2 - x1 dy = y2 - y1 angle = -atan2(dy,dx) cosangle = cos(angle) sinangle = sin(angle) ! lobes are computed assuming primary is at the origin, so shift to xprim,yprim ! unrotated, this is just plot_line(xplot,yplot) and plot_line(xplot,-yplot) call plot_line(2*npts+1,xplot*cosangle + yplot*sinangle + x1,-xplot*sinangle + yplot*cosangle + y1) call plot_line(2*npts+1,xplot*cosangle - yplot*sinangle + x1,-xplot*sinangle - yplot*cosangle + y1) !--return non-zero ierr value as we do the plotting here ierr = 1 end subroutine exact_rochelobe ! ! calculates outer limit of roche-lobe ! subroutine rlimit(q, L, x, f, df, dummy) real, intent(in) :: q,L,x,dummy real, intent(out) :: f,df real :: qi,q11,cnst,r1,r2,r3 qi = 1./q q11 = 1./(1.+qi) cnst = qi/L+1./(1.-L)+0.5*(1.+qi)*(L-q11)**2 r1 = abs(x) r2 = abs(1-x) r3 = abs(x-q11) f = qi/r1+1./r2+0.5*(1.+qi)*r3**2 - cnst df = -qi*x/r1**3 +(1.-x)/r2**3 + (1.+qi)*(x-q11) end subroutine rlimit real function rtsafe(func,q,L,x1,x2,xll,xacc) real, intent(in) :: q,L,x1,x2,xll,xacc external :: func integer :: j real :: df,dx,dxold,f,fh,fl real :: temp,xh,xl,rts call func(q,L,x1,fl,df,xll) call func(q,L,x2,fh,df,xll) if ((fl > 0.0 .and. fh > 0.0) .or. (fl < 0.0 .and. fh < 0.0)) then !print*,'Error occured in rtsafe, exiting...',q,L,x1,x2,fl,fh rtsafe = 0. return endif if (abs(fl) < tiny(fl)) then rtsafe = x1 return endif if (abs(fh) < tiny(fh)) then rtsafe = x2 return endif call func(q, L, x1, f, df, xll) call func(q, L, x2, f, df, xll) if (fl < 0.0) then xl=x1 xh=x2 else xh=x1 xl=x2 endif rts = 0.5*(x1+x2) dxold = abs(x2-x1) dx = dxold call func(q, L, rts, f, df, xll) do j=1,maxits if ((((rts-xh)*df - f)*((rts-xl)*df - f) >= 0.0) & .or. (abs(2.0*f) > abs(dxold*df))) then dxold = dx dx = 0.5*(xh-xl) rts = xl+dx if (abs(xl-rts) < tiny(rts)) then rtsafe = rts return endif else dxold = dx dx = f/df temp = rts rts = rts - dx if (abs(temp-rts) < tiny(rts)) then rtsafe = rts return endif endif if (abs(dx) < xacc) then rtsafe = rts return endif call func(q, L, rts, f, df, xll) if (f < 0.0) then xl = rts else xh = rts endif enddo rtsafe = 0. return end function rtsafe real function left_limit(q, L) real, intent(in) :: q,L left_limit = rtsafe(rlimit,q,L,-0.5*L,-L,0., roche_accuracy); end function left_limit real function right_limit(q, L) real, intent(in) :: q,L right_limit = rtsafe(rlimit,q,L,1.5-0.5*L,2.0-L,0., roche_accuracy); end function right_limit ! ! return roche radius as fraction of the semi-major axis. ! So to obtain the true roche_radius call: ! real Rl = semi_major_axis * roche_radius(m1, m2); ! Eggleton PP., ApJ, 1983, 268, 368. ! real function roche_radius(mthis, mother) real, intent(in) :: mthis,mother real :: mr,q1_3,q2_3 mr = mthis/mother q1_3 = mr**(1./3.) q2_3 = q1_3**2 roche_radius = 0.49*q2_3/(0.6*q2_3 + log(1 + q1_3)) end function roche_radius real function first_Lagrangian_point(qinv) real, intent(in) :: qinv real :: fL, dfL, dL, L, q11 q11 = 1./(1.+qinv) L = 0.5 + 0.2222222*log10(qinv) dL = 1.e7 do while (abs(dL)>1.e-6) fL = qinv/L**2- 1./(1.-L)**2 - (1.+qinv)*L + 1. dfL=-2*qinv/L**3 - 2./(1.-L)**3 - (1.+qinv) dL = -fL/(dfL*L) L = L*(1.+dL) enddo first_Lagrangian_point = L end function first_Lagrangian_point subroutine rline(q, L, y, f, df, xl) real, intent(in) :: q, L, y, xl real, intent(out) :: f, df real :: xsq,onexsq,qi,q11,cnst,cnst2,r1,r2 xsq=xl*xl onexsq=(1.-xl)**2 qi=q q11=1./(1.+qi) cnst =qi/L+1./(1.-L) + 0.5*(1.+qi)*(L-q11)**2 cnst2=0.5*(1.+qi)*(xl-q11)**2 - cnst r1=sqrt(xsq+y) r2=sqrt(onexsq+y) f=qi/r1+1./r2+cnst2 df =-0.5*qi/r1**3 - 0.5/r2**3 end subroutine rline subroutine compute_lobes(q, L, npts, xplot, yplot) real, intent(in) :: q, L integer, intent(in) :: npts real, intent(out), dimension(2*npts+1) :: xplot,yplot real :: qi,q11,cnst,lrl,rrl,y1,y2,ysq,dxl,dxr integer :: i qi = 1/q q11 = 1./(1.+qi) cnst = qi/L+1./(1.-L) + 0.5*(1.+qi)*(L-q11)**2 lrl = left_limit(q, L) xplot(1) = lrl yplot(1) = 0. xplot(npts+1) = L yplot(npts+1) = 0. rrl = right_limit(q, L) xplot(2*npts) = rrl yplot(2*npts) = 0. y1 = 0. y2 = L*L !--left lobe dxl = (xplot(npts+1)-xplot(1))/real(npts) do i=1,npts xplot(i+1) = xplot(1) + i*dxl ysq = rtsafe(rline,qi,L,y1,y2,xplot(i+1),roche_accuracy) yplot(i+1) = sqrt(ysq) enddo !--right lobe dxr = (xplot(2*npts)-xplot(npts+1))/real(npts) do i=1,npts xplot(npts+i+1) = xplot(npts+1) + i*dxr ysq = rtsafe(rline,qi,L,y1,y2,xplot(npts+i+1),roche_accuracy) yplot(npts+i+1) = sqrt(ysq) enddo end subroutine compute_lobes end module rochelobe splash/src/exact_sedov.f90000644 000770 000000 00000016576 12554276077 016421 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !--------------------------------------------------------------------------- ! compute exact solution for Sedov-type point-like energy injection ! the solution is correct for 3D, I have attempted to fix it in 1D & 2D but ! not working yet. !--------------------------------------------------------------------------- module sedov implicit none public :: exact_sedov private :: etau,rhou,pru,dudlneta,eta0 contains subroutine exact_sedov(iplot,time,gam,rhozero,energy,rmax,rplot,yplot,ierr) implicit none integer, intent(in) :: iplot integer, intent(out) :: ierr real, intent(in) :: time, gam, rhozero, energy, rmax real, dimension(:), intent(inout) :: rplot real, dimension(size(rplot)), intent(out) :: yplot integer, parameter :: ndim = 3 integer :: npts real, parameter :: pi = 3.1415926536 real :: rshock, dr real :: rhoshock, ushock, prshock real :: eta_0, power real :: ubar,ubarzero,dubar real :: phi,dphi integer :: i,ishock ierr = 0 print*,' Plotting 3D Sedov similarity solution at t = ',time print*,' rhozero = ',rhozero,' energy = ',energy, ' rmax = ',rmax if (abs(time).lt.1.e-10) then print*,'nothing at t=0, returning' ierr = 1 return endif npts = size(rplot) eta_0 = eta0(gam,ndim) print*,' eta0 = ',eta_0, ' gamma = ',gam power = 1./(ndim+2) dr = rmax/float(npts-1) ! !--calculate radius and velocity of shock from dimensional analysis ! rshock = eta_0*(energy*time**2./rhozero)**power !! ushock = 2.*power*eta_0*((energy*time**2./rhozero)**(power-1.))*energy*time/rhozero ushock = 2.*power*rshock/time print*,' rshock = ',rshock, ' ushock = ',ushock ! !--on x-y plots plot a circle at radius rshock ! if (iplot.eq.0) then dphi = 2.*pi/real(npts-1) phi = 0. do i=1,npts phi = (i-1)*dphi rplot(i) = rshock*cos(phi) yplot(i) = rshock*sin(phi) enddo return endif ! !--jump conditions to find states behind shock ! rhoshock = rhozero*(gam+1.)/(gam-1.) prshock = 2./(gam+1.)*rhoshock*ushock**2 rplot(1) = 0.0 select case(iplot) case(2) yplot(1) = 0.0 ! shouldn't be zero for pressure case default yplot(1) = 0.0 end select ishock = INT((rshock - rplot(1))/dr) if (ishock.gt.0) then ishock = min(ishock,npts) ! !--the solution for rho is given as a function of ubar (dimensionless velocity) ! ubar varies from (gamma+1)/2*gamma at eta = 0 to 1 at eta = 1 ! (eta is the dimensionless radius eta = r/rshock, so eta=1 is the shock position) ! ubarzero = 0.5*(gam+1.)/gam dubar = (1.0 - ubarzero)/REAL(ishock-1) ! need to check the denominator ! !--solution behind shock front (similarity solution) ! (I really want to start from ubar = ubarzero, but am having problems) ! do i=2,ishock ubar = ubarzero + (i-1)*dubar ! again need to check this rplot(i) = etau(ubar,gam,ndim)*rshock select case(iplot) case(1) ! rho yplot(i) = rhoshock*rhou(ubar,gam) case(2) ! pr yplot(i) = prshock*(rplot(i)/rshock)**2*pru(ubar,gam) case(3) ! utherm yplot(i) = prshock*(rplot(i)/rshock)**2*pru(ubar,gam)/ & ((gam-1.)*rhoshock*rhou(ubar,gam)) case(4) ! 1/2 v^2 yplot(i) = 0.5*(4./(5.*(gam+1.))*rplot(i)/time*ubar)**2 case(5) yplot(i) = (4./(5.*(gam+1.))*rplot(i)/time*ubar) end select !print*,'u,r, rho = ',ubar,rplot(i),rhoplot(i) enddo endif ! !--solution ahead of shock front ! ishock = max(ishock,1) if (ishock.lt.npts) then do i=ishock,npts rplot(i) = rshock + (i-ishock)*dr select case(iplot) case(1) ! rho yplot(i) = rhozero case default ! pr,utherm,v yplot(i) = 0. end select enddo endif return end subroutine exact_sedov ! !--eta (dimensionless radius) as a function of u_bar (dimensionless velocity) ! real function etau(u,gamma,ndim) implicit none integer, intent(in) :: ndim real, intent(in) :: u,gamma real :: gam1,term1,term2,power1,power2 gam1 = gamma-1. power1 = (-12.+7.*gamma-13.*gamma**2)/(5.*(-1.+gamma+6.*gamma**2)) power2 = gam1/(1.+2.*gamma) term1 = ((5.+5.*gamma+2.*u-6.*gamma*u)/(7.-gamma))**power1 term2 = ((2.*gamma*u-gamma-1.)/gam1)**power2 etau = u**(-2./(ndim+2.))*term1*term2 end function etau ! !--rhobar (dimensionless density) as a function of u_bar (dimensionless velocity) ! real function rhou(u,gamma) implicit none real, intent(in) :: u,gamma real :: gam1,power1,power2,power3,term1,term2,term3 gam1 = gamma-1. power1 = (2./(gamma-2.)) power2 = -(12.-7.*gamma+13.*gamma**2)/(2.-3.*gamma-11.*gamma**2+6.*gamma**3) power3 = 3./(1.+2.*gamma) term1 = ((1.+ gamma - 2.*u)/gam1)**power1 term2 = ((5.+5.*gamma+2.*u-6.*gamma*u)/(7.-gamma))**power2 term3 = ((2.*gamma*u - gamma -1.)/gam1)**power3 rhou = term1*term2*term3 end function rhou ! !--prbar (dimensionless pressure) as a function of u_bar (dimensionless velocity) ! real function pru(u,gamma) implicit none real, intent(in) :: u,gamma pru = (gamma+1. - 2.*u)/(2.*gamma*u - gamma - 1.)*u**2*rhou(u,gamma) end function pru ! !--du /dln eta - required for the integral to compute eta0 ! real function dudlneta(u,gamma) implicit none real, intent(in) :: u,gamma real :: term1,term2 term1 = u*(5.+5.*gamma + 2.*u - 6.*gamma*u)*(-1.-gamma+2.*gamma*u) term2 = 2.*(1.+gamma)*(1.+gamma - 2.*u - 2.*gamma*u + 2.*gamma*u**2) dudlneta = term1/term2 end function dudlneta ! !--eta_0 as a function of gamma ! real function eta0(gamma,ndim) implicit none integer, parameter :: ipts = 50000 real, parameter :: pi = 3.1415926536 integer, intent(in) :: ndim real, intent(in) :: gamma integer :: i real :: u0, u, du real :: sum, term, weight, factor ! if (abs(gamma-5./3.).lt.1.e-3) then ! eta0 = 1.1517 ! else ! print*,'warning: don''t know eta0: integral not implemented' ! eta0 = 1.0 ! endif u0 = 0.5*(gamma+1.)/gamma du = (1. - u0)/REAL(ipts) ! !--integrate using Simpson's 1/3 rule ! sum = 0. do i=1,ipts weight = 1.0 if (mod(i,2).eq.0) then weight = 4./3. else weight = 2./3. endif if ((i.eq.1).or.(i.eq.ipts)) weight = 1./3. u = u0 + i*du term = (pru(u,gamma) + rhou(u,gamma)*u**2)*(etau(u,gamma,ndim)**(ndim+2))/dudlneta(u,gamma) sum = sum + weight*du*term enddo if (ndim.eq.3) then factor = 4.*pi elseif (ndim.eq.2) then factor = 2.*pi else factor = 1. endif eta0 = (factor*8.*sum/(25.*(gamma**2 - 1.)))**(-1./REAL(ndim+2)) end function eta0 end module sedov splash/src/exact_shock.f90000644 000770 000000 00000032102 12464520622 016353 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! compute exact solution for the one dimensional Riemann problem ! (hydrodynamic shock) ! ! input parameters are initial left and right states of ! density, pressure and velocity ! ! Computes shock profile at time t ! ! Calls a separate subroutine to calculate the post-shock pressure ! and velocity (this is the difficult bit). ! ! Handles all cases of left and right-going shocks and rarefactions ! ! Daniel Price, Institute of Astronomy, Cambridge, 2004 ! University of Exeter 2004-2008 ! Monash University 2008- ! ! dprice@astro.ex.ac.uk !----------------------------------------------------------------------- module shock implicit none public :: exact_shock private :: get_pstar, get_pstar_isothermal, f_and_df contains subroutine exact_shock(iplot,time,gammain,rho_L,rho_R,p_L,p_R,v_L,v_R,rdust_to_gas,xplot,yplot,ierr) implicit none integer, intent(in) :: iplot integer, intent(out) :: ierr real, intent(in) :: time,gammain real, intent(in) :: rho_L,rho_R,p_L,p_R,v_L,v_R,rdust_to_gas real, dimension(:), intent(in) :: xplot real, dimension(size(xplot)), intent(out) :: yplot integer :: i real, dimension(size(xplot)) :: dens, pr, vel real :: cs_L,cs_R, gamfac real :: ppost, vpost, vleft, vright, gamma real :: xzero,xleft,xleftleft,xcontact,xright,xrightright logical :: useisothermal,leftisshock,rightisshock gamma = gammain print*,'Plotting exact Riemann solution at t = ',time,' gamma = ',gamma ! ! check for errors in input ! ierr = 0 if (rho_L.le.0. .or. rho_R.le.0.) then print*,'error: rho <= 0 on input : ',rho_L,rho_R ierr = 1 return elseif (p_L .le.0. .or. p_R .le.0.) then print*,'error: pr <= 0 on input ',p_L, p_R ierr = 2 return endif if (gamma < 1.) then print*,'Error: gamma = ',gamma,' setting to 5/3' gamma = 5./3. endif ! ! xzero is the position of the shock at t=0 ! xzero = 0. ! ! define sound speeds to left and right of shock tube ! cs_L = sqrt(gamma*p_L/rho_L) cs_R = sqrt(gamma*p_R/rho_R) if (rdust_to_gas .gt.epsilon(rdust_to_gas)) then cs_L = cs_L*sqrt(1./(1.+rdust_to_gas)) cs_R = cs_R*sqrt(1./(1.+rdust_to_gas)) endif gamfac = (gamma-1.)/(gamma + 1.) !------------------------------------------------------------ ! find post-shock pressure via the Riemann solver ! (this version also returns the post shock speed vpost ! although this can be calculated from ppost) !------------------------------------------------------------ if (gamma.gt.1.0001) then call get_pstar(gamma,p_L,p_R,v_L,v_R,cs_L,cs_R,ppost,vpost) useisothermal = .false. else print*,'using isothermal solver...',p_L/rho_L, p_R/rho_R useisothermal = .true. call get_pstar_isothermal(cs_L*cs_L,v_L,v_R,rho_L,rho_R,ppost,vpost) endif !------------------------------------------------------------ ! using this, calculate various speeds needed in order to ! reconstruct the shock profile !------------------------------------------------------------ ! ! check whether solutions are shocks or rarefactions ! if (ppost .gt. p_L) then leftisshock = .true. else leftisshock = .false. endif if (ppost .gt. p_R) then rightisshock = .true. else rightisshock = .false. endif if (leftisshock) then write(*,"(a)",advance='no') ' left-going wave is a shock; ' else write(*,"(a)",advance='no') ' left-going wave is a rarefaction; ' endif if (rightisshock) then write(*,"(a)") 'right-going wave is a shock' else write(*,"(a)") 'right-going wave is a rarefaction' endif if (rightisshock) then ! right hand wave is a shock ! ! speed of the shock front ! vright = v_R + cs_R**2*(ppost/p_R - 1.)/(gamma*(vpost-v_R)) else ! right hand wave is a rarefaction ! ! speed at which the right end of rarefaction fan moves ! vright = cs_R + 0.5*(gamma+1.)*vpost - 0.5*(gamma-1.)*v_R endif ! ! repeat for left-going wave ! if (leftisshock) then vleft = -(v_L + cs_L**2*(ppost/p_L - 1.)/(gamma*(vpost-v_L))) else vleft = cs_L - 0.5*(gamma+1.)*vpost + 0.5*(gamma-1.)*v_L endif !------------------------------------------------------------- ! now work out the locations of various features in the shock !------------------------------------------------------------- ! ! position of left-going shock or back end of left-going rarefaction ! xleft = xzero - vleft*time if (leftisshock) then xleftleft = xleft else ! ! front end of left-going expansion fan (propagates at sound speed into "left" fluid) ! xleftleft = xzero - (cs_L - v_L)*time endif ! ! position of the interface between the "left" fluid from the "right" fluid ! (the contact discontinuity) ! xcontact = xzero + vpost*time ! ! position of right-going shock or back end of right-going rarefaction ! xright = xzero + vright*time if (rightisshock) then xrightright = xright else ! ! right end of right-going expansion fan (propagates at sound speed into "right" fluid) ! xrightright = xzero + (cs_R + v_R)*time endif !-------------------------------------------------------------- ! reconstruct the shock profile for all x !-------------------------------------------------------------- !--here is a cheap, dirty f90 version for crap compilers do i=1,size(xplot) if (xplot(i) <= xleftleft) then ! undisturbed medium to the left pr(i) = p_L dens(i) = rho_L vel(i) = v_L elseif (xplot(i) < xleft) then if (leftisshock) then pr(i) = ppost dens(i) = rho_L*(gamfac+ppost/p_L)/(1+gamfac*ppost/p_L) ! dens(i) = rho_L*(ppost/p_L)**(1./gamma) vel(i) = vpost else ! inside expansion fan if (useisothermal) then ! this is a bit of a guess dens(i) = rho_L*exp((xleftleft-xplot(i))/(cs_L*time) + v_L/cs_L) else dens(i) = rho_L*(gamfac*(xzero-xplot(i))/(cs_L*time) + gamfac*v_L/cs_L + (1.-gamfac))**(2./(gamma-1.)) endif pr(i) = p_L*(dens(i)/rho_L)**gamma vel(i) = (1.-gamfac)*(cs_L -(xzero-xplot(i))/time) + gamfac*v_L endif elseif (xplot(i) < xcontact) then ! between left expansion fan/shock and contact discontinuity ! post-shock, ahead of contact discontinuity but before right going wave pr(i) = ppost if (leftisshock) then dens(i) = rho_L*(gamfac+ppost/p_L)/(1+gamfac*ppost/p_L) else dens(i) = rho_L*(ppost/p_L)**(1./gamma) endif vel(i) = vpost elseif (xplot(i) < xright) then ! post-shock, ahead of contact discontinuity but before right going wave pr(i) = ppost if (rightisshock) then dens(i) = rho_R*(gamfac+ppost/p_R)/(1+gamfac*ppost/p_R) else dens(i) = rho_R*(ppost/p_R)**(1./gamma) endif vel(i) = vpost elseif (xplot(i) < xrightright) then if (rightisshock) then ! irrelevant as in this case xrightright = xright else ! inside expansion fan to right if (useisothermal) then ! this is a bit of a guess dens(i) = rho_R*exp(-(xrightright-xplot(i))/(cs_R*time) - v_R/cs_R) else dens(i) = rho_R*(gamfac*(xplot(i)-xzero)/(cs_R*time) - gamfac*v_R/cs_R + (1.-gamfac))**(2./(gamma-1.)) endif pr(i) = p_R*(dens(i)/rho_R)**gamma vel(i) = (1.-gamfac)*(-cs_R - (xzero-xplot(i))/time) + gamfac*v_R endif else ! undisturbed medium to the right pr(i) = p_R dens(i) = rho_R vel(i) = v_R endif enddo !--this is the beautiful, f95 version (which won't compile on pgf90) ! where(xplot <= xleft) ! <= otherwise problems at t=0 !! undisturbed medium to the left ! pr = p_L ! dens = rho_L ! vel = v_L ! elsewhere(xplot < xfan) !! inside expansion fan ! dens = rho_L*(gamfac*(xzero-xplot)/(cs_L*time) + (1.-gamfac))**(2./(gamma-1.)) ! pr = p_L*(dens/rho_L)**gamma ! vel = (1.-gamfac)*(cs_L -(xzero-xplot)/time) ! elsewhere(xplot < xcontact) !! between expansion fan and contact discontinuity ! pr = ppost ! dens = rho_L*(ppost/p_L)**(1./gamma) ! vel = vpost ! elsewhere(xplot < xshock) !! post-shock, ahead of contact discontinuity ! pr = ppost ! dens = rho_R*(gamfac+ppost/p_R)/(1+gamfac*ppost/p_R) ! vel = vpost ! elsewhere !! undisturbed medium to the right ! pr = p_R ! dens = rho_R ! vel = v_R ! end where !------------------------------------ ! determine which solution to plot !------------------------------------ select case(iplot) case(1) yplot = dens case(2) yplot = pr case(3) yplot = vel case(4) if (gamma.gt.1.0001) then yplot = pr/((gamma-1.)*dens) else yplot = pr/dens endif case(5) ! deltav, where vd = 0 yplot = -vel case(6) ! eps, where rhod = const yplot = rho_R/(dens + rho_R) end select return end subroutine exact_shock !------------------------------------------------------------------- ! Implementation of the exact Riemann solver given in Toro (1992) ! ! Solves for the post-shock pressure (pr) and velocity (vstar) ! given the initial left and right states ! ! Does not matter if high P / high rho is on left or right ! ! Daniel Price, Institute of Astronomy, Cambridge, UK, 2004 ! dprice@ast.cam.ac.uk !------------------------------------------------------------------- subroutine get_pstar(gamma,p_L,p_R,v_L,v_R,c_L,c_R,pr,vstar) implicit none real, parameter :: tol = 1.5e-6 real, intent(in) :: gamma,p_L,p_R,v_L,v_R,c_L,c_R real, intent(out) :: pr,vstar integer, parameter :: maxits = 30 integer :: its real :: prnew, f_L, f_R, dfdp_L, dfdp_R, f, df, dp real :: power, denom ! !--get an initial starting estimate of intermediate pressure ! this one is from Toro(1992) - gives basically the right answer ! for pressure jumps below about 4 ! power = (gamma-1.)/(2.*gamma) denom = c_L/p_L**power + c_R/p_R**power prnew = ((c_L + c_R + (v_L - v_R)*0.5*(gamma-1.))/denom)**(1./power) pr = p_L its = 0 !!print*,'initial guess = ',prnew do while (abs(prnew-pr).gt.tol .and. its.lt.maxits) its = its + 1 pr = prnew ! !--evaluate the function and its derivatives ! call f_and_df(pr,p_L,c_L,gamma,f_L,dfdp_L) call f_and_df(pr,p_R,c_R,gamma,f_R,dfdp_R) ! !--then get new estimate of pr ! f = f_L + f_R + (v_R - v_L) df = dfdp_L + dfdp_R ! !--Newton-Raphson iterations ! dp = -f/df prnew = pr + dp enddo if (its.eq.maxits) print*,'WARNING: its not converged in riemann solver' pr = prnew vstar = v_L - f_L print*,'its =',its,' p* =',prnew,'v* =',vstar,v_R + f_R end subroutine get_pstar ! !--pressure function ! H is pstar/p_L or pstar/p_R ! subroutine f_and_df(prstar,pr,cs,gam,fp,dfdp) implicit none real, intent(in) :: prstar, pr, gam, cs real, intent(out) :: fp,dfdp real :: H,term, power, gamm1, denom H = prstar/pr gamm1 = gam - 1. if (H.gt.1.) then ! shock denom = gam*((gam+1.)*H + gamm1) term = sqrt(2./denom) fp = (H - 1.)*cs*term dfdp = cs*term/pr + (H - 1.)*cs/term*(-1./denom**2)*gam*(gam+1.)/pr else ! rarefaction power = gamm1/(2.*gam) fp = (H**power - 1.)*(2.*cs/gamm1) dfdp = 2.*cs/gamm1*power*H**(power-1.)/pr endif end subroutine f_and_df !------------------------------------------------------------- ! Non-iterative isothermal Riemann solver ! from Balsara (1994), ApJ 420, 197-212 ! ! See also Cha & Whitworth (2003), MNRAS 340, 73-90 !------------------------------------------------------------- subroutine get_pstar_isothermal(cs2,v_L,v_R,rho_L,rho_R,pstar,vstar) implicit none real, intent(in) :: cs2,v_L,v_R,rho_L,rho_R real, intent(out) :: pstar,vstar real :: sqrtrho_L, sqrtrho_R, X, vdiff, determinant, vstar2 sqrtrho_L = sqrt(rho_L) sqrtrho_R = sqrt(rho_R) X = sqrtrho_L*sqrtrho_R/(sqrtrho_L + sqrtrho_R) vdiff = v_L - v_R determinant = (X*vdiff)**2 + 4.*cs2*X*(sqrtrho_L + sqrtrho_R) pstar = 0.25*(X*vdiff + sqrt(determinant))**2 vstar = v_L - (pstar - cs2*rho_L)/(sqrt(pstar*rho_L)) vstar2 = v_R + (pstar - cs2*rho_R)/(sqrt(pstar*rho_R)) print*,' pstar = ',pstar,' vstar = ',vstar,vstar2 end subroutine get_pstar_isothermal end module shock splash/src/exact_shock_sr.f90000644 000770 000000 00000043645 12017612622 017071 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! compute exact solution for the one dimensional Riemann problem ! in Special Relativity ! ! input parameters are initial left and right states of ! density, pressure and velocity ! ! Computes shock profile at time t ! ! Calls the exact solution routine provided by Marti & Mueller ! ! Daniel Price, Institute of Astronomy, Cambridge, 2004 ! University of Exeter 2004-2008 ! Monash University 2008- ! ! daniel.price@monash.edu !----------------------------------------------------------------------- module shock_sr implicit none public :: exact_shock_sr contains subroutine exact_shock_sr(iplot,time,gamma,rho_L,rho_R,p_L,p_R,v_L,v_R,xplot,yplot,ierr) implicit none integer, intent(in) :: iplot integer, intent(out) :: ierr real, intent(in) :: time,gamma real, intent(in) :: rho_L,rho_R,p_L,p_R,v_L,v_R real, dimension(:), intent(inout) :: xplot real, dimension(size(xplot)), intent(out) :: yplot double precision, dimension(size(xplot)) :: rad,dens,pr,vel,uu double precision :: rhol,rhor,pl,prr,vl,vr,gam,t print*,'Plotting Special Relativistic Riemann solution at t = ',time,' gamma = ',gamma ! ! check for errors in input ! ierr = 0 if (rho_L.le.0. .or. rho_R.le.0.) then print*,'error: rho <= 0 on input : ',rho_L,rho_R ierr = 1 return elseif (p_L .le.0. .or. p_R .le.0.) then print*,'error: pr <= 0 on input ',p_L, p_R ierr = 2 return endif rhol = rho_L rhor = rho_R pl = p_L prr = p_R vl = v_L vr = v_R gam = gamma t = time rad(:) = xplot(:) call riemann(size(xplot),rad,dens,pr,vel,uu,rhol,rhor,pl,prr,vl,vr,gam,t,0.0d0) !------------------------------------ ! determine which solution to plot !------------------------------------ select case(iplot) case(1) yplot = real(dens) case(2) yplot = real(pr) case(3) yplot = real(vel) case(4) if (gamma.gt.1.0001) then yplot = real(pr/((gamma-1.)*dens)) else yplot = real(pr/dens) endif case(5) ! rho* yplot = real(dens/dsqrt(1.d0-vel**2)) end select return end subroutine exact_shock_sr ! ------------ !n name: r i e m a n n ! ------------ !p purpose: !p this program computes the solution of a 1d !p relativistic riemann problem (for constant-gamma ideal gases) with !p initial data ul if x<0.5 and ur if x>0.5 !p in the whole spatial domain [0, 1] ! !c comments: !c see marti and mueller, jfm, 1994 !c !c written by: jose-maria marti !c departamento de astronomia y astrofisica !c universidad de valencia !c 46100 burjassot (valencia), spain !c jose-maria.marti@uv.es !c and !c ewald mueller !c max-planck-institut fuer astrophysik !c karl-schwarzschild-str. 1 !c 85741 garching, germany !c emueller@mpa-garching.mpg.de !c !c Modifications by D. Price (daniel.price@sci.monash.edu.au): !c 07/2007: used as subroutine instead of program !c 09/2008: reformatted in free-form and included in exact_shock_sr module !c subroutine riemann(mn,rad,rhoa,pa,vela,ua,rholin,rhorin,plin,prin, & vlin,vrin,gamin,tin,x0) implicit none ! ------- ! common blocks ! ------- double precision rhol, pl, ul, hl, csl, vell, wl, & rhor, pr, ur, hr, csr, velr, wr common /states/ rhol, pl, ul, hl, csl, vell, wl, & rhor, pr, ur, hr, csr, velr, wr double precision rhols, uls, hls, csls, vells, vshockl common /ls/ rhols, uls, hls, csls, vells, vshockl double precision rhors, urs, hrs, csrs, velrs, vshockr common /rs/ rhors, urs, hrs, csrs, velrs, vshockr double precision gamma common /adind/ gamma ! --------- ! internal variables ! --------- integer, intent(in) :: mn integer n, i, iloop ! parameter (mn = 400) double precision tol, pmin, pmax, dvel1, dvel2, check !, xmin double precision, intent(in) :: rholin,rhorin,plin,prin,vlin,vrin,gamin,tin double precision ps, vels double precision, intent(out) :: rhoa(mn), pa(mn), vela(mn), ua(mn) double precision, intent(in) :: x0 double precision xi double precision, intent(in) :: rad(mn) double precision x1, x2, x3, x4, x5, t ! ------- ! initial states ! ------- ! write(*,*) ' adiabatic index of the gas: ' ! read (*,*) gamma gamma = gamin ! write(*,*) ' time for the solution: ' ! read (*,*) t t = tin ! xmin = x0 - 0.5d0 ! ----- ! left state ! ----- ! write(*,*) ' -- left state -- ' ! write(*,*) ' pressure : ' ! read (*,*) pl ! write(*,*) ' density : ' ! read (*,*) rhol ! write(*,*) ' flow velocity: ' ! read (*,*) vell pl = plin rhol = rholin vell = vlin pr = prin rhor = rhorin velr = vrin ! ------ ! right state ! ------ ! write(*,*) ' -- right state -- ' ! write(*,*) ' pressure : ' ! read (*,*) pr ! write(*,*) ' density : ' ! read (*,*) rhor ! write(*,*) ' flow velocity: ' ! read (*,*) velr ! ------------------------------ ! specific internal energy, specific enthalpy, sound speed and ! flow lorentz factors in the initial states ! ------------------------------ ul = pl/(gamma-1.d0)/rhol ur = pr/(gamma-1.d0)/rhor hl = 1.d0+ul+pl/rhol hr = 1.d0+ur+pr/rhor csl = dsqrt(gamma*pl/rhol/hl) csr = dsqrt(gamma*pr/rhor/hr) wl = 1.d0/dsqrt(1.d0-vell**2) wr = 1.d0/dsqrt(1.d0-velr**2) ! -------- ! number of points ! -------- n = mn ! ------------- ! tolerance for the solution ! ------------- tol = 0.d0 ! iloop = 0 pmin = (pl + pr)/2.d0 pmax = pmin 5 iloop = iloop + 1 pmin = 0.5d0*max(pmin,0.d0) pmax = 2.d0*pmax call getdvel(pmin, dvel1) call getdvel(pmax, dvel2) check = dvel1*dvel2 if (check.gt.0.d0) goto 5 ! --------------------------- ! pressure and flow velocity in the intermediate states ! --------------------------- call getp(pmin, pmax, tol, ps) vels = 0.5d0*(vells + velrs) ! --------------- ! solution on the numerical mesh ! --------------- ! ----------- ! positions of the waves ! ----------- if (pl.ge.ps) then x1 = x0 + (vell - csl )/(1.d0 - vell*csl )*t x2 = x0 + (vels - csls)/(1.d0 - vels*csls)*t else x1 = x0 + vshockl*t x2 = x1 end if x3 = x0 + vels*t if (pr.ge.ps) then x4 = x0 + (vels + csrs)/(1.d0 + vels*csrs)*t x5 = x0 + (velr + csr )/(1.d0 + velr*csr )*t else x4 = x0 + vshockr*t x5 = x4 end if ! ---------- ! solution on the mesh ! ---------- !do i=1,n ! rad(i) = xmin + dfloat(i-1)/dfloat(n-1) !enddo do i=1,n if (rad(i).le.x1) then pa(i) = pl rhoa(i) = rhol vela(i) = vell ua(i) = ul else if (rad(i).le.x2) then xi = (rad(i) - x0)/t call raref(xi, rhol, csl, vell, 'l', & rhoa(i), pa(i), ua(i), vela(i)) else if (rad(i).le.x3) then pa(i) = ps rhoa(i) = rhols vela(i) = vels ua(i) = uls else if (rad(i).le.x4) then pa(i) = ps rhoa(i) = rhors vela(i) = vels ua(i) = urs else if (rad(i).le.x5) then xi = (rad(i) - x0)/t call raref(xi, rhor, csr, velr, 'r', & rhoa(i), pa(i), ua(i), vela(i)) else pa(i) = pr rhoa(i) = rhor vela(i) = velr ua(i) = ur end if enddo ! open (3,file='solution.dat',form='formatted',status='new') ! write(3,150) n, t ! 150 format(i5,1x,f10.5) ! do 60 i=1,n ! write(3,200) rad(i),pa(i),rhoa(i),vela(i),ua(i) ! 60 continue ! 200 format(5(e15.8,1x)) ! close(3) return end subroutine riemann ! ---------- !n name: g e t d v e l ! ---------- !p purpose: !p compute the difference in flow speed between left and right intermediate !p states for given left and right states and pressure ! !c comments !c none subroutine getdvel( p, dvel ) implicit none ! ----- ! arguments ! ----- doubleprecision, intent(in) :: p doubleprecision, intent(out) :: dvel ! ------- ! common blocks ! ------- double precision rhols,uls,hls,csls,vells,vshockl common /ls/ rhols,uls,hls,csls,vells,vshockl double precision rhors,urs,hrs,csrs,velrs,vshockr common /rs/ rhors,urs,hrs,csrs,velrs,vshockr double precision rhol, pl, ul, hl, csl, vell, wl, & rhor, pr, ur, hr, csr, velr, wr common /states/ rhol, pl, ul, hl, csl, vell, wl, & rhor, pr, ur, hr, csr, velr, wr double precision gamma common /adind/ gamma ! ----- ! left wave ! ----- call getvel(p, rhol, pl, hl, csl, vell, wl, 'l', & rhols, uls, hls, csls, vells, vshockl ) ! ----- ! right wave ! ----- call getvel(p, rhor, pr, hr, csr, velr, wr, 'r', & rhors, urs, hrs, csrs, velrs, vshockr ) dvel = vells - velrs return end subroutine getdvel ! ------- !n name: g e t p ! ------- !p purpose: !p find the pressure in the intermediate state of a riemann problem in !p relativistic hydrodynamics ! !c comments: !c this routine uses a combination of interval bisection and inverse !c quadratic interpolation to find the root in a specified interval. !c it is assumed that dvel(pmin) and dvel(pmax) have opposite signs without !c a check. !c adapted from "computer methods for mathematical computation", !c by g. e. forsythe, m. a. malcolm, and c. b. moler, !c prentice-hall, englewood cliffs n.j. ! subroutine getp( pmin, pmax, tol, ps ) implicit none ! ----- ! arguments ! ----- doubleprecision, intent(in) :: pmin, pmax, tol doubleprecision, intent(out) :: ps ! ------- ! common blocks ! ------- doubleprecision gamma common /adind/ gamma doubleprecision rhol, pl, ul, hl, csl, vell, wl, & rhor, pr, ur, hr, csr, velr, wr common /states/ rhol, pl, ul, hl, csl, vell, wl, & rhor, pr, ur, hr, csr, velr, wr ! --------- ! internal variables ! --------- doubleprecision a, b, c, d, e, eps, fa, fb, fc, tol1, xm, p, q, r, s ! ------------- ! compute machine precision ! ------------- eps = 1.d0 10 eps = eps/2.d0 tol1 = 1.d0 + eps if( tol1 .gt. 1.d0 ) go to 10 ! ------- ! initialization ! ------- a = pmin b = pmax call getdvel(a,fa) call getdvel(b,fb) ! ----- ! begin step ! ----- 20 c = a fc = fa d = b - a e = d 30 if( dabs(fc) .ge. dabs(fb) )go to 40 a = b b = c c = a fa = fb fb = fc fc = fa ! -------- ! convergence test ! -------- 40 tol1 = 2.d0*eps*dabs(b) + 0.5d0*tol xm = 0.5d0*(c - b) if( dabs(xm) .le. tol1 ) go to 90 if( fb .eq. 0.d0 ) go to 90 ! ------------ ! is bisection necessary? ! ------------ if( dabs(e) .lt. tol1 ) go to 70 if( dabs(fa) .le. dabs(fb) ) go to 70 ! ------------------ ! is quadratic interpolation possible? ! ------------------ if( a .ne. c ) go to 50 ! ---------- ! linear interpolation ! ---------- s = fb/fa p = 2.d0*xm*s q = 1.d0 - s go to 60 ! ---------------- ! inverse quadratic interpolation ! ---------------- 50 q = fa/fc r = fb/fc s = fb/fa p = s*(2.d0*xm*q*(q - r) - (b - a)*(r - 1.d0)) q = (q - 1.d0)*(r - 1.d0)*(s - 1.d0) ! ------ ! adjust signs ! ------ 60 if( p .gt. 0.d0 ) q = -q p = dabs(p) ! -------------- ! is interpolation acceptable? ! -------------- if( (2.d0*p) .ge. (3.d0*xm*q-dabs(tol1*q)) ) go to 70 if( p .ge. dabs(0.5d0*e*q) ) go to 70 e = d d = p/q go to 80 ! ----- ! bisection ! ----- 70 d = xm e = d ! ------- ! complete step ! ------- 80 a = b fa = fb if( dabs(d) .gt. tol1 ) b = b+d if( dabs(d) .le. tol1 ) b = b+dsign(tol1,xm) call getdvel(b,fb) if( (fb*(fc/dabs(fc))) .gt. 0.d0) go to 20 go to 30 ! -- ! done ! -- 90 ps = b return end subroutine getp ! --------- !n name: g e t v e l ! --------- !p purpose: !p compute the flow velocity behind a rarefaction or shock in terms of the !p post-wave pressure for a given state ahead the wave in a relativistic !p flow ! !c comments: !c this routine closely follows the expressions in Marti and Mueller, !c J. fluid mech., (1994) subroutine getvel( p, rhoa, pa, ha, csa, vela, wa, s, & rho, u, h, cs, vel, vshock ) implicit none ! ----- ! arguments ! ----- double precision, intent(in) :: p, rhoa, pa, ha, csa, vela, wa character(len=1), intent(in) :: s double precision, intent(out) :: rho, u, h, cs, vel, vshock ! ------- ! common blocks ! ------- double precision gamma common /adind/ gamma ! --------- ! internal variables ! --------- double precision a, b, c, sign double precision j, wshock double precision k, sqgl1 ! --------------- ! left or right propagating wave ! --------------- sign = 0.d0 if (s.eq.'l') sign = -1.d0 if (s.eq.'r') sign = 1.d0 ! if (p.gt.pa) then ! --- ! shock ! --- a = 1.d0+(gamma-1.d0)*(pa-p)/gamma/p b = 1.d0-a c = ha*(pa-p)/rhoa-ha**2 ! ---------------- ! check for unphysical enthalpies ! ---------------- if (c.gt.(b**2/4.d0/a)) then print*,'getvel: unphysical specific enthalpy in intermediate state' return endif ! ----------------------------- ! specific enthalpy in the post-wave state ! (from the equation of state and the taub adiabat, ! eq.(74), mm94) ! ----------------------------- h = (-b+dsqrt(b**2-4.d0*a*c))/2.d0/a ! --------------- ! density in the post-wave state ! (from eq.(73), mm94) ! --------------- rho = gamma*p/(gamma-1.d0)/(h-1.d0) ! ------------------------ ! specific internal energy in the post-wave state ! (from the equation of state) ! ------------------------ u = p/(gamma-1.d0)/rho ! -------------------------- ! mass flux across the wave ! (from the rankine-hugoniot relations, eq.(71), mm94) ! -------------------------- j = sign*dsqrt((p-pa)/(ha/rhoa-h/rho)) ! ---------- ! shock velocity ! (from eq.(86), mm94 ! ---------- a = j**2+(rhoa*wa)**2 b = -vela*rhoa**2*wa**2 vshock = (-b+sign*j**2*dsqrt(1.d0+rhoa**2/j**2))/a wshock = 1.d0/dsqrt(1.d0-vshock**2) ! ------------------- ! flow velocity in the post-shock state ! (from eq.(67), mm94) ! ------------------- a = wshock*(p-pa)/j+ha*wa*vela b = ha*wa+(p-pa)*(wshock*vela/j+1.d0/rhoa/wa) vel = a/b ! --------------------- ! local sound speed in the post-shock state ! (from the equation of state) ! --------------------- cs = dsqrt(gamma*p/rho/h) else ! ------ ! rarefaction ! ------ ! --------------------------- ! politropic constant of the gas across the rarefaction ! --------------------------- k = pa/rhoa**gamma ! --------------- ! density behind the rarefaction ! --------------- rho = (p/k)**(1.d0/gamma) ! ------------------------ ! specific internal energy behind the rarefaction ! (from the equation of state) ! ------------------------ u = p/(gamma-1.d0)/rho ! -------------------- ! local sound speed behind the rarefaction ! (from the equation of state) ! -------------------- cs = dsqrt(gamma*p/(rho+gamma*p/(gamma-1.d0))) ! ------------------ ! flow velocity behind the rarefaction ! ------------------ sqgl1 = dsqrt(gamma-1.d0) a = (1.d0+vela)/(1.d0-vela)*((sqgl1+csa)/(sqgl1-csa)* & (sqgl1-cs )/(sqgl1+cs ))**(-sign*2.d0/sqgl1) vel = (a-1.d0)/(a+1.d0) end if end subroutine getvel ! -------- !n name: r a r e f ! -------- !p purpose: !p compute the flow state in a rarefaction for given pre-wave state ! !c comments: !c this routine closely follows the expressions in marti and mueller, !c j. fluid mech., (1994) subroutine raref( xi, rhoa, csa, vela, s, rho, p, u, vel ) implicit none ! ----- ! arguments ! ----- double precision, intent(in) :: xi double precision, intent(in) :: rhoa, csa, vela character, intent(in) :: s double precision, intent(out) :: rho, p, u, vel ! ------- ! common blocks ! ------- double precision gamma common /adind/ gamma ! --------- ! internal variables ! --------- double precision b, c, d, k, l, v, ocs2, fcs2, dfdcs2, cs2, sign ! --------------- ! left or right propagating wave ! --------------- sign = 0.d0 if (s.eq.'l') sign = 1.d0 if (s.eq.'r') sign = -1.d0 b = dsqrt(gamma - 1.d0) c = (b + csa)/(b - csa) d = -sign*b/2.d0 k = (1.d0 + xi)/(1.d0 - xi) l = c*k**d v = ((1.d0 - vela)/(1.d0 + vela))**d ocs2 = csa 25 fcs2 = l*v*(1.d0 + sign*ocs2)**d*(ocs2 - b) + (1.d0 - sign*ocs2)**d*(ocs2 + b) dfdcs2 = l*v*(1.d0 + sign*ocs2)**d* & (1.d0 + sign*d*(ocs2 - b)/(1.d0 + sign*ocs2)) + & (1.d0 - sign*ocs2)**d* & (1.d0 - sign*d*(ocs2 + b)/(1.d0 - sign*ocs2)) cs2 = ocs2 - fcs2/dfdcs2 if (abs(cs2 - ocs2)/ocs2.gt.5.e-7)then ocs2 = cs2 goto 25 end if vel = (xi + sign*cs2)/(1.d0 + sign*xi*cs2) rho = rhoa*((cs2**2*(gamma - 1.d0 - csa**2))/ & (csa**2*(gamma - 1.d0 - cs2**2)))**(1.d0/(gamma - 1.d0)) p = cs2**2*(gamma - 1.d0)*rho/(gamma - 1.d0 - cs2**2)/gamma u = p/(gamma - 1.d0)/rho return end subroutine raref end module shock_sr splash/src/exact_torus.f90000644 000770 000000 00000010301 12517310427 016414 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! Plots solution for equilibrium torus of Papaloizou & Pringle ! strictly valid for the midplane only (uses spherical r) ! ! Added by D. Price 16.1.06 ! ---------------------------------------------------------------------- module torus implicit none contains subroutine exact_torus(iplot,itorus,Mstar,Rtorus,AA,distortion,gamma,xplot,yplot,ierr) implicit none integer, intent(in) :: iplot,itorus real, intent(in) :: Mstar,Rtorus,AA,gamma,distortion real, intent(in), dimension(:) :: xplot real, intent(out), dimension(size(xplot)) :: yplot real :: term,densi,rxy integer, intent(out) :: ierr integer :: i,mytorus real :: ra2 integer, parameter :: nu = 2 real, parameter :: atorus = 0.2, currj0 = 1.0 ! ! check for errors ! ierr = 0 if (Mstar.le.0.) then print*,'error: mass <= 0 in exact_torus' ierr = 2 return elseif (Rtorus.lt.0.) then print*,'error: rtorus < 0 in exact_torus' ierr = 3 return endif mytorus = 1 select case(mytorus) ! !--Tokamak torus (in torus 'r' co-ordinate) ! case(2) if (nu.le.0 .or. (iplot.lt.4 .and. nu.gt.2)) then print*,'error: solution not found for nu value in tokamak torus' ierr = 5 return endif print*,' plotting tokamak torus' do i=1,size(xplot) ra2 = xplot(i)**2/atorus**2 if (nu.eq.1) then term = currj0**2*atorus**2*(1. - ra2)*(7.*ra2**2 - 23.*ra2 + 13.)/96. elseif (nu.eq.2) then term = currj0**2*atorus**2*(47. - 12.*ra2**5 + 75.*ra2**4 - 200.*ra2**3 + 270.*ra2**2 - 180*ra2)/720. endif if (abs(ra2) < tiny(ra2)) print*,'rho0 = ',term select case(iplot) case(1) !--density yplot(i) = Mstar*term**gamma case(2) !--pressure yplot(i) = term case(3) !--thermal energy yplot(i) = term case(4) !--Btheta if (xplot(i).gt.tiny(xplot(i))) then yplot(i) = 0.5*currj0*atorus**2/(nu+1)* & (1.-(1.-ra2)**(nu+1))/xplot(i) else yplot(i) = 0. endif case(5) !--Jphi current yplot(i) = currj0*(1. - ra2)**nu end select enddo ! !--Papaloizou & Pringle equilibrium torus ! case default if ((gamma-1.).le.1e-4) then print*,'error: exact solution not valid for isothermal eos' ierr = 4 return endif do i=1,size(xplot) if (iplot.ne.4) then !--plot quantities vs spherical r (assume z = 0) term = Mstar/(AA*Rtorus)*(gamma-1.)/gamma* & (Rtorus/xplot(i) - 0.5*(Rtorus/xplot(i))**2 - 1./(2.*distortion)) else !--plots with z (assume cyl r = Rtorus) rxy = sqrt(Rtorus**2 + xplot(i)**2) term = Mstar/(AA*Rtorus)*(gamma-1.)/gamma* & (Rtorus/rxy - 0.5 - 1./(2.*distortion)) endif if (term.gt.tiny(term)) then densi = term**(1./(gamma-1.)) else densi = 0. endif select case(iplot) case(1) !--density yplot(i) = densi case(2,4) !--pressure yplot(i) = AA*densi**gamma case(3) !--thermal energy yplot(i) = AA/(gamma-1.)*densi**(gamma-1.) end select enddo end select return end subroutine exact_torus end module torus splash/src/exact_toystar1D.f90000644 000770 000000 00000027076 11622211702 017143 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------ ! plot exact solution for toystar in one dimension ! ! linear solution uses Gegenbauer/Legendre polynomials ! ! non-linear solution solves ODEs, assumes linear velocity ! ! For details see Monaghan and Price (2004) MNRAS !------------------------------------------------------------ module toystar1D implicit none public :: exact_toystar1D, exact_toystar_ACplane private :: Pm, Gn contains subroutine exact_toystar1D(iplot,time,gamma,H0,A0,C0, & sigma,norder,xplot,yplot,npts,ierr) use plotlib, only:plot_pt1 implicit none integer, intent(in) :: iplot,norder,npts integer, intent(out) :: ierr real, intent(in) :: time,gamma,sigma real, intent(in) :: H0, C0, A0 ! parameters for toy star real, dimension(:), intent(inout) :: xplot real, dimension(size(xplot)), intent(out) :: yplot integer :: i,nsteps real :: const ! parameter for toy star real :: Hprev, Cprev, Aprev, Htemp, Ctemp, Atemp, H, C, A real :: radstar,dx,dt,tnow real :: rhoplot,deltarho real :: fprevC,fprevA,fprevH,ftempC,ftempA,ftempH real :: gamp1,gamm1,gam1,fact,constK,omega real :: fnorm logical :: linear linear = .false. if (norder.ge.0) linear = .true. gamp1 = gamma + 1. gamm1 = gamma - 1. gam1 = 1./gamm1 constK = 0.25 ierr = 0 if (linear) then !--------------------------------------------------------------------------- ! linear solution uses Gegenbauer & Legendre Polynomials ! (this is for the toy star oscillations) omega = sqrt(0.5*(norder+1.)*(norder+2.)) fnorm = 2.*(norder+1)*(norder+2)/real(2.*norder + 3.) print*,' Plotting toy star oscills: time, norder, omega = ', & time,norder,omega,H0,C0,A0 if (C0.le.0.) then print*,'*** C = 0 = illegal in input' ierr = 1 return else radstar = sqrt(H0/C0) endif xplot(1) = -radstar dx = (radstar-xplot(1))/float(npts-1) do i=2,npts xplot(i) = xplot(1)+dx*(i-1) ! print*,i,' x,y = ',xplot(i),yplot(i) rhoplot = (H0 - C0*xplot(i)**2) if (rhoplot.le.0.) rhoplot = 0. deltarho = Pm(xplot(i),norder+1)*sin(omega*time) rhoplot = rhoplot**gam1 + 2.*omega*A0*deltarho/fnorm select case(iplot) case(1) ! plot solution for density yplot(i) = rhoplot case(2) ! plot solution for pressure yplot(i) = constK*rhoplot**gamma case(3) ! plot solution for utherm yplot(i) = constK*(rhoplot**gamm1)/gamm1 case(4) ! plot solution for vx yplot(i) = A0*Gn(xplot(i),norder)*cos(omega*time) case(5) ! plot solution for By yplot(i) = sigma*rhoplot end select enddo if (iplot.eq.6) then ! plot By \propto rho dx = (H0**gam1)/float(npts-1) ! ie (rhomax - 0)/npts xplot(1) = 0. yplot(1) = sigma*xplot(1) do i=2,npts xplot(i) = xplot(1) + dx*(i-1) yplot(i) = sigma*(xplot(i)) enddo endif if (iplot.eq.7) then ! plot current point on A-C plane call plot_pt1(C0,A0*cos(omega*time),4) ierr = 2 ! do not plot again else ! plot normal exact solution line ierr = 0 endif !--------------------------------------------------------------------------- ! non-linear solution for the fundamental (n=1) mode ! else ! ! solve for H, C and A given initial conditions on v, rho and the time. ! nsteps = 1000*(int(time) + 1) Hprev = H0 Cprev = C0 Aprev = A0 ! PRINT*,' nsteps,H,C,A in = ',nsteps,H0,C0,A0 dt = time/nsteps fact = 2.*(constK + 0.5*sigma**2)*gamma*gam1 const = (A0**2 + 1. + 2.*fact*C0*gam1)*C0**(-2./gamp1) print*,' Plotting toy star: time, H0, C0, A0, k = ', & time,Hprev,Cprev,Aprev,const tnow = 0. do i = 1,nsteps tnow = tnow + dt ! integrate using improved Euler fprevC = -Cprev*Aprev*gamp1 fprevA = fact*Cprev -1.-Aprev**2 fprevH = -Aprev*Hprev*gamm1 ! predictor Ctemp = Cprev + dt*(-Cprev*Aprev*gamp1) Atemp = Aprev + dt*(fact*Cprev-1.-Aprev**2) Htemp = Hprev + dt*(-Aprev*Hprev*gamm1) ftempC = -Ctemp*Atemp*gamp1 ftempA = fact*Ctemp -1. -Aprev**2 ftempH = -Atemp*Htemp*gamm1 ! corrector C = Cprev + 0.5*dt*(fprevC + ftempC) A = Aprev + 0.5*dt*(fprevA + ftempA) H = Hprev + 0.5*dt*(fprevH + ftempH) Cprev = C Aprev = A Hprev = H ! print*,' time = ',tnow ! IF ((abs(C-C0).LT.5.e-3).AND. & ! (abs(A-A0).LT.5.e-3).AND.(tnow.GT.5e-3)) THEN ! PRINT*,'*** period, t = ',tnow,' err = ',abs(C-C0)+abs(A-A0) ! ENDIF enddo const = (A**2 + 1. + 2.*fact*C*gam1)*C**(-2./gamp1) print*,' C, A, H, k = ',C,A,H,const if (C.le.0.) then radstar = 0.5 print*,'*** C = 0 = illegal' ierr = 1 return else radstar = sqrt(H/C) endif xplot(1) = -radstar dx = (radstar-xplot(1))/float(npts-1) do i=2,npts xplot(i) = xplot(1)+dx*(i-1) ! print*,i,' x,y = ',xplot(i),yplot(i) rhoplot = (H - C*xplot(i)**2) if (rhoplot.le.0.) rhoplot = 0. rhoplot = rhoplot**gam1 select case(iplot) case(1) ! plot solution for density yplot(i) = rhoplot case(2) ! plot solution for pressure yplot(i) = constK*rhoplot**gamma case(3) ! plot solution for utherm yplot(i) = constK*(rhoplot**gamm1)/gamm1 case(4) ! plot solution for vx yplot(i) = A*xplot(i) case(5) ! plot solution for By yplot(i) = sigma*rhoplot end select enddo if (iplot.eq.6) then ! plot By \propto rho dx = (H**gam1)/float(npts-1) ! ie (rhomax - 0)/npts xplot(1) = 0. yplot(1) = sigma*xplot(1) do i=2,npts xplot(i) = xplot(1) + dx*(i-1) yplot(i) = sigma*(xplot(i)) enddo endif if (iplot.eq.7) then ! plot current point on A-C plane call plot_pt1(C,A,4) ierr = 2 ! do not plot again else ! plot normal exact solution line ierr = 0 endif ! !------------------------------------------------------------------------ ! endif return end subroutine exact_toystar1D ! !--function to evaluate the Gegenbauer polynomial of index n given x ! real function Gn(x,n) implicit none integer, intent(in) :: n real, intent(in) :: x integer :: i real :: Gnminus1,Gnminus2 real :: fnorm fnorm = 2.*(n+1)*(n+2)/real(2.*n + 3.) ! PRINT*,' fnorm = ',fnorm ! !--specify first two Gegenbauer polynomials ! Gnminus2 = 1. Gnminus1 = 3.*x Gn = 0. ! avoid compiler warning ! !--use recurrence relation to calculate the rest ! select case (n) case (0) Gn = Gnminus2 case (1) Gn = Gnminus1 case (2:) do i=2,n Gn = ((2*i+1)*x*Gnminus1 - (i+1)*Gnminus2)/real(i) Gnminus2 = Gnminus1 Gnminus1 = Gn enddo end select Gn = Gn/fnorm end function Gn ! !--function to calculate a Legendre Polynomial of order m ! real function Pm(x,m) implicit none integer, intent(in) :: m real, intent(in) :: x integer :: i real :: Pmminus1,Pmminus2 ! !--specify first two Legendre polynomials ! Pmminus2 = 1. Pmminus1 = x Pm = 0. ! avoid compiler warning select case(m) case (0) Pm = 1. case (1) Pm = x case (2:) ! use recurrence relation to calculate the rest do i=2,m Pm = ((2.*(i-1.)+1.)*x*Pmminus1 - (i-1.)*Pmminus2)/real(i) Pmminus2 = Pmminus1 Pmminus1 = Pm enddo end select end function Pm !---------------------------------------------------------------------- ! ! this subroutine plots the A-C relation in the 1D Toy star solution ! !---------------------------------------------------------------------- subroutine exact_toystar_ACplane(astart,cstart,sigma,gamma) use plotlib, only:plot_swin,plot_funx,plot_label,plot_box implicit none real, intent(in) :: astart,cstart,sigma,gamma real :: constk,gam1,gamm1,gamp1,fact real :: xstart,xend,xcentre,c,cnew,k real :: func,func2,funct,fderiv,ymin,ymax,extra external func,func2 common /kconst/ k,fact,gam1,gamp1 print*,' plotting a-c plane...' gamp1 = gamma + 1. gamm1 = gamma - 1. gam1 = 1./gamm1 constk = 0.25 ! print*,' k, kdash = ',constk,constk + 0.5*sigma**2 fact = 2.*(constk + 0.5*sigma**2)*gamma*gam1 k = (astart**2 + 1. + 2.*fact*cstart*gam1)*cstart**(-2./gamp1) ! print*,' k,fact = ',k,fact ! !--find limits of plot (ie. where a = 0) ! c = 1.e6 cnew = 0.25 do while (abs(c-cnew).gt.1.e-5) c = cnew funct = k*c**(2./gamp1) - 2.*fact*c*gam1 - 1. fderiv = 2.*k/gamp1*c**(-gamm1/gamp1) - 2.*fact*gam1 cnew = c - funct/fderiv if (cnew.lt.0.) print*,'eek c < 0' enddo xstart = cnew c = 1.e6 cnew = 6.37935 do while (abs(c-cnew).gt.1.e-5) c = cnew funct = k*c**(2./gamp1) - 2.*fact*c*gam1 - 1. fderiv = 2.*k/gamp1*c**(-gamm1/gamp1) - 2.*fact*gam1 cnew = c - funct/fderiv enddo xend = cnew ! print*,'plotting k = ',k,' cstart = ',cstart,' astart = ',astart ! print*,'min c = ',xstart,' max c = ',xend xstart = xstart + 0.000001 xend = xend - 0.000001 extra = 0.1*(xend-xstart) xcentre = 0.5*(xstart + xend) ymax = 1.5*func(xcentre) ymin = 1.5*func2(xcentre) call plot_swin(xstart-extra,xend+extra,ymin,ymax) call plot_box('bcnst',0.0,0,'1bvcnst',0.0,0) call plot_funx(func,10000,xstart,xend,1) call plot_funx(func2,10000,xstart,xend,1) call plot_label ('c','a',' ') return end subroutine exact_toystar_ACplane end module toystar1D !------------------------------------ ! ! these functions must be external ! !------------------------------------ real function func(x) real, intent(in) :: x real :: k,term,fact,gam1,gamp1 common /kconst/ k,fact,gam1,gamp1 ! print*,'k = ',k term = -1 -2.*fact*x*gam1 + k*x**(2./gamp1) if (term.le.0.) then ! print*,' warning: func < 0 ',term func = 0. else func = sqrt(term) endif end function func real function func2(x) implicit none real, intent(in) :: x real :: k,term,fact,gam1,gamp1 common /kconst/ k,fact,gam1,gamp1 ! print*,' k = ',k term = -1 -2.*fact*x*gam1 + k*x**(2./gamp1) if (term.le.0.) then func2 = 0. else func2 = -sqrt(term) endif end function func2 splash/src/exact_toystar2D.f90000644 000770 000000 00000034035 11622211702 017135 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------ ! Exact solutions for toystar in two dimensions ! ! For details see Monaghan and Price (2005), in prep. ! !------------------------------------------------------------ module toystar2D implicit none public :: exact_toystar2D public :: etar, detadr ! public because they are used in setup contains !------------------------------------------------------------ ! calculate exact solution for toystar in two dimensions ! ! non-linear solution solves ODEs, assumes linear velocity ! ! the solutions are all plots against radius ! ! iplot = 0 gives x vs y ! ! iplot = 1->5 gives rho, pr, u, vx, vy vs r !------------------------------------------------------------ subroutine exact_toystar2D(iplot,time,gamma,polyk,totmass, & ampl,denscentre,C0,jorder,morder, & V11,V22,V12,V21,xplot,yplot,ierr) implicit none integer, intent(in) :: iplot,jorder,morder integer, intent(out) :: ierr real, intent(in) :: time,gamma,polyk,totmass real, intent(in) :: C0, ampl, denscentre ! parameters for toy star real, intent(in) :: V11,V22,V12,V21 real, dimension(:), intent(inout) :: xplot real, dimension(:), intent(out) :: yplot real, parameter :: pi = 3.141592653589 integer :: i,npts,nsteps integer :: jmode,smode real :: H,C,D,B,omega,omegasq real :: radstar,dx,nu2 !!,scalefac real :: rhoplot,deltarho,vplot,deltav real :: gamm1,gam1,constK,sigma,period real, dimension(8) :: params, paramsp,dparams real :: fac,dt,t,phi,dphi,cosphi,sinphi,denom real :: massbefore,massafter logical linear ierr = 1 npts = size(xplot) linear = (jorder.ge.0 .and. morder.ge.0) gamm1 = gamma - 1. if (gamm1.lt.1.e-3) then print*,'Error: no toy star solution for isothermal yet' ierr = 1 return endif gam1 = 1./gamm1 if (polyK.le.0.) then print*,'Error: polytropic K <= 0 on input: using 0.25 by default' constK = 0.25 else constK = polyK !!0.25 ! this is K from P = K*rho**gamma endif omega = 1.0 ! this is omega from the main code (ie. from potential) omegasq = omega**2 B = 0. D = 0. if (linear) then !--------------------------------------------------------------------------- ! linear solution print*,' Plotting 2D toy star: linear solution r mode = ',jorder,' phi mode = ',morder jmode = jorder ! radial mode smode = morder ! non-axisymmetric modes (theta) ! sigma is the frequency of oscillation nu2 = (jmode + smode)*(jmode+smode + 2./gamm1) - smode**2 if (nu2.le.0.) then print*,'Error: nu^2 < 0 in linear toy star ',nu2 print*,' radial mode = ',jmode,' theta mode = ',smode ierr = 2 return else sigma = sqrt(0.5*omegasq*gamm1*nu2) endif print*,' Amplitude = ',ampl,' period = ',2*pi/sigma,' H,C = ',denscentre,C0 !!scalefac = polyk*gamma/(sigma*gamm1) radstar = sqrt((2.*polyk*gamma*denscentre**gamm1)/gamm1) xplot(1) = 0. dx = (radstar-xplot(1))/float(npts-1) do i=1,npts xplot(i) = xplot(1)+dx*(i-1) ! print*,i,' x,y = ',xplot(i),yplot(i) rhoplot = (denscentre - C0*xplot(i)**2) if (rhoplot.le.0.) rhoplot = 0. deltarho = etar(jmode,smode,xplot(i)/radstar,gamma) ! functional form of rho(r) !!print*,'deltarho = ',rhoplot,deltarho,xplot(i) rhoplot = (rhoplot + deltarho*ampl*SIN(sigma*time))**gam1 deltav = ampl*detadr(jmode,smode,xplot(i)/radstar,gamma) vplot = deltav*COS(sigma*time) select case(iplot) case(1) ! plot solution for density yplot(i) = rhoplot case(2) ! plot solution for pressure yplot(i) = constK*rhoplot**gamma case(3) ! plot solution for utherm yplot(i) = constK*(rhoplot**gamm1)/gamm1 case(4) ! plot solution for v_r yplot(i) = vplot case(5) yplot(i) = vplot**2 end select enddo !--------------------------------------------------------------------------- ! non-linear solution ! else if (jorder.lt.0 .and. smode.lt.0) then smode = 2 jmode = 0 else smode = 0 jmode = 2 endif print*,'Plotting 2D toy star: non-linear' ! solve for H, C and A given initial conditions on v, rho and the time. ! H = denscentre ! !--this is the static solution, determined from the total mass, polyk, gamma and omega ! radstar = sqrt(gamma*totmass/(pi*gamm1)) H = omegasq*gamm1*radstar**2/(2.*polyk*gamma) C = 0.5*gamm1*omegasq/(gamma*polyk) print*,' r_star = ',radstar,' rho = (',H,'-',C,'^2)**',gamm1 D = C B = 0. ! !--now solve the ODEs for V11,V22,V12,V21,H,C,D & B ! (we use a simple modified euler method) ! params(1)= V11 params(2)= V22 params(3)= V12 params(4)= V21 params(5)= H params(6)= C params(7)= D params(8)= B fac= 2.*gamma*polyk*gam1 massbefore = pi*gamm1/gamma*H**(gamma*gam1)/(sqrt(C*D - B**2)) ! !--get frequency to determine timestep ! nu2 = (jmode + smode)*(jmode+smode + 2./gamm1) - smode**2 if (nu2.le.0.) then print*,'Error: nu^2 < 0 in exact toy star ',nu2 print*,' radial mode = ',jmode,' theta mode = ',smode ierr = 2 return else sigma = sqrt(0.5*omegasq*gamm1*nu2) endif ! !--solve ODE's ! period = 2.*pi/sigma dt = 0.001*period nsteps = int(time/dt) dt = time/real(nsteps) t = 0. do i=1,nsteps t = t + dt call param_derivs(params,dparams,fac,gamm1,omegasq) paramsp(:)= params(:) + 0.5*dt*dparams(:) call param_derivs(paramsp,dparams,fac,gamm1,omegasq) params(:)= params(:) + dt*dparams(:) enddo ! !--have now got solution at current time ! H= params(5) C= params(6) D= params(7) B= params(8) print*,' solved ODEs to time = ',t,' in ',nsteps,' nsteps ' massafter = pi*gamm1/gamma*H**(gamma*gam1)/(sqrt(C*D - B**2)) print*,' conserved mass before = ',massbefore,' after =',massafter if (C.le.0.) then radstar = 0.5 stop '*** C = 0 = illegal' !!elseif (A.le.1.e-5) then else radstar = sqrt(H/C) endif xplot(1) = 0. dx = (radstar-xplot(1))/float(npts-1) do i=1,npts xplot(i) = xplot(1)+dx*(i-1) ! print*,i,' x,y = ',xplot(i),yplot(i) rhoplot = (H - C*xplot(i)**2) if (rhoplot.le.0.) rhoplot = 0. rhoplot = rhoplot**gam1 select case(iplot) case(1) ! plot solution for density yplot(i) = rhoplot case(2) ! plot solution for pressure yplot(i) = constK*rhoplot**gamma case(3) ! plot solution for utherm yplot(i) = constK*(rhoplot**gamm1)/gamm1 case(4) ! plot solution for v_r yplot(i) = ampl*xplot(i) case(5) yplot(i) = (ampl*xplot(i))**2 end select enddo ! !------------------------------------------------------------------------ ! endif if (iplot.gt.0 .and. iplot.le.5) then ierr = 0 elseif (iplot.eq.0) then print*,' plotting non-axisymmetric boundary' ! !--for x-y plots we plot the rho=0 curve (ie. toy star boundary) ! dphi = 2.*pi/real(npts-1) phi = 0. do i=1,npts phi = (i-1)*dphi cosphi = cos(phi) sinphi = sin(phi) denom = C*cosphi**2 + 2.*B*cosphi*sinphi + D*sinphi**2 radstar = SQRT(H/denom) xplot(i) = radstar*cosphi yplot(i) = radstar*sinphi enddo ierr = 0 ! call pgsfs(2) ! call pgcirc(0.0,0.0,radstar) ! ierr = 3 endif return end subroutine exact_toystar2D ! !--function that evaluates the polynomial for rho(r/re) for a given radial mode ! (from the power series solution to the 2nd order ODE) ! ! rad = r/r_star ! j = radial (axisymmetric) mode ! m = theta mode ! ! solution is for delta(rho**(gamma-1)) ! ie. rho**(gamma-1) = rho_0**(gamma-1) + etar ! ! and takes the form ! ! etar = rad**m sum_k a_k rad**k ! real function etar(j,m,rad,gamma) implicit none integer, intent(in) :: j,m ! j is the radial mode, m is the theta mode integer :: k,kprev real, intent(in) :: rad,gamma real :: denom,ak,akprev,gamm1,freqsq ! !--this solution is for arbitrary gamma ! gamm1 = gamma - 1. if (gamm1.lt.1.e-3) then print*,'error gamma -1 <= 0' etar = 0. return endif ! !--the solution is of the form ! drhor = a_0 + a_2 (r/re)**2 + a_4 (r/re)**4 + ... ! where for j = k, coefficients >= a_k+2 are zero ! freqsq = (j+m)*(j+m + 2./gamm1) - m**2 akprev = 1.0 ! this is a_0 which is the amplitude etar = akprev !!print*,'mode = ',j,m,' nu^2 = ',freqsq,' a_0 = ',akprev ! !--the co-efficients for the terms above a_0 are calculated using ! the recurrence relation between the a_k's ! do k = 2,j,2 kprev = k-2 denom = real((kprev + 2 + m)**2 - m**2) ak = akprev*(kprev**2 + 2.*kprev*m + 2.*(kprev+m)/gamm1 - freqsq)/denom !!print*,'coeff ',k,' = ',ak,k**2,2.*k/gamm1 etar = etar + ak*rad**k akprev = ak enddo etar = etar * rad**m end function etar ! !--function that evaluates the polynomial for v(r/re) for a given radial mode ! (from the power series solution to the 2nd order ODE) ! real function detadr(j,m,rad,gamma) implicit none integer, intent(in) :: j, m ! j is the radial mode, m is the theta mode integer :: k,kprev real, intent(in) :: rad,gamma real :: denom,term1,term2 real :: ak,akprev,gamm1,freqsq ! !--this solution is for arbitrary gamma ! gamm1 = gamma - 1. if (gamm1.lt.1.e-3) then print*,'error gamma -1 <= 0' detadr = 0. return endif ! !--the solution is of the form ! drhor = a_0 + a_2 (r/re)**2 + a_4 (r/re)**4 + ... ! where for j = k, coefficients >= a_k+2 are zero ! freqsq = (j+m)*(j+m + 2./gamm1) - m**2 detadr = 0. akprev = 1.0 ! this is a_0 which is the amplitude term1 = akprev term2 = 0. ! print*,'mode = ',j,m,' nu^2 = ',freqsq,' a_0 = ',akprev ! !--the co-efficients for the terms above a_0 are calculated using ! the recurrence relation between the a_k's ! do k = 2,j,2 kprev = k-2 denom = real((kprev + 2 + m)**2 - m**2) ak = akprev*(kprev**2 + 2.*kprev*m + 2.*(kprev+m)/gamm1 - freqsq)/denom !!print*,'coeff ',k,' = ',ak,k*ak,rad,(k-1) term1 = term1 + ak*rad**k term2 = term2 + k*ak*rad**(k-1) akprev = ak enddo if (m.eq.0) then detadr = term2 else detadr = m*rad**(m-1)*term1 + rad**m*term2 endif end function detadr subroutine param_derivs(func,dfunc,fac,gamm1,omegasq) implicit none real, intent(in), dimension(8) :: func real, intent(out), dimension(8) :: dfunc real, intent(in) :: fac, gamm1,omegasq real :: term, gamma term = func(1) + func(2) gamma = gamm1 + 1. dfunc(1)= fac*func(6) - func(1)*func(1) - func(3)*func(4) - omegasq dfunc(2)= fac*func(7) - func(2)*func(2) - func(3)*func(4) - omegasq dfunc(3)= fac*func(8) - func(3)*term dfunc(4)= fac*func(8) - func(4)*term dfunc(5)= -gamm1*term*func(5) dfunc(6)= -2.*func(6)*func(1) - gamm1*func(6)*term - 2.*func(8)*func(4) dfunc(7)= -2.*func(7)*func(2) - gamm1*func(7)*term - 2.*func(8)*func(3) dfunc(8)= -func(6)*func(3) - func(7)*func(4) - gamma*func(8)*term return end subroutine param_derivs !---------------------------------------------------------------------- ! ! this subroutine plots the alpha-beta relation in the 2D Toy star solution ! !---------------------------------------------------------------------- subroutine exact_toystar_ACplane2D(astart,bstart,sigmain,gamma) use plotlib, only:plot_swin,plot_box,plot_label,plot_line implicit none real, intent(in) :: astart,bstart,sigmain,gamma integer, parameter :: npts = 2000 integer :: i real :: gamm1,gam1,sigma real :: polyk,Omega2,constk real :: xstart,xend,ymin,ymax,xi,term,extra real, dimension(npts) :: xplot, yplot print*,' plotting alpha-beta plane...' gamm1 = gamma - 1. gam1 = 1./gamm1 polyk = 0.25 Omega2 = 1.0 sigma = 1.0 print*,' alpha = ',astart,' beta = ',bstart, 'sigma = ',sigma,sigmain ! !--find integration constant from starting values of alpha and beta ! constk = (astart**2 + bstart**2 + Omega2 & + 2.*polyk*gamma*(sigma*bstart**gamma)*gam1**2)/bstart print*,' integration constant = ',constk ! !--find limits of plot (ie. where alpha = 0) ! xstart = 0.25 xend = 2.0 ! print*,'plotting k = ',k,' cstart = ',cstart,' astart = ',astart ! print*,'min c = ',xstart,' max c = ',xend xstart = xstart + 0.000001 xend = xend - 0.000001 extra = 0.1*(xend-xstart) !!xcentre = 0.5*(xstart + xend) ymax = 2.0 ymin = -2.0 call plot_swin(xstart-extra,xend+extra,ymin,ymax) call plot_box('bcnst',0.0,0,'1bvcnst',0.0,0) call plot_label ('beta','alpha',' ') do i=1,npts xi = xstart + (i-1)*npts xplot(i) = xi term = -(xi**2 + Omega2 + 2.*polyk*gamma*(sigma*xi**gamma)*gam1**2 + constk*xi) if (term.le.0) then yplot(i) = 0. else yplot(i) = sqrt(term) endif enddo call plot_line(npts,xplot,yplot) return end subroutine exact_toystar_ACplane2D end module toystar2D splash/src/exact_wave.f90000644 000770 000000 00000004225 11622211702 016202 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- ! ---------------------------------------------------------------------- ! compute exact solution for a linear wave ! plots a sine function with a given amplitude, period and wavelength ! ---------------------------------------------------------------------- module wave implicit none contains subroutine exact_wave(time,ampl,period,lambda,x0,ymean,xplot,yplot,ierr) implicit none integer :: i real, parameter :: pi = 3.1415926536 real, intent(in) :: time, ampl, period, lambda, x0, ymean real, intent(in), dimension(:) :: xplot real, intent(out), dimension(size(xplot)) :: yplot integer, intent(out) :: ierr real :: omega print*,'plotting sine wave... mean = ',ymean print*,' lambda = ',lambda,' ampl = ',ampl,' period = ',period ! ! check for errors ! ierr = 0 if (lambda.le.0.) then print*,'error: lambda <= 0' ierr = 1 return endif if (abs(period).gt.tiny(period)) then omega = 2.*pi/period else print*,'warning: period <= 0' omega = 0. endif do i=1,size(xplot) if (abs(ymean).le.0.) then yplot(i) = ymean + ampl*sin(2.*pi/lambda*(xplot(i)-x0) - omega*time) else yplot(i) = ymean*(1. + ampl*sin(2.*pi/lambda*(xplot(i)-x0) - omega*time)) endif enddo return end subroutine exact_wave end module wave splash/src/fieldlines.f90000644 000770 000000 00000034534 12303206671 016206 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! module for field line / flux tube plotting in 2 and 3 dimensions ! module fieldlines implicit none public :: streamlines,vecplot3D_proj private :: trace2D,interpolate_pt private contains !--------------------------------------------------------------------------- ! ! This subroutine integrates a 2D vector field to give the stream function ! Plotting the contours of this function gives the field/stream lines ! ! The solution is given by ! ! A(x,y) = \int v_x(x,y) dy - \int v_y(x,y) dx ! ! which we compute, knowing v_x and v_y on a fixed grid of square pixels, ! by a simple trapezoidal integration for each component. ! ! For SPH, this means we first interpolate the vector field to ! get v_x and v_y on the two-dimensional grid. This then also works for ! cross sections / projections of 3D vector fields by first interpolating ! to the 2D grid. ! ! ! Inputs: vecpixx(npixx,npixy) : x component of vector field on fixed grid ! vecpixy(npixx,npixy) : y component of vector field on fixed grid ! xmin, ymin : xmin and ymin of grid ! pixwidth : grid cell size (pixels are square) ! npixx,npixy : number of grid cells (pixels) in x,y ! ! Output: datpix(npixx,npixy) : stream function on fixed grid ! ! written by Daniel Price dprice@astro.ex.ac.uk ! ! Oct 2007: uses Simpson's rule instead of trapezoidal ! !--------------------------------------------------------------------------- subroutine streamlines(vecpixx,vecpixy,datpix,npixx,npixy,pixwidth) implicit none integer, intent(in) :: npixx,npixy real, intent(in), dimension(npixx,npixy) :: vecpixx,vecpixy real, intent(in) :: pixwidth real, intent(out), dimension(npixx,npixy) :: datpix real, dimension(npixx,npixy) :: datpix2 double precision :: fyj,fyjhalf,term,termi,termj,fxprevi,fyjprev double precision, dimension(npixx) :: fx,fxhalf integer :: i,j ! !--check for errors in input ! if (pixwidth.le.0.) then print "(1x,a)",'streamlines: error: pixel width <= 0' datpix = 0. return endif fyj = 0. fyjhalf = 0. ! !--perform the integration forwards ! do j=1,npixy do i=1,npixx term = 0. if (i.eq.1) then fyj = 0. fyjhalf = 0. else fyjprev = fyj !--trapezoidal rule in x termj = 0.5*pixwidth*(vecpixy(i-1,j)+vecpixy(i,j)) fyj = fyj - termj if (mod(i-1,2).eq.0) then ! 3, 5, 7, 9 ... ! !--for odd points, use trapezoidal solution at half grid points ! to get Simpson's rule ! fyjhalf = fyjhalf - pixwidth*(vecpixy(i-2,j)+vecpixy(i,j)) term = term + 4./3.*fyj - 1./3.*fyjhalf else ! !--for even points, use Simpson's rule up to last odd point ! then finish with a trapezoidal integration over last two points ! term = term + 4./3.*fyjprev - 1./3.*fyjhalf - termj endif endif ! !--same as above but for integration in y ! if (j.eq.1) then fx(i) = 0. fxhalf(i) = 0. fxprevi = 0. else fxprevi = fx(i) termi = 0.5*pixwidth*(vecpixx(i,j-1)+vecpixx(i,j)) fx(i) = fx(i) + termi if (mod(j-1,2).eq.0) then fxhalf(i) = fxhalf(i) + pixwidth*(vecpixx(i,j-2)+vecpixx(i,j)) term = term + 4./3.*fx(i) - 1./3.*fxhalf(i) else term = term + 4./3.*fxprevi - 1./3.*fxhalf(i) + termi endif endif datpix(i,j) = real(term) enddo enddo ! !--perform the integration backwards ! datpix2 = 0. do j=npixy,1,-1 do i=npixx,1,-1 term = 0. if (i.eq.npixx) then fyj = 0. fyjhalf = 0. else fyjprev = fyj !--trapezoidal rule in x termj = 0.5*pixwidth*(vecpixy(i+1,j)+vecpixy(i,j)) fyj = fyj + termj if (mod(npixx-i,2).eq.0) then ! 3, 5, 7, 9 ... ! !--for odd points, use trapezoidal solution at half grid points ! to get Simpson's rule ! fyjhalf = fyjhalf + pixwidth*(vecpixy(i+2,j)+vecpixy(i,j)) term = term + 4./3.*fyj - 1./3.*fyjhalf else ! !--for even points, use Simpson's rule up to last odd point ! then finish with a trapezoidal integration over last two points ! term = term + 4./3.*fyjprev - 1./3.*fyjhalf + termj endif endif ! !--same as above but for integration in y ! if (j.eq.npixy) then fx(i) = 0. fxhalf(i) = 0. fxprevi = 0. else fxprevi = fx(i) termi = 0.5*pixwidth*(vecpixx(i,j+1)+vecpixx(i,j)) fx(i) = fx(i) - termi if (mod(npixy-j,2).eq.0) then fxhalf(i) = fxhalf(i) - pixwidth*(vecpixx(i,j+2)+vecpixx(i,j)) term = term + 4./3.*fx(i) - 1./3.*fxhalf(i) else term = term + 4./3.*fxprevi - 1./3.*fxhalf(i) - termi endif endif datpix2(i,j) = real(term) enddo enddo ! !--average the two ! datpix = 0.5*(datpix + datpix2) return end subroutine streamlines !--------------------------------------------------------------------------------- ! ! THE REST OF THIS MODULE IS EITHER OLD, *VERY* EXPERIMENTAL AND/OR UNDOCUMENTED ! !--------------------------------------------------------------------------------- ! ! we want to trace the curve through a 2D vector field ! subroutine fieldlines2D(npart,x,y,vecx,vecy,h,pmass,rho,xmin,xmax,ymin,ymax) implicit none integer, intent(in) :: npart real, intent(in), dimension(npart) :: x,y,vecx,vecy,h,pmass,rho real, intent(in) :: xmin,xmax,ymin,ymax integer :: i,nlines real :: dx,dy,xstart,ystart,ymaxline nlines = 10 dx = (xmax-xmin)/nlines dy = (ymax-ymin)/nlines ystart = ymin ymaxline = ymin do while (ymaxline.lt.ymax) do i=1,nlines xstart = xmin + (i-1)*dx + 0.5*dx print*,' tracing field line ',i,' x, y = ',xstart,ystart call trace2D(xstart,ystart,xmin,xmax,ymin,ymax,ymaxline, & x,y,vecx,vecy,h,pmass,rho,npart) enddo ystart = ymaxline + 0.5*dy enddo end subroutine fieldlines2D subroutine trace2D(xstart,ystart,xmin,xmax,ymin,ymax,ymaxline, & x,y,vecx,vecy,h,pmass,rho,npart) use plotlib, only:plot_line implicit none integer, intent(in) :: npart real, intent(in) :: xstart,ystart,xmin,xmax,ymin,ymax real, intent(inout) :: ymaxline real, dimension(npart), intent(in) :: x,y,vecx,vecy,h,pmass,rho integer :: ipt,npix real, dimension(2) :: xline, yline real :: runit,runit1,dx,dy,vx,vy,pixwidth,sign xline(1) = xstart yline(1) = ystart npix = 100 pixwidth = (xmax - xmin)/npix ipt = 0 sign = 1.0 do while ((xline(1).ge.xmin .and. xline(1).le.xmax) .and. & (yline(1).ge.ymin .and. yline(1).le.ymax) .and. ipt.lt.10*npix) ipt = ipt + 1 ! !--get dx and dy from interpolation of vector field from particles ! call interpolate_pt(xline(1),yline(1),vx,vy, & x,y,vecx,vecy,h,pmass,rho,npart) ! !--get unit vector in direction of vector ! runit = sqrt(vx**2 + vy**2) if (runit.gt.0) then runit1 = 1./runit dx = vx*runit1*pixwidth dy = vy*runit1*pixwidth else dx = 0. dy = 0. endif if (ipt.eq.1 .and. dy.lt.0.) sign = -1.0 xline(2) = xline(1) + sign*dx yline(2) = yline(1) + sign*dy !!print*,'x, y = ',xline(2),yline(2) ymaxline = max(ymaxline,yline(2)) ! !--plot line segment ! call plot_line(2,xline,yline) xline(1) = xline(2) yline(1) = yline(2) enddo if (ipt.ge.10*npix) print*,'WARNING: infinite field line' end subroutine trace2D ! !--interpolate from particles to single point ! would be nice to know neighbours ! subroutine interpolate_pt(xpt,ypt,vxpt,vypt,x,y,vecx,vecy,h,pmass,rho,npart) use kernels, only:radkernel2,wfunc,cnormk2D implicit none integer, intent(in) :: npart real, dimension(npart), intent(in) :: x,y,vecx,vecy,h,pmass,rho real, intent(in) :: xpt, ypt real, intent(out) :: vxpt, vypt real :: rho1i,term,const,dx,dy,hi1,q2,wab integer :: i vxpt = 0. vypt = 0. const = cnormk2D do i=1,npart dx = xpt - x(i) dy = ypt - y(i) hi1 = 1./h(i) q2 = (dx*dx + dy*dy)*hi1*hi1 ! !--if particles are within range, calculate contribution to this pt ! if (q2.lt.radkernel2) then if (rho(i) > 0.) then rho1i = 1./rho(i) else rho1i = 0. endif term = const*pmass(i)*rho1i wab = wfunc(q2) vxpt = vxpt + term*vecx(i)*wab vypt = vypt + term*vecy(i)*wab endif enddo end subroutine interpolate_pt !-------------------------------------------------------------------------- ! Visualisation of a 3D vector field in projection ! by means of "iron filings" drawn on particles ! ! We draw a line on each particle in the direction of the vector field ! This line is illuminated by reflections from a lighting source, and ! is drawn with an opacity proportional to the field strength, such that ! strong field regions are highlighted. ! ! For details of the lighting algorithm, see e.g. ! Stalling, Zoeckler and Hege, 1997, IEEE Trans. Viz. Comp. Graphics, 3, 118-128 ! ! Added by D. Price, Dec 2011 !-------------------------------------------------------------------------- subroutine vecplot3D_proj(x,y,z,vx,vy,vz,vecmax,weight,itype,n,dx,zobs,dscreen) use plotlib, only:plot_line,plot_bbuf,plot_ebuf,plot_slw,plot_sci,plot_set_opacity use plotlib, only:plot_qcr,plot_scr,plot_qlw use sort, only:indexx implicit none integer, intent(in) :: n real, dimension(n), intent(in) :: x,y,z,vx,vy,vz,weight integer, dimension(n), intent(in) :: itype real, intent(inout) :: vecmax real, intent(in) :: dx,zobs,dscreen integer, dimension(n) :: iorder integer :: i,ipart,np real, dimension(2) :: xpts,ypts real :: vxi,vyi,vzi,dvmag,zfrac,vmax,vmag,frac,ri,gi,bi,term,lw real :: toti,fambient,diffuse,specular,fdiff,fspec,ldotn,vdotr,ldott,vdott integer :: pdiff,nspec,lwold real, dimension(3) :: vunit,lighting,viewangle logical :: white_bg,use3Dperspective ! !--get the max adaptively if it is not already set ! if (vecmax.le.0. .or. vecmax.gt.0.5*huge(vecmax)) then vmax = 0. do i=1,n if (itype(i).ge.0 .and. weight(i).gt.0.) then vmax = max(vx(i)**2 + vy(i)**2 + vz(i)**2,vmax) endif enddo vmax = sqrt(vmax) vecmax = vmax else vmax = vecmax endif use3Dperspective = abs(dscreen).gt.tiny(dscreen) ! !--work out whether or not we have a white or black ! background colour ! call plot_qcr(0,ri,gi,bi) white_bg = (ri + gi + bi > 1.5) ! !--specify the parameters in the lighting algorithm ! these should differ depending on whether we are drawing ! on a white or black background ! if (white_bg) then fambient = 0. fdiff = 0.1 fspec = 0.5 else fambient = 0.3 fdiff = 0.7 fspec = 0.8 endif pdiff = 4 nspec = 12 ! !--specify the viewing and lighting angles ! viewangle = (/0.,0.,1./) lighting = (/0.,0.,1./) !--make sure these are normalised !lighting = lighting/sqrt(dot_product(lighting,lighting)) print*,'plotting 3D field structure: min,max = ',1.e-3*vmax,vmax ! !--first sort the particles in z so that we do the opacity in the correct order ! call indexx(n,z,iorder) call plot_bbuf call plot_qcr(1,ri,gi,bi) np = 0 zfrac = 1. call plot_qlw(lwold) lw = 2.*lwold over_particles: do ipart=1,n i = iorder(ipart) if (itype(i).ge.0 .and. weight(i).gt.0.) then if (use3Dperspective) then if (z(i).gt.zobs) cycle over_particles zfrac = abs(dscreen/(z(i)-zobs)) endif ! lw = min(zfrac,2.5) vxi = vx(i) vyi = vy(i) vzi = vz(i) ! !--we draw lines on each particle with an ! opacity proportional to the field strength ! vmag = sqrt(vxi**2 + vyi**2 + vzi**2) dvmag = 1./vmag vunit = abs((/vxi,vyi,vzi/)*dvmag) frac = min(vmag/vmax,1.0) if (frac.ge.1.e-3) then !--specify the length of line to draw term = 1.5*dx*dvmag*zfrac xpts(1) = x(i) - vxi*term xpts(2) = x(i) + vxi*term ypts(1) = y(i) - vyi*term ypts(2) = y(i) + vyi*term !--draw "halo" in background colour with ! twice the thickness, same opacity call plot_slw(2.*lw) call plot_sci(0) call plot_set_opacity(frac) call plot_line(2,xpts,ypts) !--Phong lighting ldott = dot_product(lighting,vunit) ldotn = sqrt(1. - ldott**2) diffuse = fdiff*(ldotn)**pdiff vdott = dot_product(viewangle,vunit) vdotr = ldotn*sqrt(1. - vdott**2) - ldott*vdott specular = fspec*(vdotr)**nspec toti = (fambient + diffuse + specular) !--draw line with intensity proportional ! to the amount of lighting call plot_scr(1,toti,toti,toti,max(frac,0.05)) call plot_sci(1) call plot_slw(lw) call plot_line(2,xpts,ypts) np = np + 1 endif endif enddo over_particles !--reset opacity for both foreground and background colour indices call plot_sci(0) call plot_set_opacity(1.0) call plot_sci(1) call plot_scr(1,ri,gi,bi) call plot_set_opacity(1.0) call plot_ebuf call plot_slw(lwold) print*,' plotted ',np,' of ',n,' particles' end subroutine vecplot3D_proj end module fieldlines splash/src/fparser.f90000644 000770 000000 00000136063 12032557771 015543 0ustar00dpricewheel000000 000000 ! ! Copyright (c) 2000-2008, Roland Schmehl. All rights reserved. ! ! This software is distributable under the BSD license. See the terms of the ! BSD license in the documentation provided with this software. ! MODULE fparser !------- -------- --------- --------- --------- --------- --------- --------- ------- ! Fortran 90 function parser v1.1 !------- -------- --------- --------- --------- --------- --------- --------- ------- ! ! This function parser module is intended for applications where a set of mathematical ! fortran-style expressions is specified at runtime and is then evaluated for a large ! number of variable values. This is done by compiling the set of function strings ! into byte code, which is interpreted efficiently for the various variable values. ! ! The source code is available from http://fparser.sourceforge.net ! ! Please send comments, corrections or questions to the author: ! Roland Schmehl ! !------- -------- --------- --------- --------- --------- --------- --------- ------- ! The function parser concept is based on a C++ class library written by Juha ! Nieminen available from http://warp.povusers.org/FunctionParser/ !------- -------- --------- --------- --------- --------- --------- --------- ------- ! ! Modifications by D, Price for integration in SPLASH: ! 7th Aug 2009: added checkf interface routine to check syntax without compiling code ! added endf routine to stop memory leaks, also called from initf if needed ! bug fix with error message for sqrt(-ve) ! ! 9th Aug 2009: added Mathematical constant recognition (pi) ! ! 27th Jan 2010: check for -ve numbers to fractional powers and zero to negative power added IMPLICIT NONE !--modification here by D.Price: define type parameters here rather than in a separate module integer, parameter, public :: rn = KIND(0.0d0) ! Precision of real numbers integer, parameter, private :: is = SELECTED_INT_KIND(1) ! Data type of bytecode !--end modification !------- -------- --------- --------- --------- --------- --------- --------- ------- PUBLIC :: initf, & ! Initialize function parser for n functions parsef, & ! Parse single function string evalf, & ! Evaluate single function checkf, & ! Check syntax in a function string endf, & ! Clean up memory once finished EvalErrMsg ! Error message (Use only when EvalErrType>0) INTEGER, PUBLIC :: EvalErrType ! =0: no error occured, >0: evaluation error !--modification by D. Price: add parseErr parameter (used in checkf) INTEGER, PRIVATE :: ParseErrType ! =0: no error occured, >0: parse error !--modification by D. Price: add verboseness internal variable (used in checkf) LOGICAL, PRIVATE :: PrintErrors = .true. ! =0: no error occured, >0: parse error !------- -------- --------- --------- --------- --------- --------- --------- ------- PRIVATE SAVE INTEGER(is), PARAMETER :: cImmed = 1, & cNeg = 2, & cAdd = 3, & cSub = 4, & cMul = 5, & cDiv = 6, & cPow = 7, & cAbs = 8, & cExp = 9, & cLog10 = 10, & cLog = 11, & cSqrt = 12, & cSinh = 13, & cCosh = 14, & cTanh = 15, & cSin = 16, & cCos = 17, & cTan = 18, & cAsin = 19, & cAcos = 20, & cAtan = 21, & VarBegin = 22 CHARACTER (LEN=1), DIMENSION(cAdd:cPow), PARAMETER :: Ops = (/ '+', & '-', & '*', & '/', & '^' /) CHARACTER (LEN=5), DIMENSION(cAbs:cAtan), PARAMETER :: Funcs = (/ 'abs ', & 'exp ', & 'log10', & 'log ', & 'sqrt ', & 'sinh ', & 'cosh ', & 'tanh ', & 'sin ', & 'cos ', & 'tan ', & 'asin ', & 'acos ', & 'atan ' /) TYPE tComp INTEGER(is), DIMENSION(:), POINTER :: ByteCode INTEGER :: ByteCodeSize REAL(rn), DIMENSION(:), POINTER :: Immed INTEGER :: ImmedSize REAL(rn), DIMENSION(:), POINTER :: Stack INTEGER :: StackSize, & StackPtr END TYPE tComp TYPE (tComp), DIMENSION(:), POINTER :: Comp ! Bytecode INTEGER, DIMENSION(:), ALLOCATABLE :: ipos ! Associates function strings ! CONTAINS ! SUBROUTINE initf (n) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Initialize function parser for n functions !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: n ! Number of functions INTEGER :: i !----- -------- --------- --------- --------- --------- --------- --------- ------- IF (ASSOCIATED(Comp)) THEN print "(a)",' fparser warning: initf called repeatedly without prior call to endf' CALL endf ENDIF ALLOCATE (Comp(n)) DO i=1,n NULLIFY (Comp(i)%ByteCode,Comp(i)%Immed,Comp(i)%Stack) END DO END SUBROUTINE initf ! SUBROUTINE endf() !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Clean up memory at the end of the function parsing/evaluation calls (D. Price) !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER :: i !----- -------- --------- --------- --------- --------- --------- --------- ------- IF (ASSOCIATED(Comp)) THEN DO i=1,size(Comp) IF (ASSOCIATED(Comp(i)%ByteCode)) DEALLOCATE ( Comp(i)%ByteCode, & Comp(i)%Immed, & Comp(i)%Stack ) ENDDO DEALLOCATE(Comp) ENDIF END SUBROUTINE endf ! SUBROUTINE parsef (i, FuncStr, Var, err, Verbose) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Parse ith function string FuncStr and compile it into bytecode !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: i ! Function identifier CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Function string CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with variable names CHARACTER (LEN=LEN(FuncStr)) :: Func ! Function string, local use INTEGER, INTENT(OUT), OPTIONAL :: err LOGICAL, INTENT(IN), OPTIONAL :: Verbose ! Turn error messages on/off !----- -------- --------- --------- --------- --------- --------- --------- ------- IF (i < 1 .OR. i > SIZE(Comp)) THEN WRITE(*,*) '*** Parser error: Function number ',i,' out of range' IF (present(err)) err = 1 RETURN END IF EvalErrType = 0 ! D. Price : to prevent accidental misuse ParseErrType = 0 PrintErrors = .true. IF (present(Verbose)) PrintErrors = Verbose ALLOCATE (ipos(LEN(Func))) ! Char. positions in orig. string Func = FuncStr ! Local copy of function string CALL Replace ('**','^ ',Func) ! Exponent into 1-Char. format CALL RemoveSpaces (Func) ! Condense function string !CALL GetConstants (Func) CALL CheckSyntax (Func,FuncStr,Var) DEALLOCATE (ipos) IF (present(err)) err = ParseErrType PrintErrors = .true. ! reset this to true !--D. Price: return after ParseErr here instead of stop inside CheckSyntax IF (ParseErrType /= 0) RETURN CALL Compile (i,Func,Var) ! Compile into bytecode END SUBROUTINE parsef ! INTEGER FUNCTION checkf(FuncStr, Var, Verbose) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check syntax in a function string (added by D. Price) but do not compile it ! Returns an error code NOT related to ErrMsg ! Optional variable "verbose" determines whether or not error messages are printed !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(IN) :: FuncStr ! Function string CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: Var ! Array with variable names LOGICAL, INTENT(IN), OPTIONAL :: Verbose ! Turn error messages on/off CHARACTER (LEN=LEN(FuncStr)) :: Func ! Function string, local use !----- -------- --------- --------- --------- --------- --------- --------- ------- EvalErrType = 0 ! D. Price : to prevent accidental misuse ParseErrType = 0 PrintErrors = .true. IF (present(Verbose)) PrintErrors = Verbose ALLOCATE (ipos(LEN(Func))) ! Char. positions in orig. string Func = FuncStr ! Local copy of function string CALL Replace ('**','^ ',Func) ! Exponent into 1-Char. format CALL RemoveSpaces (Func) ! Condense function string !CALL GetConstants (Func) CALL CheckSyntax (Func,FuncStr,Var) DEALLOCATE (ipos) PrintErrors = .true. ! reset this to true checkf = ParseErrType END FUNCTION checkf ! FUNCTION evalf (i, Val) RESULT (res) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Evaluate bytecode of ith function for the values passed in array Val(:) !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: i ! Function identifier REAL(rn), DIMENSION(:), INTENT(in) :: Val ! Variable values REAL(rn) :: res ! Result INTEGER :: IP, & ! Instruction pointer DP, & ! Data pointer SP ! Stack pointer REAL(rn), PARAMETER :: zero = 0._rn !----- -------- --------- --------- --------- --------- --------- --------- ------- DP = 1 SP = 0 DO IP=1,Comp(i)%ByteCodeSize SELECT CASE (Comp(i)%ByteCode(IP)) CASE (cImmed); SP=SP+1; Comp(i)%Stack(SP)=Comp(i)%Immed(DP); DP=DP+1 CASE (cNeg); Comp(i)%Stack(SP)=-Comp(i)%Stack(SP) CASE (cAdd); Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)+Comp(i)%Stack(SP); SP=SP-1 CASE (cSub); Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)-Comp(i)%Stack(SP); SP=SP-1 CASE (cMul); Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)*Comp(i)%Stack(SP); SP=SP-1 CASE (cDiv); IF (Comp(i)%Stack(SP)==0._rn) THEN; EvalErrType=1; res=zero; RETURN; ENDIF Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)/Comp(i)%Stack(SP); SP=SP-1 ! D. Price: check for zero to negative powers and negative numbers to fractional powers CASE (cPow); IF (Comp(i)%Stack(SP-1)==0._rn .and.Comp(i)%Stack(SP)<0._rn) & THEN; EvalErrType=1; res=zero; RETURN; ENDIF IF (Comp(i)%Stack(SP-1)<=0._rn .and.(Comp(i)%Stack(SP).ne.nint(Comp(i)%Stack(SP)))) & THEN; EvalErrType=5; res=zero; RETURN; ENDIF Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)**Comp(i)%Stack(SP); SP=SP-1 CASE (cAbs); Comp(i)%Stack(SP)=ABS(Comp(i)%Stack(SP)) CASE (cExp); Comp(i)%Stack(SP)=EXP(Comp(i)%Stack(SP)) CASE (cLog10); IF (Comp(i)%Stack(SP)<=0._rn) THEN; EvalErrType=3; res=zero; RETURN; ENDIF Comp(i)%Stack(SP)=LOG10(Comp(i)%Stack(SP)) CASE (cLog); IF (Comp(i)%Stack(SP)<=0._rn) THEN; EvalErrType=3; res=zero; RETURN; ENDIF Comp(i)%Stack(SP)=LOG(Comp(i)%Stack(SP)) CASE (cSqrt); IF (Comp(i)%Stack(SP)<0._rn) THEN; EvalErrType=2; res=zero; RETURN; ENDIF Comp(i)%Stack(SP)=SQRT(Comp(i)%Stack(SP)) CASE (cSinh); Comp(i)%Stack(SP)=SINH(Comp(i)%Stack(SP)) CASE (cCosh); Comp(i)%Stack(SP)=COSH(Comp(i)%Stack(SP)) CASE (cTanh); Comp(i)%Stack(SP)=TANH(Comp(i)%Stack(SP)) CASE (cSin); Comp(i)%Stack(SP)=SIN(Comp(i)%Stack(SP)) CASE (cCos); Comp(i)%Stack(SP)=COS(Comp(i)%Stack(SP)) CASE (cTan); Comp(i)%Stack(SP)=TAN(Comp(i)%Stack(SP)) CASE (cAsin); IF ((Comp(i)%Stack(SP)<-1._rn).OR.(Comp(i)%Stack(SP)>1._rn)) THEN EvalErrType=4; res=zero; RETURN; ENDIF Comp(i)%Stack(SP)=ASIN(Comp(i)%Stack(SP)) CASE (cAcos); IF ((Comp(i)%Stack(SP)<-1._rn).OR.(Comp(i)%Stack(SP)>1._rn)) THEN EvalErrType=4; res=zero; RETURN; ENDIF Comp(i)%Stack(SP)=ACOS(Comp(i)%Stack(SP)) CASE (cAtan); Comp(i)%Stack(SP)=ATAN(Comp(i)%Stack(SP)) CASE DEFAULT; SP=SP+1; Comp(i)%Stack(SP)=Val(Comp(i)%ByteCode(IP)-VarBegin+1) END SELECT END DO EvalErrType = 0 res = Comp(i)%Stack(1) END FUNCTION evalf ! SUBROUTINE CheckSyntax (Func,FuncStr,Var) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check syntax of function string, returns 0 if syntax is ok !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: Func ! Function string without spaces CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Original function string CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with variable names INTEGER(is) :: n CHARACTER (LEN=1) :: c REAL(rn) :: r LOGICAL :: err INTEGER :: ParCnt, & ! Parenthesis counter j,ib,in,lFunc,inold,ibold !----- -------- --------- --------- --------- --------- --------- --------- ------- j = 1 ParCnt = 0 lFunc = LEN_TRIM(Func) step: DO IF (j > lFunc) THEN CALL ParseErrMsg (j, FuncStr) EXIT ENDIF c = Func(j:j) !-- -------- --------- --------- --------- --------- --------- --------- ------- ! Check for valid operand (must appear) !-- -------- --------- --------- --------- --------- --------- --------- ------- IF (c == '-' .OR. c == '+') THEN ! Check for leading - or + j = j+1 IF (j > lFunc) THEN CALL ParseErrMsg (j, FuncStr, 'Missing operand') EXIT ENDIF c = Func(j:j) IF (ANY(c == Ops)) THEN CALL ParseErrMsg (j, FuncStr, 'Multiple operators') EXIT ENDIF END IF n = MathFunctionIndex (Func(j:)) IF (n > 0) THEN ! Check for math function j = j+LEN_TRIM(Funcs(n)) IF (j > lFunc) THEN CALL ParseErrMsg (j, FuncStr, 'Missing function argument') EXIT ENDIF c = Func(j:j) IF (c /= '(') THEN CALL ParseErrMsg (j, FuncStr, 'Missing opening parenthesis') EXIT ENDIF END IF IF (c == '(') THEN ! Check for opening parenthesis ParCnt = ParCnt+1 j = j+1 CYCLE step END IF IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number r = RealNum (Func(j:),ib,in,err) IF (err) THEN CALL ParseErrMsg (j, FuncStr, 'Invalid number format: '//Func(j+ib-1:j+in-2)) EXIT ENDIF j = j+in-1 IF (j > lFunc) EXIT c = Func(j:j) ELSE ! Check for variable n = VariableIndex (Func(j:),Var,ib,in) IF (n == 0) THEN ! DP: If not a variable, check for constants ibold = ib inold = in r = MathConst (Func(j:),ib,in,err) IF (err) THEN ! Return error if constants not found CALL ParseErrMsg (j, FuncStr, 'Invalid element: '//Func(j+ib-1:j+in-2)) ib = ibold in = inold EXIT ENDIF ENDIF j = j+in-1 IF (j > lFunc) EXIT c = Func(j:j) END IF DO WHILE (c == ')') ! Check for closing parenthesis ParCnt = ParCnt-1 IF (ParCnt < 0) CALL ParseErrMsg (j, FuncStr, 'Mismatched parenthesis') IF (Func(j-1:j-1) == '(') CALL ParseErrMsg (j-1, FuncStr, 'Empty parentheses') j = j+1 IF (j > lFunc) EXIT c = Func(j:j) END DO !-- -------- --------- --------- --------- --------- --------- --------- ------- ! Now, we have a legal operand: A legal operator or end of string must follow !-- -------- --------- --------- --------- --------- --------- --------- ------- IF (j > lFunc) EXIT IF (ANY(c == Ops)) THEN ! Check for multiple operators IF (j+1 > lFunc) CALL ParseErrMsg (j, FuncStr) IF (ANY(Func(j+1:j+1) == Ops)) CALL ParseErrMsg (j+1, FuncStr, 'Multiple operators') ELSE ! Check for next operand CALL ParseErrMsg (j, FuncStr, 'Missing operator') END IF !-- -------- --------- --------- --------- --------- --------- --------- ------- ! Now, we have an operand and an operator: the next loop will check for another ! operand (must appear) !-- -------- --------- --------- --------- --------- --------- --------- ------- j = j+1 END DO step IF (ParCnt > 0) CALL ParseErrMsg (j, FuncStr, 'Missing )') END SUBROUTINE CheckSyntax ! FUNCTION EvalErrMsg () RESULT (msg) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Return error message !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), DIMENSION(5), PARAMETER :: m = (/ 'Division by zero ', & 'Argument of SQRT negative ', & 'Argument of LOG <= 0 ', & 'Argument of ASIN or ACOS illegal', & '-ve number to fractional power '/) CHARACTER (LEN=LEN(m)) :: msg !----- -------- --------- --------- --------- --------- --------- --------- ------- IF (EvalErrType < 1 .OR. EvalErrType > SIZE(m)) THEN msg = '' ELSE msg = m(EvalErrType) ENDIF END FUNCTION EvalErrMsg ! SUBROUTINE ParseErrMsg (j, FuncStr, Msg) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Print error message (modification by D.Price: do not terminate program, ! also added option to not print error message) !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: j CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Original function string CHARACTER (LEN=*), OPTIONAL, INTENT(in) :: Msg INTEGER :: k !----- -------- --------- --------- --------- --------- --------- --------- ------- IF (PrintErrors) THEN IF (PRESENT(Msg)) THEN WRITE(*,*) '*** Error in syntax of function string: '//Msg ELSE WRITE(*,*) '*** Error in syntax of function string:' ENDIF WRITE(*,*) WRITE(*,'(A)') ' '//FuncStr IF (ALLOCATED(ipos)) THEN ! Avoid out-of-bounds-errors IF (SIZE(ipos).ge.j) THEN DO k=1,ipos(j) WRITE(*,'(A)',ADVANCE='NO') ' ' ! Advance to the jth position END DO WRITE(*,'(A)') '?' ENDIF ENDIF ENDIF ParseErrType = 1 END SUBROUTINE ParseErrMsg ! FUNCTION OperatorIndex (c) RESULT (n) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Return operator index !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=1), INTENT(in) :: c INTEGER(is) :: n,j !----- -------- --------- --------- --------- --------- --------- --------- ------- n = 0 DO j=cAdd,cPow IF (c == Ops(j)) THEN n = j EXIT END IF END DO END FUNCTION OperatorIndex ! FUNCTION MathFunctionIndex (str) RESULT (n) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Return index of math function beginnig at 1st position of string str !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: str INTEGER(is) :: n,j INTEGER :: k CHARACTER (LEN=LEN(Funcs)) :: fun !----- -------- --------- --------- --------- --------- --------- --------- ------- n = 0 DO j=cAbs,cAtan ! Check all math functions k = MIN(LEN_TRIM(Funcs(j)), LEN(str)) CALL LowCase (str(1:k), fun) IF (fun == Funcs(j)) THEN ! Compare lower case letters n = j ! Found a matching function EXIT END IF END DO END FUNCTION MathFunctionIndex ! FUNCTION VariableIndex (str, Var, ibegin, inext) RESULT (n) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Return index of variable at begin of string str (returns 0 if no variable found) !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: str ! String CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with variable names INTEGER(is) :: n,j ! Index of variable INTEGER, OPTIONAL, INTENT(out) :: ibegin, & ! Start position of variable name inext ! Position of character after name INTEGER :: ib,in,lstr !----- -------- --------- --------- --------- --------- --------- --------- ------- n = 0 lstr = LEN_TRIM(str) IF (lstr > 0) THEN DO ib=1,lstr ! Search for first character in str IF (str(ib:ib) /= ' ') EXIT ! When lstr>0 at least 1 char in str END DO DO in=ib,lstr ! Search for name terminators IF (SCAN(str(in:in),'+-*/^) ') > 0) EXIT END DO DO j=1,SIZE(Var,kind=is) IF (str(ib:in-1) == Var(j)) THEN n = j ! Variable name found EXIT END IF END DO !--else below added by D. Price - should never be required though ELSE ! blank string ib = 1 ! to avoid compiler warnings in = 2 ! and any possible seg fault END IF IF (PRESENT(ibegin)) ibegin = ib IF (PRESENT(inext)) inext = in END FUNCTION VariableIndex ! SUBROUTINE RemoveSpaces (str) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Remove Spaces from string, remember positions of characters in old string !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(inout) :: str INTEGER :: k,lstr !----- -------- --------- --------- --------- --------- --------- --------- ------- lstr = LEN_TRIM(str) ipos = 0 do k=1,lstr ipos(k) = k enddo k = 1 DO WHILE (str(k:lstr) /= ' ') IF (str(k:k) == ' ') THEN str(k:lstr) = str(k+1:lstr)//' ' ! Move 1 character to left ipos(k:lstr) = (/ ipos(k+1:lstr), 0 /) ! Move 1 element to left k = k-1 END IF k = k+1 END DO END SUBROUTINE RemoveSpaces ! SUBROUTINE Replace (ca,cb,str) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Replace ALL appearances of character set ca in string str by character set cb !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: ca CHARACTER (LEN=LEN(ca)), INTENT(in) :: cb ! LEN(ca) must be LEN(cb) CHARACTER (LEN=*), INTENT(inout) :: str INTEGER :: j,lca !----- -------- --------- --------- --------- --------- --------- --------- ------- lca = LEN(ca) DO j=1,LEN_TRIM(str)-lca+1 IF (str(j:j+lca-1) == ca) str(j:j+lca-1) = cb END DO END SUBROUTINE Replace ! SUBROUTINE Compile (i, F, Var) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Compile i-th function string F into bytecode !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: i ! Function identifier CHARACTER (LEN=*), INTENT(in) :: F ! Function string CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with variable names INTEGER :: istat !----- -------- --------- --------- --------- --------- --------- --------- ------- IF (ASSOCIATED(Comp(i)%ByteCode)) DEALLOCATE ( Comp(i)%ByteCode, & Comp(i)%Immed, & Comp(i)%Stack ) Comp(i)%ByteCodeSize = 0 Comp(i)%ImmedSize = 0 Comp(i)%StackSize = 0 Comp(i)%StackPtr = 0 CALL CompileSubstr (i,F,1,LEN_TRIM(F),Var) ! Compile string to determine size ALLOCATE ( Comp(i)%ByteCode(Comp(i)%ByteCodeSize), & Comp(i)%Immed(Comp(i)%ImmedSize), & Comp(i)%Stack(Comp(i)%StackSize), & STAT = istat ) IF (istat /= 0) THEN WRITE(*,*) '*** Parser error: Memory allocation for byte code failed' STOP ELSE Comp(i)%ByteCodeSize = 0 Comp(i)%ImmedSize = 0 Comp(i)%StackSize = 0 Comp(i)%StackPtr = 0 CALL CompileSubstr (i,F,1,LEN_TRIM(F),Var) ! Compile string into bytecode END IF ! END SUBROUTINE Compile ! SUBROUTINE AddCompiledByte (i, b) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Add compiled byte to bytecode !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: i ! Function identifier INTEGER(is), INTENT(in) :: b ! Value of byte to be added !----- -------- --------- --------- --------- --------- --------- --------- ------- Comp(i)%ByteCodeSize = Comp(i)%ByteCodeSize + 1 IF (ASSOCIATED(Comp(i)%ByteCode)) Comp(i)%ByteCode(Comp(i)%ByteCodeSize) = b END SUBROUTINE AddCompiledByte ! FUNCTION MathItemIndex (i, F, Var) RESULT (n) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Return math item index, if item is real number, enter it into Comp-structure !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: i ! Function identifier CHARACTER (LEN=*), INTENT(in) :: F ! Function substring CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with variable names INTEGER(is) :: n ! Byte value of math item !----- -------- --------- --------- --------- --------- --------- --------- ------- n = 0 IF (SCAN(F(1:1),'0123456789.') > 0) THEN ! Check for begin of a number Comp(i)%ImmedSize = Comp(i)%ImmedSize + 1 IF (ASSOCIATED(Comp(i)%Immed)) Comp(i)%Immed(Comp(i)%ImmedSize) = RealNum (F) n = cImmed ELSE ! Check for a variable n = VariableIndex (F, Var) IF (n > 0) THEN n = VarBegin+n-1_is ELSE ! Check for Mathematical constants n = MathConstIndex(i, F) ENDIF END IF END FUNCTION MathItemIndex ! FUNCTION MathConstIndex (i, F, ibegin, inext) RESULT (n) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Routine added by D. Price ! Substitute values for Mathematical Constants (e.g. pi) !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: i ! Function identifier CHARACTER (LEN=*), INTENT(in) :: F ! Function substring INTEGER, OPTIONAL, INTENT(out) :: ibegin, & ! Start position of real number inext ! 1st character after real number INTEGER(is) :: n ! Byte value of math item REAL(rn) :: res LOGICAL :: err INTEGER :: ib,in !----- -------- --------- --------- --------- --------- --------- --------- ------- n = 0 res = MathConst(F,ib,in,err) IF (.not.err) THEN Comp(i)%ImmedSize = Comp(i)%ImmedSize + 1 IF (ASSOCIATED(Comp(i)%Immed)) Comp(i)%Immed(Comp(i)%ImmedSize) = res n = cImmed ELSE ib = 1 in = 1 END IF IF (PRESENT(ibegin)) ibegin = ib IF (PRESENT(inext)) inext = in END FUNCTION MathConstIndex ! FUNCTION CompletelyEnclosed (F, b, e) RESULT (res) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check if function substring F(b:e) is completely enclosed by a pair of parenthesis !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: F ! Function substring INTEGER, INTENT(in) :: b,e ! First and last pos. of substring LOGICAL :: res INTEGER :: j,k !----- -------- --------- --------- --------- --------- --------- --------- ------- res=.false. IF (F(b:b) == '(' .AND. F(e:e) == ')') THEN k = 0 DO j=b+1,e-1 IF (F(j:j) == '(') THEN k = k+1 ELSEIF (F(j:j) == ')') THEN k = k-1 END IF IF (k < 0) EXIT END DO IF (k == 0) res=.true. ! All opened parenthesis closed END IF END FUNCTION CompletelyEnclosed ! RECURSIVE SUBROUTINE CompileSubstr (i, F, b, e, Var) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Compile i-th function string F into bytecode !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: i ! Function identifier CHARACTER (LEN=*), INTENT(in) :: F ! Function substring INTEGER, INTENT(in) :: b,e ! Begin and end position substring CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with variable names INTEGER(is) :: n INTEGER :: b2,j,k,io CHARACTER (LEN=*), PARAMETER :: calpha = 'abcdefghijklmnopqrstuvwxyz'// & 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check for special cases of substring !----- -------- --------- --------- --------- --------- --------- --------- ------- IF (F(b:b) == '+') THEN ! Case 1: F(b:e) = '+...' ! WRITE(*,*)'1. F(b:e) = "+..."' CALL CompileSubstr (i, F, b+1, e, Var) RETURN ELSEIF (CompletelyEnclosed (F, b, e)) THEN ! Case 2: F(b:e) = '(...)' ! WRITE(*,*)'2. F(b:e) = "(...)"' CALL CompileSubstr (i, F, b+1, e-1, Var) RETURN ELSEIF (SCAN(F(b:b),calpha) > 0) THEN n = MathFunctionIndex (F(b:e)) IF (n > 0) THEN b2 = b+INDEX(F(b:e),'(')-1 IF (CompletelyEnclosed(F, b2, e)) THEN ! Case 3: F(b:e) = 'fcn(...)' ! WRITE(*,*)'3. F(b:e) = "fcn(...)"' CALL CompileSubstr(i, F, b2+1, e-1, Var) CALL AddCompiledByte (i, n) RETURN END IF END IF ELSEIF (F(b:b) == '-') THEN IF (CompletelyEnclosed (F, b+1, e)) THEN ! Case 4: F(b:e) = '-(...)' ! WRITE(*,*)'4. F(b:e) = "-(...)"' CALL CompileSubstr (i, F, b+2, e-1, Var) CALL AddCompiledByte (i, cNeg) RETURN ELSEIF (SCAN(F(b+1:b+1),calpha) > 0) THEN n = MathFunctionIndex (F(b+1:e)) IF (n > 0) THEN b2 = b+INDEX(F(b+1:e),'(') IF (CompletelyEnclosed(F, b2, e)) THEN ! Case 5: F(b:e) = '-fcn(...)' ! WRITE(*,*)'5. F(b:e) = "-fcn(...)"' CALL CompileSubstr(i, F, b2+1, e-1, Var) CALL AddCompiledByte (i, n) CALL AddCompiledByte (i, cNeg) RETURN END IF END IF ENDIF END IF !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check for operator in substring: check only base level (k=0), exclude expr. in () !----- -------- --------- --------- --------- --------- --------- --------- ------- DO io=cAdd,cPow ! Increasing priority +-*/^ k = 0 DO j=e,b,-1 IF (F(j:j) == ')') THEN k = k+1 ELSEIF (F(j:j) == '(') THEN k = k-1 END IF IF (k == 0 .AND. F(j:j) == Ops(io) .AND. IsBinaryOp (j, F)) THEN IF (ANY(F(j:j) == Ops(cMul:cPow)) .AND. F(b:b) == '-') THEN ! Case 6: F(b:e) = '-...Op...' with Op > - ! WRITE(*,*)'6. F(b:e) = "-...Op..." with Op > -' CALL CompileSubstr (i, F, b+1, e, Var) CALL AddCompiledByte (i, cNeg) RETURN ELSE ! Case 7: F(b:e) = '...BinOp...' ! WRITE(*,*)'7. Binary operator',F(j:j) CALL CompileSubstr (i, F, b, j-1, Var) CALL CompileSubstr (i, F, j+1, e, Var) CALL AddCompiledByte (i, OperatorIndex(Ops(io))) Comp(i)%StackPtr = Comp(i)%StackPtr - 1 RETURN END IF END IF END DO END DO !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check for remaining items, i.e. variables or explicit numbers !----- -------- --------- --------- --------- --------- --------- --------- ------- b2 = b IF (F(b:b) == '-') b2 = b2+1 n = MathItemIndex(i, F(b2:e), Var) ! WRITE(*,*)'8. AddCompiledByte ',n CALL AddCompiledByte (i, n) Comp(i)%StackPtr = Comp(i)%StackPtr + 1 IF (Comp(i)%StackPtr > Comp(i)%StackSize) Comp(i)%StackSize = Comp(i)%StackSize + 1 IF (b2 > b) CALL AddCompiledByte (i, cNeg) END SUBROUTINE CompileSubstr ! FUNCTION IsBinaryOp (j, F) RESULT (res) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check if operator F(j:j) in string F is binary operator ! Special cases already covered elsewhere: (that is corrected in v1.1) ! - operator character F(j:j) is first character of string (j=1) !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE INTEGER, INTENT(in) :: j ! Position of Operator CHARACTER (LEN=*), INTENT(in) :: F ! String LOGICAL :: res ! Result INTEGER :: k LOGICAL :: Dflag,Pflag !----- -------- --------- --------- --------- --------- --------- --------- ------- res=.true. IF (F(j:j) == '+' .OR. F(j:j) == '-') THEN ! Plus or minus sign: IF (j == 1) THEN ! - leading unary operator ? res = .false. ELSEIF (SCAN(F(j-1:j-1),'+-*/^(') > 0) THEN ! - other unary operator ? res = .false. ELSEIF (SCAN(F(j+1:j+1),'0123456789') > 0 .AND. & ! - in exponent of real number ? SCAN(F(j-1:j-1),'eEdD') > 0) THEN Dflag=.false.; Pflag=.false. k = j-1 DO WHILE (k > 1) ! step to the left in mantissa k = k-1 IF (SCAN(F(k:k),'0123456789') > 0) THEN Dflag=.true. ELSEIF (F(k:k) == '.') THEN IF (Pflag) THEN EXIT ! * EXIT: 2nd appearance of '.' ELSE Pflag=.true. ! * mark 1st appearance of '.' ENDIF ELSE EXIT ! * all other characters END IF END DO IF (Dflag .AND. (k == 1 .OR. SCAN(F(k:k),'+-*/^(') > 0)) res = .false. END IF END IF END FUNCTION IsBinaryOp ! FUNCTION RealNum (str, ibegin, inext, error) RESULT (res) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Get real number from string - Format: [blanks][+|-][nnn][.nnn][e|E|d|D[+|-]nnn] !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: str ! String REAL(rn) :: res ! Real number INTEGER, OPTIONAL, INTENT(out) :: ibegin, & ! Start position of real number inext ! 1st character after real number LOGICAL, OPTIONAL, INTENT(out) :: error ! Error flag INTEGER :: ib,in,istat LOGICAL :: Bflag, & ! .T. at begin of number in str InMan, & ! .T. in mantissa of number Pflag, & ! .T. after 1st '.' encountered Eflag, & ! .T. at exponent identifier 'eEdD' InExp, & ! .T. in exponent of number DInMan, & ! .T. if at least 1 digit in mant. DInExp, & ! .T. if at least 1 digit in exp. err ! Local error flag !----- -------- --------- --------- --------- --------- --------- --------- ------- Bflag=.true.; InMan=.false.; Pflag=.false.; Eflag=.false.; InExp=.false. DInMan=.false.; DInExp=.false. ib = 1 in = 1 DO WHILE (in <= LEN_TRIM(str)) SELECT CASE (str(in:in)) CASE (' ') ! Only leading blanks permitted ib = ib+1 IF (InMan .OR. Eflag .OR. InExp) EXIT CASE ('+','-') ! Permitted only IF (Bflag) THEN InMan=.true.; Bflag=.false. ! - at beginning of mantissa ELSEIF (Eflag) THEN InExp=.true.; Eflag=.false. ! - at beginning of exponent ELSE EXIT ! - otherwise STOP ENDIF CASE ('0':'9') ! Mark IF (Bflag) THEN InMan=.true.; Bflag=.false. ! - beginning of mantissa ELSEIF (Eflag) THEN InExp=.true.; Eflag=.false. ! - beginning of exponent ENDIF IF (InMan) DInMan=.true. ! Mantissa contains digit IF (InExp) DInExp=.true. ! Exponent contains digit CASE ('.') IF (Bflag) THEN Pflag=.true. ! - mark 1st appearance of '.' InMan=.true.; Bflag=.false. ! mark beginning of mantissa ELSEIF (InMan .AND..NOT.Pflag) THEN Pflag=.true. ! - mark 1st appearance of '.' ELSE EXIT ! - otherwise STOP END IF CASE ('e','E','d','D') ! Permitted only IF (InMan) THEN Eflag=.true.; InMan=.false. ! - following mantissa ELSE EXIT ! - otherwise STOP ENDIF CASE DEFAULT EXIT ! STOP at all other characters END SELECT in = in+1 END DO err = (ib > in-1) .OR. (.NOT.DInMan) .OR. ((Eflag.OR.InExp).AND..NOT.DInExp) IF (err) THEN res = 0.0_rn ELSE READ(str(ib:in-1),*,IOSTAT=istat) res err = istat /= 0 END IF IF (PRESENT(ibegin)) ibegin = ib IF (PRESENT(inext)) inext = in IF (PRESENT(error)) error = err END FUNCTION RealNum ! FUNCTION MathConst (str, ibegin, inext, error) RESULT (res) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Return values of Mathematical constants in string !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: str ! String REAL(rn) :: res ! Real number INTEGER, OPTIONAL, INTENT(out) :: ibegin, & ! Start position of real number inext ! 1st character after real number LOGICAL, OPTIONAL, INTENT(out) :: error ! Error flag INTEGER :: ib,in LOGICAL :: err ! Local error flag !----- -------- --------- --------- --------- --------- --------- --------- ------- ib = 1 in = 1 err = .false. IF (str(1:2)=='pi') THEN res = 3.14159265358979323846_rn in = 3 ELSE res = 0.0_rn err = .true. ENDIF IF (PRESENT(ibegin)) ibegin = ib IF (PRESENT(inext)) inext = in IF (PRESENT(error)) error = err END FUNCTION MathConst ! SUBROUTINE LowCase (str1, str2) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Transform upper case letters in str1 into lower case letters, result is str2 !----- -------- --------- --------- --------- --------- --------- --------- ------- IMPLICIT NONE CHARACTER (LEN=*), INTENT(in) :: str1 CHARACTER (LEN=*), INTENT(out) :: str2 INTEGER :: j,k CHARACTER (LEN=*), PARAMETER :: lc = 'abcdefghijklmnopqrstuvwxyz' CHARACTER (LEN=*), PARAMETER :: uc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' !----- -------- --------- --------- --------- --------- --------- --------- ------- str2 = str1 DO j=1,LEN_TRIM(str1) k = INDEX(uc,str1(j:j)) IF (k > 0) str2(j:j) = lc(k:k) END DO END SUBROUTINE LowCase ! END MODULE fparser splash/src/geometry.f90000644 000770 000000 00000044262 12506631437 015731 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! Standalone module containing subroutines to transform between ! different co-ordinate systems, for co-ordinates and vectors ! (e.g. from cartesian to cylindrical polar and vice versa) ! ! itype must be one of the following: ! itype = 1 : cartesian (default) ! itype = 2 : cylindrical ! itype = 3 : spherical ! itype = 4 : toroidal ! ! Currently handles: ! ! cartesian -> cylindrical, spherical polar ! cylindrical -> cartesian ! spherical polar -> cartesian ! toroidal r,theta,phi <-> cartesian ! ! written by Daniel Price 2004-2011 ! as part of the SPLASH SPH visualisation package !----------------------------------------------------------------- module geometry implicit none integer, parameter, public :: maxcoordsys = 4 integer, parameter, public :: igeom_cartesian = 1 integer, parameter, public :: igeom_cylindrical = 2 integer, parameter, public :: igeom_spherical = 3 integer, parameter, public :: igeom_toroidal = 4 character(len=24), dimension(maxcoordsys), parameter, public :: labelcoordsys = & (/'cartesian x,y,z ', & 'cylindrical r,phi,z ', & 'spherical r,phi,theta', & 'toroidal r,theta,phi'/) character(len=6), dimension(3,maxcoordsys), parameter, public :: labelcoord = & reshape((/'x ','y ','z ', & 'r ','phi ','z ', & 'r ','phi ','theta', & 'r_t ','theta','phi '/),shape=(/3,maxcoordsys/)) public :: coord_transform, vector_transform, coord_transform_limits public :: coord_is_length, print_error real, parameter, private :: pi = 3.1415926536 real, parameter, private :: Rtorus = 1.0 integer, parameter, public :: ierr_invalid_dimsin = 1 integer, parameter, public :: ierr_invalid_dimsout = 2 integer, parameter, public :: ierr_invalid_dims = 3 integer, parameter, public :: ierr_r_is_zero = 4 integer, parameter, public :: ierr_warning_assuming_cartesian = -1 private contains !----------------------------------------------------------------- ! utility that returns whether or not a particular coordinate ! in a given coordinate system has dimensions of length or not !----------------------------------------------------------------- pure logical function coord_is_length(ix,igeom) integer, intent(in) :: ix,igeom coord_is_length = .false. select case(igeom) case(igeom_toroidal, igeom_spherical) if (ix==1) coord_is_length = .true. case(igeom_cylindrical) if (ix==1 .or. ix==3) coord_is_length = .true. case(igeom_cartesian) coord_is_length = .true. end select end function coord_is_length !-------------------------------------------------------- ! utility to handle error printing so transform routines ! do not generate verbose output !-------------------------------------------------------- subroutine print_error(ierr) integer, intent(in) :: ierr select case(ierr) case(ierr_invalid_dimsin) print*,'Error: coord transform: invalid number of dimensions on input' case(ierr_invalid_dimsout) print*,'Error: coord transform: invalid number of dimensions on output' case(ierr_invalid_dims) print*,'Error: coord transform: ndimout must be <= ndimin' case(ierr_r_is_zero) print*,'Warning: coord transform: r=0 on input: cannot return angle' case(ierr_warning_assuming_cartesian) print*,'warning: using default cartesian output' case default print*,' unknown error' end select end subroutine print_error !----------------------------------------------------------------- ! Subroutine to transform between different co-ordinate systems ! (e.g. from cartesian to cylindrical polar and vice versa) ! ! xin(ndimin) : input co-ordinates, in ndimin dimensions ! itypein : input co-ordinate type ! ! xout(ndimout) : output co-ordinates, in ndimout dimensions ! itypeout : output co-ordinate type ! ! !----------------------------------------------------------------- pure subroutine coord_transform(xin,ndimin,itypein,xout,ndimout,itypeout,err) integer, intent(in) :: ndimin,ndimout,itypein,itypeout real, intent(in) :: xin(ndimin) real, intent(out) :: xout(ndimout) integer, intent(out), optional :: err real :: rcyl integer :: ierr ! !--check for errors in input ! ierr = 0 if (itypeout==itypein) then xout(1:ndimout) = xin(1:ndimout) return elseif (ndimin < 1.or.ndimin > 3) then ierr = ierr_invalid_dimsin if (present(err)) err = ierr return elseif (ndimout < 1.or.ndimout > 3) then ierr = ierr_invalid_dimsout if (present(err)) err = ierr return elseif (ndimout > ndimin) then ierr = ierr_invalid_dims if (present(err)) err = ierr return elseif (abs(xin(1)) < 1e-8 .and. ndimout >= 2 .and. & (itypein==2 .or. itypein==3)) then ierr = ierr_r_is_zero if (present(err)) err = ierr xout(1:ndimout) = xin(1:ndimout) return endif ! !--now do transformation ! select case(itypein) ! !--input is cylindrical polars ! case(2) select case(itypeout) case default ! ! output is cartesian (default) ! if (itypeout /= 1) ierr = ierr_warning_assuming_cartesian if (ndimout==1) then xout(1) = xin(1) else ! r,phi,z -> x,y,z xout(1) = xin(1)*COS(xin(2)) xout(2) = xin(1)*SIN(xin(2)) if (ndimout > 2) xout(3) = xin(3) endif end select ! !--input is spherical polars ! case(3) select case(itypeout) case default ! ! output is cartesian (default) ! if (itypeout /= 1) ierr = ierr_warning_assuming_cartesian select case(ndimout) case(1) ! r -> x xout(1) = xin(1) case(2) ! r,phi -> x,y xout(1) = xin(1)*COS(xin(2)) xout(2) = xin(1)*SIN(xin(2)) case(3) ! r,phi,theta -> x,y,z xout(1) = xin(1)*COS(xin(2))*SIN(xin(3)) xout(2) = xin(1)*SIN(xin(2))*SIN(xin(3)) xout(3) = xin(1)*COS(xin(3)) end select end select ! !--input is torus co-ordinates ! case(4) select case(itypeout) case default ! ! output is cartesian (default) ! if (itypeout /= 1) ierr = ierr_warning_assuming_cartesian if (ndimin /= 3) then xout(1:ndimout) = xin(1:ndimout) else rcyl = xin(1)*COS(xin(2)) + Rtorus xout(1) = rcyl*COS(xin(3)) if (ndimout >= 2) xout(2) = rcyl*SIN(xin(3)) if (ndimout >= 3) xout(3) = xin(1)*SIN(xin(2)) endif end select ! !--input is cartesian co-ordinates ! case default select case(itypeout) case(2) ! !--output is cylindrical ! if (ndimin==1) then xout(1) = abs(xin(1)) ! cylindrical r else xout(1) = SQRT(DOT_PRODUCT(xin(1:2),xin(1:2))) if (ndimout >= 2) xout(2) = ATAN2(xin(2),xin(1)) ! phi if (ndimout==3) xout(3) = xin(3) ! z endif case(3) ! !--output is spherical ! xout(1) = SQRT(DOT_PRODUCT(xin,xin))! r if (ndimout >= 2) xout(2) = ATAN2(xin(2),xin(1)) ! phi if (ndimout >= 3) then ! theta = ACOS(z/r) xout(3) = ACOS(xin(3)/xout(1)) endif case(4) ! !--output is torus r,theta,phi co-ordinates ! if (ndimin /= 3) then ! not applicable if ndim < 3 xout(1:ndimout) = xin(1:ndimout) else rcyl = SQRT(xin(1)**2 + xin(2)**2) xout(1) = SQRT(xin(3)**2 + (rcyl - Rtorus)**2) if (ndimout >= 2) xout(2) = ATAN2(xin(3),rcyl-Rtorus) ! ASIN(xin(3)/xout(1)) if (ndimout >= 3) xout(3) = ATAN2(xin(2),xin(1)) endif case default ! ! just copy ! xout(1:ndimout) = xin(1:ndimout) end select end select if (present(err)) err = ierr return end subroutine coord_transform !----------------------------------------------------------------- ! Subroutine to transform vector components ! between different co-ordinate systems ! (e.g. from cartesian to cylindrical polar and vice versa) ! ! Arguments: ! xin(ndimin) : input co-ordinates, in ndimin dimensions ! vecin(ndimin) : components of vector in input co-ordinate basis ! itypein : input co-ordinate type ! ! vecout(ndimout) : components of vector in output co-ordinate basis ! itypeout : output co-ordinate type ! ! coords must be one of the following: ! 'cartesian' (default) ! 'cylindrical' ! 'spherical' ! ! Currently handles: ! ! cartesian -> cylindrical, spherical polar ! cylindrical -> cartesian ! spherical polar -> cartesian ! !----------------------------------------------------------------- pure subroutine vector_transform(xin,vecin,ndimin,itypein,vecout,ndimout,itypeout,err) integer, intent(in) :: ndimin,ndimout,itypein,itypeout real, intent(in) :: xin(ndimin),vecin(ndimin) real, intent(out) :: vecout(ndimout) integer, intent(out), optional :: err integer :: i,ierr real :: dxdx(3,3) real :: sinphi, cosphi real :: rr,rr1,rcyl,rcyl2,rcyl1 ierr = 0 ! !--check for errors in input ! if (ndimout > ndimin) then ierr = ierr_invalid_dims if (present(err)) err = ierr return elseif (itypein==itypeout) then vecout(1:ndimout) = vecin(1:ndimout) return elseif (ndimin < 1.or.ndimin > 3) then ierr = ierr_invalid_dimsin if (present(err)) err = ierr return elseif (ndimout < 1.or.ndimout > 3) then ierr = ierr_invalid_dimsout if (present(err)) err = ierr return elseif (abs(xin(1)) < 1e-8 .and. & (itypein==2 .or. itypein==3)) then ierr = ierr_r_is_zero if (present(err)) err = ierr vecout = 0. return endif ! !--set Jacobian matrix to zero ! dxdx = 0. ! !--calculate non-zero components of Jacobian matrix for the transformation ! select case(itypein) ! !--input is toroidal ! case(4) select case(itypeout) case default dxdx(1,1) = COS(xin(2))*COS(xin(3)) ! dx/dr dxdx(1,2) = -SIN(xin(2))*COS(xin(3)) ! 1/r dx/dtheta dxdx(1,3) = SIN(xin(3)) ! 1/rcyl dx/dphi dxdx(2,1) = COS(xin(2))*SIN(xin(3)) ! dy/dr dxdx(2,2) = -SIN(xin(2))*SIN(xin(3)) ! 1/r dy/dtheta dxdx(2,3) = COS(xin(3)) ! 1/rcyl dy/dphi dxdx(3,1) = SIN(xin(3)) ! dz/dr dxdx(3,2) = COS(xin(3)) ! 1/r dz/dtheta ! dxdx(3,3) = 0. ! dz/dphi end select ! !--input is spherical polars ! case(3) select case(itypeout) case default ! ! output is cartesian (default) ! dxdx(1,1) = COS(xin(2))*SIN(xin(3)) ! dx/dr dxdx(1,2) = -SIN(xin(2)) ! 1/rcyl dx/dphi dxdx(1,3) = COS(xin(2))*COS(xin(3)) ! 1/r dx/dtheta dxdx(2,1) = SIN(xin(2))*SIN(xin(3)) ! dy/dr dxdx(2,2) = COS(xin(2)) ! 1/rcyl dy/dphi dxdx(2,3) = SIN(xin(2))*COS(xin(3)) ! 1/r dy/dtheta dxdx(3,1) = COS(xin(3)) ! dz/dr dxdx(3,3) = -SIN(xin(3)) ! 1/r dz/dtheta end select ! !--input is cylindrical polars ! case(2) select case(itypeout) case default ! ! output is cartesian (default) ! sinphi = SIN(xin(2)) cosphi = COS(xin(2)) dxdx(1,1) = cosphi ! dx/dr dxdx(1,2) = -sinphi ! 1/r*dx/dphi dxdx(2,1) = sinphi ! dy/dr dxdx(2,2) = cosphi ! 1/r*dy/dphi dxdx(3,3) = 1. ! dz/dz end select ! !--input is cartesian co-ordinates (default) ! case default select case(itypeout) case(4) ! ! output is toroidal ! rcyl = sqrt(xin(1)**2 + xin(2)**2) if (rcyl > tiny(rcyl)) then rcyl1 = 1./rcyl else rcyl1 = 0. endif rr = sqrt((rcyl - Rtorus)**2 + xin(3)**2) if (rr > tiny(rr)) then rr1 = 1./rr else rr1 = 0. endif dxdx(1,1) = (rcyl - Rtorus)*xin(1)*rr1*rcyl1 ! dr/dx dxdx(1,2) = (rcyl - Rtorus)*xin(2)*rr1*rcyl1 ! dr/dy dxdx(1,3) = xin(3)*rr1 ! dr/dz dxdx(2,1) = -xin(3)*xin(1)*rr1*rcyl1 ! dtheta/dx dxdx(2,2) = -xin(3)*xin(2)*rr1*rcyl1 ! dtheta/dy dxdx(2,3) = (rcyl - Rtorus)*rr1 ! dtheta/dz dxdx(3,1) = -xin(2)*rcyl1 ! dphi/dx dxdx(3,2) = xin(1)*rcyl1 ! dphi/dy ! dxdx(3,3) = 0. ! dphi/dz case(3) ! ! output is spherical ! rr = sqrt(dot_product(xin,xin)) if (rr > tiny(rr)) then rr1 = 1./rr else rr1 = 0. endif dxdx(1,1) = xin(1)*rr1 ! dr/dx if (ndimin >= 2) dxdx(1,2) = xin(2)*rr1 ! dr/dy if (ndimin==3) dxdx(1,3) = xin(3)*rr1 ! dr/dz if (ndimin >= 2) then rcyl2 = dot_product(xin(1:2),xin(1:2)) rcyl = sqrt(rcyl2) if (rcyl > tiny(rcyl)) then rcyl1 = 1./rcyl else rcyl1 = 0. endif dxdx(2,1) = -xin(2)*rcyl1 ! rcyl dphi/dx dxdx(2,2) = xin(1)*rcyl1 ! rcyl dphi/dy dxdx(2,3) = 0. if (ndimin >= 3) then dxdx(3,1) = xin(1)*xin(3)*rr1*rcyl1 ! r dtheta/dx dxdx(3,2) = xin(2)*xin(3)*rr1*rcyl1 ! r dtheta/dy dxdx(3,3) = -rcyl2*rr1*rcyl1 ! r dtheta/dz endif endif case(2) ! !--output is cylindrical ! rr = sqrt(dot_product(xin(1:min(ndimin,2)),xin(1:min(ndimin,2)))) if (rr > tiny(rr)) then rr1 = 1./rr else rr1 = 0. endif dxdx(1,1) = xin(1)*rr1 ! dr/dx if (ndimin >= 2) dxdx(1,2) = xin(2)*rr1 ! dr/dy if (ndimout >= 2) then dxdx(2,1) = -xin(2)*rr1 ! r*dphi/dx dxdx(2,2) = xin(1)*rr1 ! r*dphi/dy if (ndimout==3) dxdx(3,3) = 1. ! dz/dz endif case default ierr = ierr_warning_assuming_cartesian vecout(1:ndimout) = vecin(1:ndimout) return end select end select ! !--now perform transformation using Jacobian matrix ! do i=1,ndimout vecout(i) = dot_product(dxdx(i,1:ndimin),vecin(1:ndimin)) enddo if (present(err)) err = ierr return end subroutine vector_transform !------------------------------------------------------------------ ! this subroutine attempts to switch plot limits / boundaries ! between various co-ordinate systems. !------------------------------------------------------------------ subroutine coord_transform_limits(xmin,xmax,itypein,itypeout,ndim) integer, intent(in) :: itypein,itypeout,ndim real, dimension(ndim), intent(inout) :: xmin,xmax real, dimension(ndim) :: xmaxtemp,xmintemp ! !--check for errors in input ! if (ndim < 1 .or. ndim > 3) then print*,'Error: limits coord transform: ndim invalid on input' return endif !print*,'modifying plot limits for new coordinate system' ! !--by default do nothing ! xmintemp(1:ndim) = xmin(1:ndim) xmaxtemp(1:ndim) = xmax(1:ndim) select case(itypein) ! !--input is toroidal ! case(4) select case(itypeout) case default ! !--cartesian output ! xmintemp(1:min(ndim,2)) = -Rtorus - xmax(1) xmaxtemp(1:min(ndim,2)) = Rtorus + xmax(1) if (ndim==3) then xmintemp(3) = -xmax(1) xmaxtemp(3) = xmax(1) endif end select ! !--input is spherical ! case(3) select case(itypeout) case default ! !--cartesian output ! xmintemp(1:ndim) = -xmax(1) xmaxtemp(1:ndim) = xmax(1) end select ! !--input is cylindrical ! case(2) select case(itypeout) case default ! !--cartesian output ! xmintemp(1:max(ndim,2)) = -xmax(1) xmaxtemp(1:max(ndim,2)) = xmax(1) end select ! !--input is cartesian ! case default select case(itypeout) case(4) ! !--output is toroidal ! xmintemp(1) = 0. xmaxtemp(1) = max(maxval(abs(xmax(1:min(ndim,2))))-Rtorus, & maxval(abs(xmin(1:min(ndim,2))))-Rtorus) if (ndim >= 2) then xmintemp(2) = -0.5*pi xmaxtemp(2) = 0.5*pi if (ndim >= 3) then xmintemp(3) = -pi xmaxtemp(3) = pi endif endif ! !--output is spherical ! case(3) !--rmin, rmax xmintemp(1) = 0. xmaxtemp(1) = max(maxval(abs(xmin(1:ndim))), & maxval(abs(xmax(1:ndim)))) if (ndim >= 2) then xmintemp(2) = -pi xmaxtemp(2) = pi if (ndim >= 3) then xmintemp(3) = 0. xmaxtemp(3) = pi endif endif ! !--output is cylindrical ! case(2) !--rmin, rmax xmintemp(1) = 0. if (ndim >= 2) then xmaxtemp(1) = sqrt(max((xmin(1)**2 + xmin(2)**2), & (xmax(1)**2 + xmax(2)**2))) xmintemp(2) = -pi xmaxtemp(2) = pi else xmaxtemp(1) = max(abs(xmin(1)),abs(xmax(1))) endif end select end select xmin(:) = min(xmintemp(:),xmaxtemp(:)) xmax(:) = max(xmintemp(:),xmaxtemp(:)) return end subroutine coord_transform_limits end module geometry splash/src/geomutils.f90000644 000770 000000 00000022674 12465020646 016107 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! Utility module containing wrapper routines for coordinate ! transformations !----------------------------------------------------------------- module geomutils implicit none public :: change_coords, changecoords, changeveccoords public :: set_coordlabels private contains !----------------------------------------------------------------- ! transform all columns of data for a given particle ! to new coordinate system (does both coordinates ! and components of vectors) ! this version uses DOUBLE PRECISION for vals !----------------------------------------------------------------- subroutine change_coords(vals,ncols,ndim,icoords,icoordsnew,x0,v0) use params, only:doub_prec use geometry, only:coord_transform,vector_transform use labels, only:ix,iamvec,ivx implicit none integer, intent(in) :: ncols,ndim,icoords,icoordsnew real(kind=doub_prec), dimension(ncols), intent(inout) :: vals real, dimension(ndim), intent(in) :: x0,v0 real, dimension(ndim) :: xcoords,xcoordsnew,vec,vecnew integer :: iamvecprev,icol !--perform transformations on coordinates xcoords(1:ndim) = vals(ix(1:ndim)) - x0(1:ndim) call coord_transform(xcoords(1:ndim),ndim,icoords,xcoordsnew(1:ndim),ndim,icoordsnew) vals(ix(1:ndim)) = xcoordsnew(1:ndim) !--transform all vector quantities to new coord system iamvecprev = 0 do icol=1,ncols - ndim + 1 if (iamvec(icol).gt.0 .and. iamvec(icol).ne.iamvecprev) then iamvecprev = iamvec(icol) if (icol.eq.ivx) then vec(1:ndim) = vals(iamvec(icol):iamvec(icol)+ndim-1) - v0(1:ndim) else vec(1:ndim) = vals(iamvec(icol):iamvec(icol)+ndim-1) endif call vector_transform(xcoords,vec,ndim,icoords,vecnew,ndim,icoordsnew) vals(iamvec(icol):iamvec(icol)+ndim-1) = vecnew(1:ndim) endif enddo end subroutine change_coords !------------------------------------------------------------------- ! interface to coordinate-system transformations !------------------------------------------------------------------- subroutine changecoords(iplotx,iploty,xplot,yplot,ntot,ndim,itrackpart,dat) use geometry, only:coord_transform,labelcoordsys use settings_data, only:xorigin,icoords,icoordsnew,debugmode use labels, only:is_coord,ix implicit none integer, intent(in) :: iplotx,iploty,ntot,ndim,itrackpart real, dimension(:), intent(inout) :: xplot,yplot real, dimension(:,:), intent(in) :: dat real, dimension(ndim) :: xcoords,xcoordsnew integer :: j,ixcoord,iycoord logical :: iscoordx,iscoordy iscoordx = is_coord(iplotx,ndim) iscoordy = is_coord(iploty,ndim) if (iscoordx .or. iscoordy) then if (debugmode) print*,'changing coords from ',trim(labelcoordsys(icoords)), & ' to ',trim(labelcoordsys(icoordsnew)) if (itrackpart.gt.0) print*,'coords relative to particle ',itrackpart !--get offsets in range 1->ndim for the case where particle ! coords are not first in plot arrays ixcoord = iplotx - ix(1) + 1 if (iscoordx .and. (ixcoord.le.0 .or. ixcoord.gt.ndim)) then print*,'ERROR in x coordinate offset in arrays: cannot change coordinate system' return endif iycoord = iploty - ix(1) + 1 if (iscoordy .and. (iycoord.le.0 .or. iycoord.gt.ndim)) then print*,'ERROR in y coordinate offset in arrays: cannot change coordinate system' return endif do j=1,ntot if (itrackpart.gt.0 .and. itrackpart.le.ntot) then xcoords(1:ndim) = dat(j,ix(1:ndim)) - dat(itrackpart,ix(1:ndim)) else xcoords(1:ndim) = dat(j,ix(1:ndim)) - xorigin(1:ndim) endif call coord_transform(xcoords(1:ndim),ndim,icoords, & xcoordsnew(1:ndim),ndim,icoordsnew) if (iscoordx) xplot(j) = xcoordsnew(ixcoord) if (iscoordy) yplot(j) = xcoordsnew(iycoord) enddo endif end subroutine changecoords !------------------------------------------------------------------- ! interface to coordinate-system transformations for vectors !------------------------------------------------------------------- subroutine changeveccoords(iplot,xploti,ntot,ndim,itrackpart,dat) use geometry, only:vector_transform,labelcoordsys use settings_data, only:xorigin,icoords,icoordsnew,debugmode use labels, only:ivx,iamvec,ix implicit none integer, intent(in) :: iplot,ntot,ndim,itrackpart real, dimension(:), intent(inout) :: xploti real, dimension(ndim) :: xcoords,vecnew,vecin real, dimension(:,:), intent(in) :: dat integer :: j if (iamvec(iplot).gt.0) then if (iplot-iamvec(iplot)+1 .le. ndim) then if (debugmode) print*,'changing vector component from ', & trim(labelcoordsys(icoords)),' to ',trim(labelcoordsys(icoordsnew)) if (itrackpart.gt.0 .and. iamvec(iplot).eq.ivx) then print*,'velocities relative to particle ',itrackpart endif do j=1,ntot if (itrackpart.gt.0 .and. itrackpart.le.ntot) then xcoords(1:ndim) = dat(j,ix(1:ndim)) - dat(itrackpart,ix(1:ndim)) if (iamvec(iplot).eq.ivx) then vecin(1:ndim) = dat(j,iamvec(iplot):iamvec(iplot)+ndim-1) & - dat(itrackpart,iamvec(iplot):iamvec(iplot)+ndim-1) else vecin(1:ndim) = dat(j,iamvec(iplot):iamvec(iplot)+ndim-1) endif else xcoords(1:ndim) = dat(j,ix(1:ndim)) - xorigin(1:ndim) vecin(1:ndim) = dat(j,iamvec(iplot):iamvec(iplot)+ndim-1) endif call vector_transform(xcoords(1:ndim),vecin(1:ndim), & ndim,icoords,vecnew(1:ndim),ndim,icoordsnew) xploti(j) = vecnew(iplot-iamvec(iplot)+1) enddo else print*,'error: can''t convert vector components with ndimV > ndim' endif endif return end subroutine changeveccoords !---------------------------------------------------------------- ! ! routine to set labels for vector quantities and spatial ! coordinates depending on the coordinate system used. ! !---------------------------------------------------------------- subroutine set_coordlabels(numplot) use geometry, only:labelcoord,coord_is_length use labels, only:label,unitslabel,iamvec,labelvec,ix,labeldefault use settings_data, only:icoords,icoordsnew,ndim,iRescale,debugmode implicit none integer, intent(in) :: numplot integer :: i integer, save :: icoordsprev = -1 ! !--sanity check on icoordsnew... ! (should not be zero) ! if (icoordsnew.le.0) then if (icoords.gt.0) then icoordsnew = icoords else icoordsnew = 1 endif endif ! !--store the previous value of icoordsnew that was used ! last time we adjusted the labels ! if (icoordsprev.lt.0) icoordsprev = icoordsnew ! !--set coordinate and vector labels (depends on coordinate system) ! if (icoordsnew.ne.icoords .or. icoordsnew.ne.icoordsprev) then ! !--here we are using a coordinate system that differs from the original ! one read from the code (must change labels appropriately) ! if (debugmode) print*,'DEBUG: changing coordinate labels ...' do i=1,ndim if (ix(i).gt.0) then label(ix(i)) = labelcoord(i,icoordsnew) if (iRescale .and. coord_is_length(i,icoordsnew)) then label(ix(i)) = trim(label(ix(i)))//trim(unitslabel(ix(i))) endif endif enddo ! elseif (icoordsnew.ne.icoordsprev) then !! !!--here we are reverting back to the original coordinate system !! so we have to re-read the original labels from the data read !! ! call get_labels endif ! !--set vector labels if iamvec is set and the labels are the default ! if (icoordsnew.gt.0) then do i=1,numplot if (iamvec(i).ne.0 .and. & (icoordsnew.ne.icoords .or. icoordsnew.ne.icoordsprev & .or. index(label(i),trim(labeldefault)).ne.0)) then if (i-iamvec(i)+1 .gt. 0) then if (icoordsnew.eq.1) then label(i) = trim(labelvec(iamvec(i)))//'_'//trim(labelcoord(i-iamvec(i)+1,icoordsnew)) else label(i) = trim(labelvec(iamvec(i)))//'_{'//trim(labelcoord(i-iamvec(i)+1,icoordsnew))//'}' endif else print "(a,i2,a,i2)",' ERROR with vector labels, referencing '// & trim(labelvec(iamvec(i)))//' in column ',i,' iamvec = ',iamvec(i) endif if (iRescale) then label(i) = trim(label(i))//'\u'//trim(unitslabel(i)) endif endif enddo endif icoordsprev = icoordsnew return end subroutine set_coordlabels end module geomutils splash/src/get_data.f90000644 000770 000000 00000046600 12462261531 015637 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! wrapper for the main data read ! ensures that same procedure occurs on initial read as from menu option ! ! drives reading of all files listed on command line ! ! Arguments: ! ireadfile : if < 0, reads from all files ! if > 0, reads only from the filename rootname(ireadfile) ! if = 0, no data read, just call labelling and exact_params ! module getdata implicit none public :: get_data, get_labels integer, private :: ncolumnsfirst private contains subroutine get_data(ireadfile,gotfilenames,firsttime) use asciiutils, only:ucase use exact, only:read_exactparams use filenames, only:rootname,nstepsinfile,nfiles,nsteps,maxfile,ifileopen use limits, only:set_limits use settings_data, only:ncolumns,iendatstep,ncalc,ivegotdata, & DataisBuffered,iCalcQuantities,ndim,iverbose,ntypes, & iRescale,required,ipartialread,lowmemorymode,debugmode use settings_data, only:iexact use particle_data, only:dat,time,npartoftype,maxcol use prompting, only:prompt use labels, only:labeltype use calcquantities, only:calc_quantities use settings_units, only:units use timing, only:wall_time,print_time use settings_part, only:iplotpartoftype use geomutils, only:set_coordlabels use adjustdata, only:adjust_data_codeunits implicit none integer, intent(in) :: ireadfile logical, intent(in) :: gotfilenames logical, intent(in), optional :: firsttime logical :: setlimits,isfirsttime logical, parameter :: dotiming = .true. integer :: i,istart,ierr,itype,nplot real :: t1,t2 if (.not.gotfilenames) then if (nfiles.le.0 .or. nfiles.gt.maxfile) nfiles = 1 call prompt('Enter number of files to read ',nfiles,1,maxfile) do i=1,nfiles call prompt('Enter filename to read',rootname(i),noblank=.true.) enddo endif ! !--set everything to zero initially ! ncolumns = 0 ncalc = 0 nsteps = 0 istart = 1 ivegotdata = .false. ifileopen = ireadfile DataIsBuffered = .false. ipartialread = .false. isfirsttime = .false. if (present(firsttime)) isfirsttime = firsttime if (isfirsttime) then iverbose = 1 else iverbose = 0 endif ! !--nstepsinfile is initialised to negative ! this is set progressively as files are read ! for non-buffered data file 1 is read and the rest are assumed to be the same ! then these files are corrected as they are read. By initialising nstepsinfile ! to negative, this means that if we get dud files (with nstepsinfile=0) we ! know that this is really the file contents (not just an initialised value of nstepsinfile) ! and can skip the file on the second encounter (see timestepping.f90) ! if (isfirsttime) then nstepsinfile(:) = -1 ncolumnsfirst = 0 required = .true. if (lowmemorymode) required = .false. call endian_info() endif if (ireadfile.le.0) then ! !--read all steps from the data file ! nstepsinfile(1:nfiles) = 0 required = .true. print "(/a)",' reading ALL dumpfiles into memory' !call endian_info() do i=1,nfiles call read_data(rootname(i),istart,nstepsinfile(i)) istart = istart + nstepsinfile(i) ! number of next step in data array if (nstepsinfile(i).gt.0 .and. ncolumnsfirst.eq.0 .and. ncolumns.gt.0) then ncolumnsfirst = ncolumns elseif (nstepsinfile(i).gt.0 .and. ncolumns.ne.ncolumnsfirst) then print "(a,i2,a,i2,a)",' WARNING: file contains ',ncolumns, & ' columns, which differs from ',ncolumnsfirst,' read previously' ncolumns = max(ncolumns,ncolumnsfirst) endif enddo nsteps = istart - 1 if (nsteps.gt.0) then ivegotdata = .true. DataIsBuffered = .true. else ncolumns = 0 endif print "(a,i6,a,i3)",' >> Finished data read, nsteps = ',nsteps,' ncolumns = ',ncolumns ! !--set labels (and units) for each column of data ! !print "(/a)",' setting plot labels...' if (ivegotdata .and. ncolumns.gt.0) then call get_labels call adjust_data_codeunits ! !--do some basic sanity checks ! call check_data_read() endif if (iRescale .and. any(abs(units(0:ncolumns)-1.0).gt.tiny(units))) then !write(*,"(/a)") ' rescaling data...' do i=1,ncolumns if (abs(units(i)-1.0).gt.tiny(units) .and. abs(units(i)).gt.tiny(units)) then dat(:,i,1:nsteps) = dat(:,i,1:nsteps)*units(i) endif enddo time(1:nsteps) = time(1:nsteps)*units(0) endif ! !--reset coordinate and vector labels (depending on coordinate system) ! Need to do this BEFORE calculating quantities ! if (ivegotdata) call set_coordlabels(ncolumns) ! !--calculate various additional quantities ! if (nsteps.ge.1 .and. iCalcQuantities) then call calc_quantities(1,nsteps) endif ! !--set plot limits ! if (ierr.gt.0 .and. ivegotdata .and. nstepsinfile(1).ge.1) then call set_limits(1,nsteps,1,ncolumns+ncalc) endif elseif (ireadfile.gt.0) then ! !--read from a single file only ! nstepsinfile(ireadfile) = 0 !if (isfirsttime) print "(/a)",' reading single dumpfile' if (dotiming) call wall_time(t1) call read_data(rootname(ireadfile),istart,nstepsinfile(ireadfile)) ! !--do some basic sanity checks ! if (debugmode) print "(a,i3)",' DEBUG: ncolumns from data read = ',ncolumns if (debugmode) print "(a,i3)",' DEBUG: nsteps read from file = ',nstepsinfile(ireadfile) !--try different endian if failed the first time !if (nstepsinfile(ireadfile).eq.0) then ! print "(a)",' trying different endian' ! call read_data_otherendian(rootname(ireadfile),istart,nstepsinfile(ireadfile)) !endif if (dotiming) then call wall_time(t2) if (t2-t1.gt.1.) then if (ipartialread) then call print_time(t2-t1,'time for (partial) data read = ') print* else call print_time(t2-t1,'time for data read = ') print* endif endif ! do i=1,ncolumns+ncalc ! print*,' required(',i,') = ',required(i) ! enddo endif !!print*,'nsteps in file = ',nstepsinfile(ireadfile) if (ANY(nstepsinfile(1:ireadfile).gt.0)) ivegotdata = .true. if (.not.ivegotdata) ncolumns = 0 ! !--set ncolumns on first step only ! if (ivegotdata .and. ncolumnsfirst.eq.0 .and. ncolumns.gt.0) then ncolumnsfirst = ncolumns endif !--override ncolumns from file and warn if different to first file if (ncolumnsfirst.gt.0 .and. nstepsinfile(ireadfile).gt.0) then if (ncolumns.ne.ncolumnsfirst) then print "(1x,a,i2,a,i2,a)",'WARNING: file contains ',ncolumns, & ' columns, which differs from ',ncolumnsfirst,' read previously' if (ncolumns.lt.ncolumnsfirst) then print "(10x,a,i2,/)",'setting data = 0 for columns > ',ncolumns dat(:,ncolumns+1:min(ncolumnsfirst,maxcol),1:nstepsinfile(ireadfile)) = 0. elseif (ncolumns.gt.ncolumnsfirst) then print "(10x,a,i2,a)",'extra data beyond column ',ncolumnsfirst,' will be ignored' print "(10x,a,/)",'(read this file first to use this data)' endif ncolumns = ncolumnsfirst endif endif ! !--assume there are the same number of steps in the other files ! which have not been read ! do i=1,nfiles if (nstepsinfile(i).eq.-1) then nstepsinfile(i) = nstepsinfile(ireadfile) endif enddo nsteps = sum(nstepsinfile(1:nfiles)) ! !--set labels (and units) for each column of data ! allow this to be overridden by the presence of a splash.columns file ! !!print "(/a)",' setting plot labels...' if (ivegotdata .and. ncolumns.gt.0) then call get_labels call adjust_data_codeunits call check_data_read() endif if (iRescale .and. any(abs(units(0:ncolumns)-1.0).gt.tiny(units))) then if (debugmode) write(*,"(a)") ' rescaling data...' do i=1,min(ncolumns,maxcol) if (abs(units(i)-1.0).gt.tiny(units) .and. abs(units(i)).gt.tiny(units)) then dat(:,i,1:nstepsinfile(ireadfile)) = dat(:,i,1:nstepsinfile(ireadfile))*units(i) endif enddo do i=1,nstepsinfile(ireadfile) if (time(i).gt.-0.5*huge(0.)) time(i) = time(i)*units(0) enddo endif ! !--reset coordinate and vector labels (depending on coordinate system) ! Need to do this BEFORE calculating quantities ! if (ivegotdata) call set_coordlabels(ncolumns) ! !--calculate various additional quantities ! if (nstepsinfile(ireadfile).gt.0 .and. iCalcQuantities) then if (ipartialread .and. .not.any(required(ncolumns+1:))) then !--for partial data reads do a "pretend" call to calc quantities ! just to get ncalc and column labels right call calc_quantities(1,nstepsinfile(ireadfile),dontcalculate=.true.) else call calc_quantities(1,nstepsinfile(ireadfile)) endif endif ! !--only set limits if reading the first file for the first time ! setlimits = (ireadfile.eq.1 .and. ivegotdata .and. nstepsinfile(1).ge.1) if (.not.present(firsttime)) then setlimits = .false. elseif (.not.firsttime) then setlimits = .false. endif if (setlimits) then call set_limits(1,nstepsinfile(ireadfile),1,ncolumns+ncalc) !--also set iendatstep the first time around iendatstep = nsteps endif endif ! !--check for errors in data read / print warnings ! if (ndim.ne.0 .and. ncolumns.gt.0 .and. nsteps.gt.0 .and. iverbose.eq.1) then if (sum(npartoftype(:,1)).gt.0 .and. npartoftype(1,1).eq.0) then print "(a)",' WARNING! DATA APPEARS TO CONTAIN NO '//trim(ucase(labeltype(1)))//' PARTICLES' itype = 0 nplot = 0 do while (nplot.eq.0 .and. itype < ntypes) itype = itype + 1 if (npartoftype(itype,1).gt.0) then iplotpartoftype(itype) = .true. nplot = nplot + npartoftype(itype,1) print "(a)",' (plotting of '//trim(labeltype(itype))//' particles turned ON)' endif enddo print* endif endif ! !--read exact solution parameters from files if present ! if (iexact.ne.0) then if (ireadfile.lt.0) then call read_exactparams(iexact,rootname(1),ierr) else call read_exactparams(iexact,rootname(ireadfile),ierr) endif endif return end subroutine get_data !---------------------------------------------------------------------- ! ! The following is a wrapper routine for the call to set_labels which ! overrides the label setting from the splash.columns file if present. ! Also adds the units label if the data has been rescaled. ! !---------------------------------------------------------------------- subroutine get_labels use asciiutils, only:read_asciifile use filenames, only:fileprefix,unitsfile use labels, only:label,unitslabel use settings_data, only:ncolumns,iRescale,iverbose use settings_units, only:read_unitsfile use particle_data, only:maxcol use params, only:maxplot implicit none logical :: iexist integer :: nlabelsread,ierr,i call set_labels ! !--check that label settings are sensible, fix where possible ! call check_labels ! !--look for a .columns file to override the default column labelling ! inquire(file=trim(fileprefix)//'.columns',exist=iexist) nlabelsread = 0 if (iexist) then call read_asciifile(trim(fileprefix)//'.columns',nlabelsread,label(1:min(ncolumns,maxcol,maxplot))) if (nlabelsread.lt.ncolumns) & print "(a,i3)",' end of file in '//trim(fileprefix)//'.columns file: labels read to column ',nlabelsread endif ! !--read units file and change units if necessary ! call read_unitsfile(trim(unitsfile),ncolumns,ierr,iverbose) ! !--add units labels to labels ! if (iRescale) then do i=1,min(ncolumns,maxcol,maxplot) if (index(label(i),trim(unitslabel(i))).eq.0) label(i) = trim(label(i))//trim(unitslabel(i)) enddo endif end subroutine get_labels !---------------------------------------------------------------- ! ! utility to check that label settings are sensible ! !---------------------------------------------------------------- subroutine check_labels use settings_data, only:ndim,ndimV,ncolumns,iverbose use labels, only:ix,irho,ih,ipmass use particle_data, only:masstype use settings_render, only:icolour_particles implicit none integer :: i,ndimset if (ndim.ne.0 .and. ncolumns.gt.0) then if (ndim.lt.0 .or. ndim.gt.3) then print "(a)",' ERROR with ndim setting in data read, using ndim=3' ndim = 3 endif if (ndimV.lt.0 .or. ndimV.gt.3) then print "(a)",' ERROR with ndimV setting in data read, using ndimV=3' ndimV = 3 endif if (ndim.ge.2 .and. any(ix(2:ndim).eq.ix(1))) then print "(a)",' WARNING: error in ix setting in set_labels: fixing ' ix(1) = max(ix(1),1) do i=2,ndim ix(i) = i enddo endif if (ndim.ge.1) then do i=1,ndim if (ix(i).le.0) then ix(i) = i print "(a)",' WARNING: ndim > 0 but zero ix setting in set_labels: fixing ' endif enddo endif ndimset = 0 do i=1,3 if (ix(i).ne.0) ndimset = ndimset + 1 enddo if (ndimset.ne.ndim) then print "(2(a,i2))",' ERROR: labels for ',ndimset,& ' coordinates set but got ndim = ',ndim endif if (irho.gt.ncolumns .or. irho.lt.0) then print "(a)",' ERROR with irho setting in data read' irho = 0 endif if (ih.gt.ncolumns .or. ih.lt.0) then print "(a)",' ERROR with ih setting in data read ' ih = 0 endif if (ipmass.gt.ncolumns .or. ipmass.lt.0) then print "(a)",' ERROR with ipmass setting in data read' ipmass = 0 endif if (iverbose.ge.1) then if (irho.eq.0 .or. ih.eq.0) then print "(4(/,a))",' WARNING: Rendering capabilities cannot be enabled', & ' until positions of density, smoothing length and particle', & ' masses are known (specified using the integer variables ', & ' irho,ih and ipmass in the read_data routine)' icolour_particles = .true. elseif (irho.gt.0 .and. ih.gt.0 .and. ipmass.eq.0 .and. all(masstype(:,:).lt.tiny(0.))) then print "(2(/,a))",' WARNING: Particle masses not read as array but mass not set:', & ' RENDERING WILL NOT WORK! ' endif endif endif end subroutine check_labels !---------------------------------------------------------------- ! ! utility to check things about the data read ! !---------------------------------------------------------------- subroutine check_data_read use params, only:maxplot,maxparttypes use settings_data, only:ncolumns,ndim,ndimV,ntypes,ivegotdata use particle_data, only:npartoftype,iamtype,dat use labels, only:labeltype implicit none integer :: i,j,ntoti,nunknown,itype integer, dimension(maxparttypes) :: noftype if (ncolumns.lt.0) then print "(a)",' ERROR: ncolumns < 0 in data read' ncolumns = 0 elseif (ncolumns.gt.maxplot) then print "(/,71('*'),/,'*',a,i3,a,'*',/,71('*'))",& ' ERROR: ncolumns > ',maxplot,' in data read: cannot list all columns in menu ' ncolumns = maxplot endif if (ndim.gt.3) then; print "(a)",' ERROR: ndim > 3 in data read, setting ndim = 3'; ndim = 3; endif if (ndim.lt.0) then; print "(a)",' ERROR: ndim < 0 in data read, setting ndim = 0'; ndim = 0; endif if (ndimV.gt.3) then; print "(a)",' ERROR: ndimV > 3 in data read, setting ndimV = 3'; ndimV = 3; endif if (ndimV.lt.0) then; print "(a)",' ERROR: ndimV < 0 in data read, setting ndimV = 0'; ndimV = 0; endif if (ntypes.lt.0) then; print "(a)",' ERROR: ntypes < 0 in data read'; ntypes = 0; endif if (allocated(npartoftype)) then if (size(npartoftype(:,1)).lt.ntypes) then print "(a)",' ERROR: too many particle types for allocated array size in data read' ntypes = size(npartoftype(:,1)) endif do i=1,ntypes do j=1,size(npartoftype(i,:)) if (npartoftype(i,j).lt.0) then print "(a)",' ERROR: number of '//trim(labeltype(i))//' particles < 0 in data read' npartoftype(i,j) = 0 endif enddo enddo ntoti = sum(npartoftype(:,1)) if (ntoti > size(dat(:,1,1))) then print "(2(a,i10),a)",' ERROR: size of dat array (',size(dat(:,1,1)),& ') too small for number of particles (',ntoti,')' ivegotdata = .false. endif !if (debugmode) then ! !--for mixed type storage, check that the number of particles ! of each type adds up to npartoftype ! ntoti = sum(npartoftype(:,1)) noftype(:) = 0 nunknown = 0 if (size(iamtype(:,1)).ge.ntoti) then do i=1,ntoti itype = iamtype(i,1) if (itype.gt.0 .and. itype.le.ntypes) then noftype(itype) = noftype(itype) + 1 else nunknown = nunknown + 1 endif enddo do itype=1,ntypes if (npartoftype(itype,1).ne.noftype(itype)) then print "(a,i10,a,i10)",' ERROR in data read: got ',noftype(itype),' '//trim(labeltype(itype))// & ' particles from iamtype, but npartoftype = ',npartoftype(itype,1) endif enddo if (nunknown.gt.0) then print "(a,i10,a)",' ERROR in data read: got ',nunknown, & ' particles of unknown type in iamtype array from data read' endif endif !endif endif end subroutine check_data_read !------------------------------------- ! ! simple utility to spit out native ! endian-ness ! !------------------------------------- subroutine endian_info implicit none logical :: bigendian bigendian = IACHAR(TRANSFER(1,"a")) == 0 if (bigendian) then print "(a)",' native byte order on this machine is BIG endian' !--we no longer warn for little endian, as this is now most common !else ! print "(a)",' native byte order on this machine is LITTLE endian' endif end subroutine endian_info end module getdata splash/src/globaldata.f90000644 000770 000000 00000011605 12462271522 016157 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------------- ! ! modules containing global variables ! !---------------------------------------------------------------------------- ! !--global parameters ! module params implicit none integer, parameter :: doub_prec = selected_real_kind(P=10,R=30) integer, parameter :: sing_prec = selected_real_kind(P=5,R=15) integer, parameter :: int1 = selected_int_kind(1) integer, parameter :: int8 = selected_int_kind(10) integer, parameter :: maxplot=64 ! maximum number of plots (for multiplot arrays) integer, parameter :: maxparttypes = 12 ! max # of different particle types public end module params module physcon use params, only:doub_prec implicit none real(doub_prec), parameter :: solarrcgs = 6.955d10 real(doub_prec), parameter :: solarmcgs = 1.989d33 public end module physcon ! !--particle data ! module particle_data use params implicit none integer :: maxpart,maxstep,maxcol ! dimensions of dat array integer, allocatable, dimension(:) :: icolourme integer(kind=int1), allocatable, dimension(:,:) :: iamtype integer, allocatable, dimension(:,:) :: npartoftype real, allocatable, dimension(:,:) :: masstype real, allocatable, dimension(:) :: time, gamma real, allocatable, dimension(:,:,:) :: dat real, parameter :: time_not_read_val = -0.5*huge(0.) public contains logical function time_was_read(t) real, intent(in) :: t time_was_read = .true. if (t <= time_not_read_val) time_was_read = .false. end function time_was_read end module particle_data ! !--filenames ! module filenames implicit none integer, parameter :: maxfile = 10001 integer :: nfiles,nsteps,ifileopen character(len=120), dimension(maxfile) :: rootname character(len=100) :: fileprefix character(len=120) :: defaultsfile,limitsfile,unitsfile integer, dimension(maxfile) :: nstepsinfile character(len=68) :: tagline = & 'SPLASH: A visualisation tool for SPH data (c)2004-2015 Daniel Price' public contains subroutine set_filenames(prefix) implicit none character(len=*), intent(in) :: prefix defaultsfile = trim(adjustl(prefix))//'.defaults' limitsfile = trim(adjustl(prefix))//'.limits' unitsfile = trim(adjustl(prefix))//'.units' fileprefix = trim(adjustl(prefix)) return end subroutine set_filenames end module filenames !------------------------------------ ! modules containing plot settings !------------------------------------ ! !--data ! module settings_data use params implicit none integer :: numplot,ncalc,ncolumns,nextra integer :: ndataplots integer :: ndim, ndimv integer :: icoords,icoordsnew,iformat,ntypes,iexact integer :: istartatstep,iendatstep,nfreq integer :: itracktype,itrackoffset,iverbose integer, dimension(10) :: isteplist logical :: ivegotdata, DataIsBuffered, ipartialread logical :: buffer_data,iUseStepList,iCalcQuantities,iRescale !--required array is dimensioned 0:maxplot so that required(icol) = .true. ! does nothing bad if icol = 0 (much safer that way) logical :: lowmemorymode logical :: debugmode logical, dimension(0:maxplot) :: required logical, dimension(maxparttypes) :: UseTypeInRenderings real, dimension(3) :: xorigin namelist /dataopts/ buffer_data,iCalcQuantities,iRescale,xorigin,itracktype,itrackoffset public end module settings_data ! !--multiplot settings ! module multiplot use params implicit none integer :: nyplotmulti integer, dimension(maxplot) :: multiplotx,multiploty integer, dimension(maxplot) :: irendermulti,ivecplotmulti integer, dimension(maxplot) :: itrans,icontourmulti logical, dimension(maxplot) :: x_secmulti real, dimension(maxplot) :: xsecposmulti logical, dimension(maxplot) :: iusealltypesmulti logical, dimension(maxparttypes,maxplot) :: iplotpartoftypemulti ! !--sort these into a namelist for input/output ! namelist /multi/ nyplotmulti, & itrans,multiplotx,multiploty,irendermulti, & ivecplotmulti,icontourmulti,x_secmulti,xsecposmulti, & iusealltypesmulti,iplotpartoftypemulti public end module multiplot splash/src/H5Part/000755 000770 000000 00000000000 12612006625 014642 5ustar00dpricewheel000000 000000 splash/src/interactive.f90000644 000770 000000 00000323326 12347462775 016426 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module interactive_routines use colourbar, only:barisvertical,incolourbar,incolourbarlabel,adjustcolourbar implicit none public :: interactive_part,interactive_step,interactive_multi private :: mvlegend,mvtitle,save_limits,save_rotation private :: get_vptxy real, private :: xcursor = 0.5 real, private :: ycursor = 0.5 private contains ! !--interactive tools on particle plots ! allows user to change settings interactively ! ! Arguments: ! ! INPUT: ! npart : number of particles plotted ! iplotx : quantity plotted as x axis ! iploty : quantity plotted as y axis ! iplotz : quantity to use in selecting particles ! irender : quantity rendered ! xcoords(npart) : x coordinates of particles ! ycoords(npart) : y coordinates of particles ! zcoords(npart) : z coordinates (or third quantity) of particles ! hi(npart) : smoothing lengths of particles ! zmin, zmax : range of z within which to plot particles ! istep : current step position ! ilaststep : position of last timestep ! ! CHANGEABLE: ! icolourpart(npart) : flag indicating colour of particles ! xmin, xmax, ymin, ymax : current plot limits ! rendermin, rendermax : current rendering limits ! vecmax : maximum vector limits ! ! OUTPUT: ! iadvance : integer telling the loop how to advance the timestep ! irerender : if set, redo rendering. Anything which requires rendering ! to be recalculated must set this ! subroutine interactive_part(npart,iplotx,iploty,iplotz,irender,icontour,ivecx,ivecy, & xcoords,ycoords,zcoords,hi,icolourpart,iamtype,usetype,npartoftype,xmin,xmax,ymin,ymax, & rendermin,rendermax,renderminadapt,rendermaxadapt,contmin,contmax,& contminadapt,contmaxadapt,vecmax, & anglex,angley,anglez,ndim,xorigin,x_sec,zslicepos,dzslice, & zobserver,dscreen,use3Dopacity,taupartdepth,double_rendering,irerender,itrackpart,icolourscheme, & iColourBarStyle,labelrender,iadvance,istep,ilaststep,iframe,nframes,interactivereplot) use settings_xsecrot, only:setsequenceend use shapes, only:inshape,edit_shape,edit_textbox,delete_shape,nshapes,add_textshape use multiplot, only:itrans use labels, only:is_coord,ix use limits, only:assert_sensible_limits use settings_render, only:projlabelformat,iapplyprojformat use settings_data, only:ndataplots,ntypes,icoords,icoordsnew use plotlib, only:plot_qwin,plot_curs,plot_sfs,plot_circ,plot_line,plot_pt1, & plot_rect,plot_band,plot_sfs,plot_qcur,plot_left_click,plot_right_click,& plot_scroll_left,plot_scroll_right,plotlib_is_pgplot,& plot_shift_click,plot_lcur,plot_poly use params, only:int1,maxparttypes use part_utils, only:igettype use particleplots, only:plot_kernel_gr implicit none integer, intent(in) :: npart,icontour,ndim,iplotz,ivecx,ivecy,istep,ilaststep,iframe,nframes integer, intent(inout) :: irender,iColourBarStyle integer, intent(inout) :: iplotx,iploty,itrackpart,icolourscheme integer, intent(out) :: iadvance integer, dimension(npart), intent(inout) :: icolourpart real, dimension(npart), intent(in) :: xcoords,ycoords,zcoords,hi integer(kind=int1), dimension(:), intent(in) :: iamtype logical, dimension(maxparttypes), intent(in) :: usetype integer, dimension(maxparttypes), intent(in) :: npartoftype real, intent(inout) :: xmin,xmax,ymin,ymax,rendermin,rendermax,vecmax,contmin,contmax,taupartdepth real, intent(inout) :: anglex,angley,anglez,zslicepos,dzslice,zobserver,dscreen real, intent(in) :: renderminadapt,rendermaxadapt,contminadapt,contmaxadapt real, intent(in), dimension(ndim) :: xorigin character(len=*), intent(inout) :: labelrender logical, intent(inout) :: x_sec logical, intent(out) :: irerender,interactivereplot logical, intent(in) :: use3Dopacity, double_rendering real, parameter :: pi=3.141592653589 integer, parameter :: maxpts = 64 integer :: i,iclosest,ierr,ixsec,ishape,itype,npts integer :: nmarked,ncircpart,itrackparttemp,iadvancenew integer, dimension(1000) :: icircpart real :: xpt,ypt real :: xpt2,ypt2,xcen,ycen,xminwin,xmaxwin,yminwin,ymaxwin real :: xptmin,xptmax,yptmin,yptmax,zptmin,zptmax,rptmax2 real :: rmin,rr,gradient,yint,dx,dy,dr,anglerad real :: xlength,ylength,renderlength,renderpt,zoomfac real :: dxlength,dylength,xmaxin,ymaxin,contlength real, dimension(4) :: xline,yline real, dimension(maxpts) :: xpts,ypts character(len=1) :: char,char2 logical :: iexit, rotation, verticalbar, iamincolourbar, mixedtypes, use3Dperspective logical :: iadvanceset, leftclick, iselectpoly, iselectcircle logical, save :: print_help = .true. if (plot_qcur()) then if (.not.print_help) print*,'entering interactive mode...press h in plot window for help' !print*, plot_left_click else !print*,'cannot enter interactive mode: device has no cursor' return endif mixedtypes = size(iamtype).ge.npart use3Dperspective = abs(dscreen).gt.tiny(0.) iadvanceset = .false. char = 'A' xline = 0. yline = 0. ! !--convert saved cursor position (saved in viewport coords) ! back to coordinates ! call plot_qwin(xminwin,xmaxwin,yminwin,ymaxwin) call get_posxy(xcursor,ycursor,xpt,ypt,xminwin,xmaxwin,yminwin,ymaxwin) ! xpt = 0. ! ypt = 0. xpt2 = 0. ypt2 = 0. xmaxin = xmax ymaxin = ymax zoomfac = 1.0 ncircpart = 0 itrackparttemp = itrackpart iexit = .false. rotation = .false. irerender = .false. interactivereplot = .false. if (is_coord(iplotx,ndim) .and. is_coord(iploty,ndim) .and. ndim.ge.2) rotation = .true. verticalbar = barisvertical(iColourBarStyle) if (iplotz.gt.0 .and. x_sec) then zptmin = zslicepos - 0.5*dzslice zptmax = zslicepos + 0.5*dzslice else !--if not using z range, make it encompass all the particles zptmin = -huge(zptmin) zptmax = huge(zptmax) endif interactiveloop: do while (.not.iexit) if (print_help) then char = 'h' ierr = 0 print_help = .false. else ierr = plot_curs(xpt,ypt,char) endif ! !--exit if the device is not interactive ! if (ierr.eq.1) return !print*,'x,y = ',xpt,ypt,' function = ',char,iachar(char) ! !--find closest particle ! rmin = 1.e6 iclosest = 0 xlength = xmax - xmin ylength = ymax - ymin if (xlength.gt.tiny(xlength)) then dxlength = 1./xlength else dxlength = 0. endif if (ylength.gt.tiny(ylength)) then dylength = 1./ylength else dylength = 0. endif over_npart: do i=1,npart if (ntypes.gt.1) then if (mixedtypes) then itype = int(iamtype(i)) else itype = igettype(i,npartoftype) endif if (.not.usetype(itype)) cycle over_npart endif !--use distance normalised on screen rr = ((xcoords(i)-xpt)*dxlength)**2 + ((ycoords(i)-ypt)*dylength)**2 if (rr.lt.rmin) then iclosest = i rmin = rr endif enddo over_npart !--query the position of the colour bar iamincolourbar = incolourbar(iColourBarStyle,4,xpt,ypt,xmin,xmax,ymin,ymax) select case(char) ! !--particle plot stuff ! case('p') if (iclosest.gt.0 .and. iclosest.le.npart) then print*,' closest particle = ',iclosest,'x = ',xcoords(iclosest),' y =',ycoords(iclosest) call plot_number(iclosest,xcoords(iclosest),ycoords(iclosest)) else print*,'error: could not determine closest particle' endif case('c') if (iclosest.gt.0 .and. iclosest.le.npart) then print*,'plotting circle of interaction on particle ',iclosest, & ' h = ',hi(iclosest) !--save settings for these ncircpart = ncircpart + 1 if (ncircpart.gt.size(icircpart)) then print*,'WARNING: ncircles > array limits, cannot save' ncircpart = size(icircpart) else icircpart(ncircpart) = iclosest endif call plot_sfs(2) if (icoordsnew.ne.icoords) then call plot_kernel_gr(icoordsnew,icoords,xcoords(iclosest),ycoords(iclosest),2.*hi(iclosest)) else call plot_circ(xcoords(iclosest),ycoords(iclosest),2.*hi(iclosest)) endif else print*,'error: could not determine closest particle' endif case('t') !--track closest particle (must save to activate) if (itrackpart.ne.0 .and. itrackparttemp.eq.itrackpart) then itrackpart = 0 itrackparttemp = 0 print*,' particle tracking limits OFF' else if (iclosest.gt.0 .and. iclosest.le.npart) then itrackparttemp = iclosest call plot_number(iclosest,xcoords(iclosest),ycoords(iclosest)) print*,' limits set to track particle ',itrackparttemp,' x, y = ', & xcoords(iclosest),ycoords(iclosest) print*,' save settings to activate ' else print*,'error: could not determine closest particle' endif endif case('g') ! draw a line between two points xline(2) = xpt yline(2) = ypt !--mark first point call plot_pt1(xpt,ypt,4) !--select second point print*,' select another point (using left click or g) to plot line ' ierr = plot_band(1,1,xline(2),yline(2),xline(3),yline(3),char2) !--draw line if left click or g select case(char2) case(plot_left_click,'g') print* !--mark second point call plot_pt1(xline(3),yline(3),4) xlength = xline(3)-xline(2) if (abs(xlength).lt.tiny(xlength)) then xline(1) = xline(2) xline(4) = xline(2) yline(1) = ymin yline(4) = ymax print*,' error: gradient = infinite' elseif (xline(2).lt.xline(3)) then xline(1) = xmin xline(4) = xmax else xline(1) = xmax xline(4) = xmin endif ylength = yline(3)-yline(2) dr = sqrt(xlength**2 + ylength**2) print*,' (x1,y1) = (',xline(2),',',yline(2),')' print*,' (x2,y2) = (',xline(3),',',yline(3),')' print*,' dr = ',dr,' dx = ',xlength,' dy = ',ylength if (abs(xlength).gt.tiny(xlength)) then gradient = ylength/xlength yint = yline(3) - gradient*xline(3) print*,' gradient = ',gradient,' y intercept = ',yint yline(1) = gradient*xline(1) + yint yline(4) = gradient*xline(4) + yint endif !--plot line joining the two points call plot_line(4,xline,yline) case default print*,' action cancelled' end select ! !--help ! case('h') print "(/,a)",' -------------- interactive mode commands -----------------------------' print*,' SPACE BAR (or n) : skip to next timestep/file' print*,' 0,1,2,3..9 and click : go forward/back n timesteps (back=r.click)' print*,' left click (or A) : zoom/select' print*,' right click (or X or b) : previous timestep' print*,' shift+left click : IRREGULAR particle selection' print*,' left click on colour bar : change rendering limits' print*,' +/- : zoom IN/OUT (_ for out by 20%) ' print*,' a : (a)dapt plot limits (inside box, over axes or colour bar)' print*,' l : (l)og / unlog axis (over x/y axis or colour bar)' print*,' o/C : re-centre plot on (o)rigin/(C)ursor position' print*,' backspace: delete annotation (over axes, legend, title or colour bar)' print*,' r : (r)eplot current plot' print*,' R : (R)eset/remove all range restrictions' print*,' p/c : label closest (p)article/plot (c)ircle of interaction' print*,' t : t)rack closest particle/turn tracking off (coord plots only)' print*,' g : plot a line and find its g)radient' print*,' ctrl-t : add text annotation at current position' print*,' G/T/H : move le(G)end, (T)itle or (H) vector legend to current position' print*,' m/M/i : change colour map (m=next,M=previous,i=invert) (rendered plots only)' print*,' v/V/w : decrease/increase/adapt arrow size on vector plots (Z for x10)' if (ndim.ge.3) then print*,' k/K : decrease/increase opacity on opacity-rendered plots (Z for x10)' endif print*,' e/E : use current frame/settings as end point to animation sequence' if (ndim.gt.1) then print*,' , . < > : rotate about z axis by +(-) 15,30 degrees (coord plots only)' if (ndim.ge.3) then print*,' [ ] { } : rotate about x axis by +/- 15,30 degrees (coord plots only)' print*,' / \ ? | : rotate about y axis by +/- 15,30 degrees (coord plots only)' print*,' x : take cross section (coord plots only)' if (iplotz.gt.0) then print*,' u/U/d/D : move cross section/perspective pos. up/down (towards/away from observer)' endif endif endif print*,' s : (s)ave current settings for all steps' print*,' q/Q/esc : (q)uit plotting' print*,' z/Z(oom) : timestepping, zoom and limits-changing multiplied by 10' print*,'----------------------------------------------------------------------' case('s','S') itrackpart = itrackparttemp if (itrackpart.eq.0) then call save_limits(iplotx,xmin,xmax) call save_limits(iploty,ymin,ymax) call save_itrackpart_recalcradius(itrackpart) ! set saved value to zero else print*,'tracking particle ',itrackpart,'x,y = ',xcoords(itrackpart),ycoords(itrackpart) if (is_coord(iplotx,ndim)) call save_limits_track(iplotx,xmin,xmax,xcoords(itrackpart)) if (is_coord(iploty,ndim)) call save_limits_track(iploty,ymin,ymax,ycoords(itrackpart)) call save_itrackpart_recalcradius(itrackpart) endif if (irender.gt.0) call save_limits(irender,rendermin,rendermax) if (icontour.gt.0) then if (icontour.eq.irender & .and. abs(rendermin-contmin).le.tiny(0.) & .and. abs(rendermax-contmax).le.tiny(0.)) then call reset_limits2(icontour) elseif (icontour.eq.irender .and. .not.double_rendering) then call save_limits(icontour,contmin,contmax,setlim2=.true.) else call save_limits(icontour,contmin,contmax) endif endif if (ivecx.gt.0 .and. ivecy.gt.0) then call save_limits(ivecx,-vecmax,vecmax) call save_limits(ivecy,-vecmax,vecmax) endif if (ndim.eq.3 .and. iplotz.gt.0 .and. irender.gt.0 .and. use3Dopacity) then call save_opacity(taupartdepth) endif if (ncircpart.gt.0) call save_circles(ncircpart,icircpart) if (rotation) call save_rotation(ndim,anglex,angley,anglez) if (iplotz.gt.0) then if (x_sec) then call save_xsecpos(zslicepos,x_sec) else call save_perspective(zobserver,dscreen) endif endif print*,'> interactively set limits saved <' ! !--actions on left click ! case(plot_left_click,plot_right_click,plot_shift_click) ! left click ! !--change colour bar limits ! leftclick = (char == plot_left_click) ishape = inshape(xpt,ypt,itrans(iplotx),itrans(iploty)) if (ishape.gt.0) then call edit_shape(ishape,xpt,ypt,itrans(iplotx),itrans(iploty)) iadvance = 0 interactivereplot = .true. iexit = .true. elseif (iamincolourbar .and. irender.gt.0 .and. leftclick) then if (incolourbarlabel(iColourBarStyle,4,xpt,ypt,xmin,xmax,ymin,ymax)) then if (verticalbar) then call edit_textbox(xpt,ypt,90.,labelrender) projlabelformat = trim(labelrender) iapplyprojformat = irender else call edit_textbox(xpt,ypt,0.,labelrender) projlabelformat = trim(labelrender) iapplyprojformat = irender endif iadvance = 0 interactivereplot = .true. iexit = .true. else print*,'click to set rendering limits' if (verticalbar) then ierr = plot_band(3,1,xpt,ypt,xpt2,ypt2,char2) else ierr = plot_band(4,1,xpt,ypt,xpt2,ypt2,char2) endif if (char2 == plot_left_click) then if (double_rendering) then call adjustcolourbar(iColourBarStyle,xpt,ypt,xpt2,ypt2,& xmin,xmax,ymin,ymax,contmin,contmax) print*,'setting doublerender min = ',contmin print*,'setting doublerender max = ',contmax else call adjustcolourbar(iColourBarStyle,xpt,ypt,xpt2,ypt2,& xmin,xmax,ymin,ymax,rendermin,rendermax) print*,'setting render min = ',rendermin print*,'setting render max = ',rendermax endif iadvance = 0 interactivereplot = .true. iexit = .true. endif endif ! !--zoom or mark particles ! else print*,'select area: ' !--Note: circle selection is not implemented in PGPLOT iselectpoly = (char==plot_shift_click .or.((.not.leftclick).and.plotlib_is_pgplot)) iselectcircle = (char==plot_right_click .and. .not.plotlib_is_pgplot) if (iselectpoly) then if (plotlib_is_pgplot) then print*,'left click/a)dd points; middle click/d)elete points; X/x)finish' else print*,'left click/a)dd points; middle click/d)elete points; q)uit/abort' if (irender.le.0) print*,'1-9 = close polygon and mark particles with colours 1-9' print*,'0 = close polygon and hide selected particles' print*,'p = close polygon and plot selected particles only' print*,'c = close polygon and plot circles of interaction on selected parts' endif else print*,'left click : zoom' if (irender.le.0) print*,'1-9 = mark selected particles with colours 1-9' print*,'0 = hide selected particles' print*,'p = plot selected particles only' print*,'c = plot circles of interaction on selected parts' endif if (leftclick .or. iselectcircle) then print*,'x = use particles within x parameter range only' print*,'y = use particles within y parameter range only' print*,'r = use particles within x and y parameter range only' print*,'R = remove all range restrictions' endif npts = 1 xpts(1) = xpt ! to avoid problems with uninitialised variables ypts(1) = ypt if (iselectpoly) then call plot_lcur(maxpts,npts,xpts,ypts,char2) if (plotlib_is_pgplot) then if (irender.le.0) print*,'1-9 = close polygon and mark particles with colours 1-9' print*,'0 = close polygon and hide selected particles' print*,'p = close polygon and plot selected particles only' print*,'c = close polygon and plot circles of interaction on selected parts' ierr = plot_band(0,1,xpt,ypt,xpt2,ypt2,char2) endif xptmin = minval(xpts(1:npts)) xptmax = maxval(xpts(1:npts)) yptmin = minval(ypts(1:npts)) yptmax = maxval(ypts(1:npts)) elseif (iselectcircle) then ierr = plot_band(8,1,xpt,ypt,xpt2,ypt2,char2) rptmax2 = (xpt2-xpt)**2 + (ypt2-ypt)**2 rr = sqrt(rptmax2) xptmin = xpt - rr xptmax = xpt + rr yptmin = ypt - rr yptmax = ypt + rr else ! left click: rectangle selection ierr = plot_band(2,1,xpt,ypt,xpt2,ypt2,char2) xptmin = min(xpt,xpt2) xptmax = max(xpt,xpt2) yptmin = min(ypt,ypt2) yptmax = max(ypt,ypt2) endif if (.not.(iselectcircle.or.iselectpoly) .or. char2==plot_left_click) then ! rectangle selection print*,'xrange = ',xptmin,'->',xptmax print*,'yrange = ',yptmin,'->',yptmax if (iplotz.ne.0 .and. x_sec) then print*,'(zrange = ',zptmin,'->',zptmax,')' endif endif select case (char2) case(plot_left_click) ! zoom if another left click call plot_sfs(2) !--draw the selected shape in case zooming is slow if (iselectpoly) then call plot_poly(npts,xpts,ypts) elseif (iselectcircle) then call plot_circ(xpt,ypt,sqrt(rptmax2)) else call plot_rect(xpt,xpt2,ypt,ypt2) endif !--zoom is identical for rectangle, poly and circle selection xmin = xptmin xmax = xptmax ymin = yptmin ymax = yptmax iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. case('0','1','2','3','4','5','6','7','8','9') ! mark particles nmarked = 0 if (irender.le.0 .or. char2.eq.'0' .or. char2.eq.'1') then do i=1,npart if (inslice(zcoords(i),zptmin,zptmax) .and. & (leftclick .and. inrectangle(xcoords(i),ycoords(i),xptmin,xptmax,yptmin,yptmax) & .or.(iselectcircle .and. incircle(xcoords(i)-xpt,ycoords(i)-ypt,rptmax2)) & .or.(iselectpoly .and. inpoly(xcoords(i),ycoords(i),xpts,ypts,npts)))) then read(char2,*,iostat=ierr) icolourpart(i) if (ierr /=0) then print*,'*** error marking particle' icolourpart(i) = 1 !--translate 0 to icolourpart = -1 for non-plotted particles elseif (icolourpart(i).eq.0) then icolourpart(i) = -1 endif nmarked = nmarked + 1 endif enddo print*,'marked ',nmarked,' particles in selected region' endif iadvance = 0 if (nmarked.gt.0) irerender = .true. interactivereplot = .true. iexit = .true. case('p') ! plot selected particles only nmarked = 0 do i=1,npart if (inslice(zcoords(i),zptmin,zptmax) .and. & (leftclick .and. inrectangle(xcoords(i),ycoords(i),xptmin,xptmax,yptmin,yptmax) & .or.(iselectcircle .and. incircle(xcoords(i)-xpt,ycoords(i)-ypt,rptmax2)) & .or.(iselectpoly .and. inpoly(xcoords(i),ycoords(i),xpts,ypts,npts)))) then nmarked = nmarked + 1 if (icolourpart(i).le.0) icolourpart(i) = 1 else icolourpart(i) = -1 endif enddo print*,'plotting selected ',nmarked,' particles only' iadvance = 0 irerender = .true. interactivereplot = .true. iexit = .true. case('c') ! set circles of interaction in marked region ncircpart = 0 do i=1,npart if (inslice(zcoords(i),zptmin,zptmax) .and. & (leftclick .and. inrectangle(xcoords(i),ycoords(i),xptmin,xptmax,yptmin,yptmax) & .or.(iselectcircle .and. incircle(xcoords(i)-xpt,ycoords(i)-ypt,rptmax2)) & .or.(iselectpoly .and. inpoly(xcoords(i),ycoords(i),xpts,ypts,npts)))) then if (ncircpart.lt.size(icircpart)) then ncircpart = ncircpart + 1 icircpart(ncircpart) = i call plot_sfs(2) call plot_circ(xcoords(i),ycoords(i),2.*hi(i)) endif endif enddo print*,'set ',ncircpart,' circles of interaction in selected region' if (ncircpart.eq.size(icircpart)) print*,' (first ',size(icircpart),' only)' case('x') call restrict_range(iplotx,xptmin,xptmax) iadvance = 0 irerender = .true. interactivereplot = .true. iexit = .true. case('y') call restrict_range(iploty,yptmin,yptmax) iadvance = 0 irerender = .true. interactivereplot = .true. iexit = .true. case('r') call restrict_range(iplotx,xptmin,xptmax) call restrict_range(iploty,yptmin,yptmax) iadvance = 0 irerender = .true. interactivereplot = .true. iexit = .true. case('R') call reset_ranges iadvance = 0 irerender = .true. interactivereplot = .true. iexit = .true. case default print*,' action cancelled' end select endif ! !--zooming ! case('-','_','+','o','C') ! zoom in/out xlength = xmax - xmin ylength = ymax - ymin xcen = 0.5*(xmax + xmin) ycen = 0.5*(ymax + ymin) renderlength = rendermax - rendermin contlength = contmax - contmin select case(char) case('-') xlength = 1.1*zoomfac*xlength ylength = 1.1*zoomfac*ylength renderlength = 1.1*zoomfac*renderlength contlength = 1.1*zoomfac*contlength case('_') xlength = 1.2*zoomfac*xlength ylength = 1.2*zoomfac*ylength renderlength = 1.2*zoomfac*renderlength contlength = 1.2*zoomfac*contlength case('+') xlength = xlength/(1.1*zoomfac) ylength = ylength/(1.1*zoomfac) renderlength = renderlength/(1.1*zoomfac) contlength = contlength/(1.1*zoomfac) case('o') if (itrackpart.gt.0) then print*,'centreing limits on tracked particle ',itrackpart,'x,y = ',xcoords(itrackpart),ycoords(itrackpart) xcen = xcoords(itrackpart) ycen = ycoords(itrackpart) else if (is_coord(iplotx,ndim)) then xcen = xorigin(iplotx) else xcen = 0. endif if (is_coord(iploty,ndim)) then ycen = xorigin(iploty) else ycen = 0. endif print*,' centreing plot on origin x,y = ',xcen,ycen endif case('C') xcen = xpt ycen = ypt end select if (iamincolourbar .and. irender.gt.0) then !--rendering zoom does not allow pan - renderpt is always centre of axis if (double_rendering) then renderpt = 0.5*(contmin + contmax) contmin = renderpt - 0.5*contlength contmax = renderpt + 0.5*contlength call assert_sensible_limits(contmin,contmax) print*,'zooming on colour bar: min, max = ',contmin,contmax else renderpt = 0.5*(rendermin + rendermax) rendermin = renderpt - 0.5*renderlength rendermax = renderpt + 0.5*renderlength call assert_sensible_limits(rendermin,rendermax) print*,'zooming on colour bar: min, max = ',rendermin,rendermax endif iadvance = 0 interactivereplot = .true. iexit = .true. else if (xpt.ge.xmin .and. xpt.le.xmax .and. ypt.le.ymaxin) then xmin = xcen - 0.5*xlength xmax = xcen + 0.5*xlength call assert_sensible_limits(xmin,xmax) print*,'zooming on x axis: min, max = ',xmin,xmax iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif if (ypt.ge.ymin .and. ypt.le.ymax .and. xpt.le.xmaxin) then ymin = ycen - 0.5*ylength ymax = ycen + 0.5*ylength call assert_sensible_limits(ymin,ymax) print*,'zooming on y axis: min, max = ',ymin,ymax iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif endif if (char.eq.'o') then xpt = xcen ypt = ycen endif case('a') ! reset plot limits if (iamincolourbar .and. irender.gt.0) then if (double_rendering) then contmin = contminadapt contmax = contmaxadapt call assert_sensible_limits(contmin,contmax) else rendermin = renderminadapt rendermax = rendermaxadapt call assert_sensible_limits(rendermin,rendermax) endif iadvance = 0 ! that it should change the render limits interactivereplot = .true. iexit = .true. else xmaxin = xmax ymaxin = ymax if (xpt.ge.xmin .and. xpt.le.xmax .and. ypt.le.ymaxin) then call adapt_limits_interactive('x',npart,xcoords,xmin,xmax,icolourpart,iamtype,usetype) iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif if (ypt.ge.ymin .and. ypt.le.ymax .and. xpt.le.xmaxin) then call adapt_limits_interactive('y',npart,ycoords,ymin,ymax,icolourpart,iamtype,usetype) iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif endif ! !--zoom in/out on vector plots (arrow size) ! case('v') if (ivecx.gt.0 .and. ivecy.gt.0) then print*,'decreasing vector arrow size' vecmax = 1.2*zoomfac*vecmax iadvance = 0 interactivereplot = .true. iexit = .true. endif case('V') if (ivecx.gt.0 .and. ivecy.gt.0) then print*,'increasing vector arrow size' vecmax = vecmax/(1.2*zoomfac) iadvance = 0 interactivereplot = .true. iexit = .true. endif case('w','W') if (ivecx.gt.0 .and. ivecy.gt.0) then print*,'adapting vector arrow size' vecmax = -1.0 iadvance = 0 interactivereplot = .true. iexit = .true. endif ! !--change opacity on 3D opacity rendered plots ! case('k') if (ndim.eq.3 .and. iplotz.gt.0 .and. irender.ne.0 .and. use3Dopacity) then print*,'decreasing opacity by factor of ',1.5*zoomfac !--opacity goes like 1/taupartdepth taupartdepth = 1.5*zoomfac*taupartdepth iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('K') if (ndim.eq.3 .and. iplotz.gt.0 .and. irender.ne.0 .and. use3Dopacity) then print*,'increasing opacity by factor of ',1.5*zoomfac !--opacity goes like 1/taupartdepth taupartdepth = taupartdepth/(1.5*zoomfac) iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif ! !--set/unset log axes ! case('l') ! !--change colour bar, y and x itrans between log / not logged ! if (iamincolourbar .and. irender.gt.0) then if (double_rendering) then !call change_itrans(irender,rendermin,rendermax) call change_itrans(icontour,contmin,contmax) else if (icontour.eq.irender) then call change_itrans2(irender,rendermin,rendermax,contmin,contmax) else call change_itrans(irender,rendermin,rendermax) endif endif iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. elseif (xpt.lt.xmin) then if (is_coord(iploty,ndim) .and. irender.gt.0) then print "(a)",'error: cannot log coordinate axes with rendering' else call change_itrans(iploty,ymin,ymax) iadvance = 0 interactivereplot = .true. iexit = .true. endif elseif (ypt.lt.ymin) then if (is_coord(iplotx,ndim) .and. irender.gt.0) then print "(a)",'error: cannot log coordinate axes with rendering' else call change_itrans(iplotx,xmin,xmax) iadvance = 0 interactivereplot = .true. iexit = .true. endif endif ! !--reset all range restrictions ! case('R') call reset_ranges iadvance = 0 interactivereplot = .true. iexit = .true. ! !--save as end point of animation sequence ! case('e','E') call setsequenceend(istep,iplotx,iploty,irender,rotation, & anglex,angley,anglez,zobserver,use3Dopacity,taupartdepth, & x_sec,zslicepos,xmin,xmax,ymin,ymax,rendermin,rendermax) ! !--rotation ! case(',') if (rotation) then print*,'changing z rotation angle by -15 degrees...' anglez = anglez - 15. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('<') if (rotation) then print*,'changing z rotation angle by -30 degrees...' anglez = anglez - 30. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('.') if (rotation) then print*,'changing z rotation angle by 15 degrees...' anglez = anglez + 15. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('>') if (rotation) then print*,'changing z rotation angle by 30 degrees...' anglez = anglez + 30. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('/') if (rotation .and. ndim.ge.2) then print*,'changing y rotation angle by -15 degrees...' angley = angley - 15. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('?') if (rotation .and. ndim.ge.2) then print*,'changing y rotation angle by -30 degrees...' angley = angley - 30. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('\') if (rotation .and. ndim.ge.2) then print*,'changing y rotation angle by 15 degrees...' angley = angley + 15. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('|') if (rotation .and. ndim.ge.2) then print*,'changing y rotation angle by 30 degrees...' angley = angley + 30. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('[') if (rotation .and. ndim.ge.3) then print*,'changing x rotation angle by -15 degrees...' anglex = anglex - 15. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('{') if (rotation .and. ndim.ge.3) then print*,'changing x rotation angle by -30 degrees...' anglex = anglex - 30. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case(']') if (rotation .and. ndim.ge.3) then print*,'changing x rotation angle by 15 degrees...' anglex = anglex + 15. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('}') if (rotation .and. ndim.ge.3) then print*,'changing x rotation angle by 30 degrees...' anglex = anglex + 30. iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif ! !--set cross section position ! case('x') if (rotation .and. ndim.ge.3) then xline(1) = xpt yline(1) = ypt !--work out which is the third dimension do i=1,3 if (i.ne.iplotx .and. i.ne.iploty) ixsec = i enddo print*,' select cross section position (using left click or x)' ierr = plot_band(1,1,xline(1),yline(1),xline(2),yline(2),char2) !--work out cross section if left click or x again select case(char2) case(plot_left_click,'x') !--plot the cross section line call plot_line(2,xline(1:2),yline(1:2)) !--work out angle with the x axis ! and offset of line from origin dx = xline(2) - xline(1) dy = yline(2) - yline(1) anglerad = ATAN2(dy,dx) select case(ixsec) case(1) anglex = 180.*anglerad/pi + anglex print*,'setting angle x = ',anglex case(2) angley = 180.*anglerad/pi + angley print*,'setting angle y = ',angley case(3) anglez = 180.*anglerad/pi + anglez print*,'setting angle z = ',anglez end select iploty = ixsec !--work out offset of cross section line ! y intercept yint = yline(2) - (dy/dx)*xline(2) zslicepos = yint/COS(anglerad) !--if we are in column density mode, change back to cross-section mode x_sec = .true. print*,'iploty = ',ixsec, ' xsecpos = ',zslicepos iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. case default print*,' action cancelled' end select endif ! !--cross sections ! case('u') ! move cross section up by dxsec if (iplotz.gt.0 .and. ndim.eq.3) then if (x_sec) then print*,'shifting cross section position up by ',dzslice zslicepos = zslicepos + dzslice iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. elseif (use3Dperspective) then if (abs(zobserver).lt.tiny(0.)) then print*,'resetting z position' zobserver = 1. else print*,'shifting perspective position up by 20%' zobserver = 1.2*zobserver endif iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif endif case('U') ! move cross section up by 2*dxsec if (iplotz.gt.0 .and. ndim.eq.3) then if (x_sec) then print*,'shifting cross section position up by ',2.*dzslice zslicepos = zslicepos + 2.*dzslice iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. elseif (use3Dperspective) then if (abs(zobserver).lt.tiny(0.)) then print*,'resetting z position' zobserver = 1. else print*,'shifting perspective position up by factor of 2' zobserver = 2.*zobserver endif iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif endif case('d') ! move cross section down by dxsec if (iplotz.gt.0 .and. ndim.eq.3) then if (x_sec) then print*,'shifting cross section position down by ',dzslice zslicepos = zslicepos - dzslice elseif (use3Dperspective) then if (abs(zobserver).lt.tiny(0.)) then print*,'resetting z position' zobserver = 1. else print*,'shifting perspective position down by 20%' zobserver = zobserver/1.2 endif endif iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif case('D') ! move cross section down by 2*dxsec if (iplotz.gt.0 .and. ndim.eq.3) then if (x_sec) then print*,'shifting cross section position down by ',2.*dzslice zslicepos = zslicepos - 2.*dzslice elseif (use3Dperspective) then if (abs(zobserver).lt.tiny(0.)) then print*,'resetting z position' zobserver = 1. else print*,'shifting perspective position down by factor of 2' zobserver = zobserver/2. endif endif iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. endif ! !--general plot stuff ! case('G') ! move legend here print*,'setting legend position to current location...' call mvlegend(xpt,ypt,xmin,xmax,ymax) iadvance = 0 interactivereplot = .true. iexit = .true. case('T') ! move title here print*,'setting title position to current location...' call mvtitle(xpt,ypt,xmin,xmax,ymax) iadvance = 0 interactivereplot = .true. iexit = .true. case('H') ! move vector legend here if (ivecx.gt.0 .and. ivecy.gt.0) then print*,'setting vector plot legend to current location...' call mvlegendvec(xpt,ypt,xmin,xmax,ymax) endif iadvance = 0 interactivereplot = .true. iexit = .true. case('f') ! change rendered quantity (next) if (irender.ne.0 .and. ndim.gt.0) then irender = irender + 1 if (irender.gt.ndataplots) irender = 1 if (is_coord(irender,ndim)) irender = ix(ndim) + 1 !if (irender.eq.ndataplots+1) irender = 0 iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. else print*,'ERROR: f has no effect if not rendering' endif case('F') ! change rendered quantity (previous) if (irender.ne.0 .and. ndim.gt.0) then irender = irender - 1 if (is_coord(irender,ndim)) irender = ix(1) - 1 if (irender.lt.1) irender = ndataplots !if (irender.eq.ndim) irender = 0 iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. else print*,'ERROR: F has no effect if not rendering' endif case('m') ! change colour map (next scheme) !call set_movie_mode() call change_colourmap(icolourscheme,1) iadvance = 0 interactivereplot = .true. iexit = .true. case('M') ! change colour map (previous scheme) call change_colourmap(icolourscheme,-1) iadvance = 0 interactivereplot = .true. iexit = .true. case('i') ! invert colour map icolourscheme = -icolourscheme call change_colourmap(icolourscheme,0) iadvance = 0 interactivereplot = .true. iexit = .true. case(achar(20)) ! add text shape call add_textshape(xpt,ypt,itrans(iplotx),itrans(iploty),0,ierr) if (ierr.eq.0) then iadvance = 0 interactivereplot = .true. iexit = .true. endif case(achar(8)) ! delete plot annotation / colour bar (backspace) ishape = inshape(xpt,ypt,itrans(iplotx),itrans(iploty)) if (ishape.gt.0) then call delete_shape(ishape,nshapes) iadvance = 0 interactivereplot = .true. iexit = .true. elseif (iamincolourbar .and. irender.gt.0) then iColourBarStyle = 0 iadvance = 0 interactivereplot = .true. iexit = .true. elseif (xpt.lt.xmin .or. xpt.gt.xmax .or. ypt.lt.ymin .or. ypt.gt.ymax) then call deleteaxes() iadvance = 0 interactivereplot = .true. iexit = .true. else print*,' nothing to delete at x,y =',xpt,',',ypt endif ! !--timestepping ! case('q','Q',achar(27),achar(3)) iadvance = -666 print*,'quitting...' iexit = .true. case('b','B',plot_scroll_left) ! right click -> go back iadvance = -abs(iadvance) iexit = .true. case('r') ! replot iadvance = 0 interactivereplot = .true. irerender = .true. iexit = .true. case(' ','n','N',plot_scroll_right) ! space iadvance = abs(iadvance) iexit = .true. case('0','1','2','3','4','5','6','7','8','9') read(char,*,iostat=ierr) iadvancenew if (ierr /=0) then print*,'*** internal error setting timestep jump' iadvancenew = 1 endif if ((iadvance.gt.1 .or. iadvanceset) .and. iadvance.le.9999) then iadvance = 10*iadvance + iadvancenew if (iadvance.gt.9999) iadvance = 1 elseif (iadvancenew.eq.0) then iadvance = 10 else iadvance = iadvancenew endif iadvance = int(zoomfac*iadvance) print*,' setting timestep jump = ',iadvance iadvanceset = .true. case(')') iadvance = int(zoomfac*10) print*,' setting timestep jump = ',iadvance ! !--multiply everything by a factor of 10 ! case('z','Z') zoomfac = 10.*zoomfac if (zoomfac.gt.1000000.) then zoomfac = 1.0 endif print*,' LIMITS/TIMESTEPPING CHANGES NOW x ',zoomfac ! !--unknown ! case default if (iachar(char).ge.iachar('a')) then print*,' x, y = ',xpt,ypt,'; unknown option "',trim(char), '" ',iachar(char) endif end select ! !--save cursor position relative to the viewport ! call plot_qwin(xminwin,xmaxwin,yminwin,ymaxwin) call get_vptxy(xpt,ypt,xcursor,ycursor) if (rotation) then if (anglez.ge.360.) anglez = anglez - 360. if (anglez.lt.0.) anglez = anglez + 360. if (ndim.gt.2) then if (angley.ge.360.) angley = angley - 360. if (angley.lt.0.) angley = angley + 360. if (anglex.ge.360.) anglex = anglex - 360. if (anglex.lt.0.) anglex = anglex + 360. endif endif ! !--do not let timestep go outside of bounds ! if we are at the first/last step, just print message and do nothing ! if iadvance trips over the bounds, jump to last/first step ! if (iadvance.ne.-666 .and. iexit) then if (istep + iadvance .gt. ilaststep .and. iframe.eq.nframes) then print "(1x,a)",'reached last timestep' if (ilaststep-istep .gt.0) then iadvance= ilaststep - istep else iexit = .false. endif elseif (istep + iadvance .lt. 1 .and. iframe.eq.1) then print "(1x,a)",'reached first timestep: can''t go back' if (1-istep .lt.0) then iadvance= 1 - istep else iexit = .false. endif endif endif enddo interactiveloop return end subroutine interactive_part ! ! cut down version of interactive mode -> controls timestepping only ! used in powerspectrum / extra plots ! THIS IS NOW LARGELY OBSOLETE (superseded by interactive_multi) ! AND WILL BE REMOVED IN FUTURE VERSIONS ! subroutine interactive_step(iadvance,istep,ilaststep,xmin,xmax,ymin,ymax,interactivereplot) use plotlib, only:plot_qcur,plot_curs,plot_band,plot_rect,plot_left_click implicit none integer, intent(inout) :: iadvance integer, intent(in) :: istep,ilaststep real, intent(inout) :: xmin,xmax,ymin,ymax logical, intent(out) :: interactivereplot integer :: ierr real :: xpt,ypt,xpt2,ypt2 real :: xlength, ylength, zoomfac character(len=1) :: char,char2 logical :: iexit if (plot_qcur()) then print*,'entering interactive mode...press h in plot window for help' else !print*,'cannot enter interactive mode: device has no cursor' return endif char = 'A' xpt = 0. ypt = 0. zoomfac = 1.0 iexit = .false. interactivereplot = .false. do while (.not.iexit) ierr = plot_curs(xpt,ypt,char) ! !--exit if the device is not interactive ! if (ierr.eq.1) return print*,'x, y = ',xpt,ypt,' function = ',char select case(char) case('h') print*,'-------------- interactive mode commands --------------' print*,' select area and zoom : left click (or A)' print*,' zoom in by 10% : +' print*,' zoom out by 10(20)% : - (_)' print*,' (r)eplot current plot : r' print*,' next timestep/plot : space, n' print*,' previous timestep : right click (or X), b' print*,' jump forward (back) by n timesteps : 0,1,2,3..9 then left (right) click' print*,' G : move legend to current position' print*,' T : move title to current position' print*,' (h)elp : h' print*,' (q)uit plotting : q, Q, esc' print*,'-------------------------------------------------------' case(plot_left_click) ! left click ! !--draw rectangle from the point and reset the limits ! print*,'select area: ' print*,'left click : zoom' ierr = plot_band(2,1,xpt,ypt,xpt2,ypt2,char2) print*,xpt,ypt,xpt2,ypt2,char2 select case (char2) case(plot_left_click) ! zoom if another left click call plot_rect(xpt,xpt2,ypt,ypt2) xmin = min(xpt,xpt2) xmax = max(xpt,xpt2) ymin = min(ypt,ypt2) ymax = max(ypt,ypt2) iadvance = 0 interactivereplot = .true. iexit = .true. case default print*,' action cancelled' end select ! !--zooming ! case('-','_','+','o') ! zoom out by 10 or 20% xlength = xmax - xmin ylength = ymax - ymin select case(char) case('-') xlength = 1.1*zoomfac*xlength ylength = 1.1*zoomfac*ylength case('_') xlength = 1.2*zoomfac*xlength ylength = 1.2*zoomfac*ylength case('+') xlength = 0.9/zoomfac*xlength ylength = 0.9/zoomfac*ylength case('o') !--reset cursor to origin xpt = 0. ypt = 0. end select if (xpt.ge.xmin .and. xpt.le.xmax .and. ypt.le.ymax) then print*,'zooming on x axis' xmin = xpt - 0.5*xlength xmax = xpt + 0.5*xlength iadvance = 0 interactivereplot = .true. iexit = .true. endif if (ypt.ge.ymin .and. ypt.le.ymax .and. xpt.le.xmax) then print*,'zooming on y axis' ymin = ypt - 0.5*ylength ymax = ypt + 0.5*ylength iadvance = 0 interactivereplot = .true. iexit = .true. endif ! !--general plot stuff ! case('G') ! move legend here print*,'setting legend position to current location...' call mvlegend(xpt,ypt,xmin,xmax,ymax) case('T') ! move title here print*,'setting title position to current location...' call mvtitle(xpt,ypt,xmin,xmax,ymax) ! !--timestepping ! case('q','Q',achar(27),achar(3)) iadvance = -666 print*,'quitting...' iexit = .true. case('X','b','B') ! right click -> go back iadvance = -abs(iadvance) iexit = .true. case('r','R') ! replot iadvance = 0 interactivereplot = .true. iexit = .true. case(' ','n','N') ! space iadvance = abs(iadvance) iexit = .true. case('0','1','2','3','4','5','6','7','8','9') read(char,*,iostat=ierr) iadvance if (ierr /=0) then print*,'*** internal error setting timestep jump' iadvance = 1 endif iadvance = int(zoomfac*iadvance) print*,' setting timestep jump = ',iadvance case(')') iadvance = int(zoomfac*10) print*,' setting timestep jump = ',iadvance ! !--multiply everything by a factor of 10 ! case('z','Z') zoomfac = 10.*zoomfac if (zoomfac.gt.1000000.) then zoomfac = 1.0 endif print*,' LIMITS/TIMESTEPPING CHANGES NOW x ',zoomfac ! !--unknown ! case default print*,' x, y = ',xpt,ypt,'; unknown option "',trim(char), '" ',iachar(char) end select ! !--do not let timestep go outside of bounds ! if we are at the first/last step, just print message and do nothing ! if iadvance trips over the bounds, jump to last/first step ! if (iadvance.ne.-666 .and. iexit) then if (istep + iadvance .gt. ilaststep) then print "(1x,a)",'reached last timestep' if (ilaststep-istep .gt.0) then iadvance= ilaststep - istep else iexit = .false. endif elseif (istep + iadvance .lt. 1) then print "(1x,a)",'reached first timestep: can''t go back' if (1-istep .lt.0) then iadvance= 1 - istep else iexit = .false. endif endif endif enddo return end subroutine interactive_step ! ! interactive mode for multiple plots per page - requires determination of which plot/panel ! a mouse-click refers to from stored settings for the viewport and limits for each plot. ! (this could be made into the only subroutine required) ! subroutine interactive_multi(iadvance,istep,ifirststeponpage,ilaststep,iframe,ifirstframeonpage,nframes, & lastpanel,iplotxarr,iplotyarr,irenderarr,icontourarr,ivecarr,& use_double_rendering,xmin,xmax,vptxmin,vptxmax,vptymin,vptymax, & barwmulti,xminadapt,xmaxadapt,nacross,ndim,xorigin,icolourscheme, & iColourBarStyle,interactivereplot) use labels, only:is_coord,iamvec use limits, only:assert_sensible_limits use multiplot, only:itrans use shapes, only:add_textshape,inshape,edit_shape,delete_shape,nshapes use plotlib, only:plot_qcur,plot_band,plot_qwin,plot_pt1,plot_curs,plot_line,plot_left_click implicit none integer, intent(inout) :: iadvance integer, intent(inout) :: istep,iframe,lastpanel,iColourBarStyle integer, intent(in) :: ifirststeponpage,ilaststep,nacross,ndim,ifirstframeonpage,nframes integer, intent(inout) :: icolourscheme integer, intent(in), dimension(:) :: iplotxarr,iplotyarr,irenderarr,icontourarr,ivecarr real, dimension(:), intent(in) :: vptxmin,vptxmax,vptymin,vptymax,barwmulti real, dimension(:), intent(inout) :: xmin,xmax,xminadapt,xmaxadapt real, intent(in), dimension(ndim) :: xorigin logical, intent(in) :: use_double_rendering logical, intent(out) :: interactivereplot integer :: ierr,ipanel,ipanel2,istepin,istepnew,i,istepjump,istepsonpage,ishape integer :: istepjumpnew,ivecx,ivecy real :: xpt,ypt,xpt2,ypt2,xpti,ypti,renderpt,xptmin,xptmax,yptmin,yptmax real :: xlength,ylength,renderlength,contlength,zoomfac real :: vptxi,vptyi,vptx2i,vpty2i,vptxceni,vptyceni real :: xmini,xmaxi,ymini,ymaxi,xcen,ycen,gradient,dr,yint,xmaxin real, dimension(4) :: xline,yline character(len=1) :: char,char2 logical :: iexit,iamincolourbar,verticalbar,double_render,istepjumpset logical, save :: print_help = .true. if (plot_qcur()) then if (.not.print_help) print*,'entering interactive mode...press h in plot window for help' else !print*,'cannot enter interactive mode: device has no cursor' return endif char = 'A' zoomfac = 1.0 xpt2 = 0. ypt2 = 0. verticalbar = barisvertical(iColourBarStyle) ! !--convert saved cursor position (saved in viewport coords) ! back to world coordinates: ! !--query window limits in world coords call plot_qwin(xmini,xmaxi,ymini,ymaxi) !--determine which plot the cursor falls on !print*,' saved xcursor,ycursor = ',xcursor,ycursor,vptxmin,vptxmax,vptymin,vptymax ipanel = getpanel(xcursor,ycursor) !print*,' saved panel = ',ipanel !--set the window to correspond to the panel we last left the cursor in call set_panel(ipanel) !--set the position in x,y relative to this panel call getxy(xcursor,ycursor,xpt,ypt,ipanel) !print*,' saved x,y = ',xpt,ypt call get_vptxy(xpt,ypt,vptxi,vptyi) !print*,'saved vptx,y = ',vptxi,vptyi,ipanel iexit = .false. interactivereplot = .false. istepin = istep istepnew = ifirststeponpage - iadvance istepsonpage = abs(istep - ifirststeponpage)/iadvance + 1 istepjump = 1 istepjumpset = .false. ! print*,'istep = ',istepnew ! print*,'steps on page = ',istepsonpage interactive_loop: do while (.not.iexit) if (print_help) then print_help = .false. char = 'h' ierr = 0 else ierr = plot_curs(xpt,ypt,char) endif ! !--exit if the device is not interactive ! if (ierr.eq.1) return !print*,'x, y = ',xpt,ypt,' function = ',char ! !--determine which plot the cursor falls on ! call get_vptxy(xpt,ypt,vptxi,vptyi) ipanel = getpanel(vptxi,vptyi) !print*,'xpt,ypt = ',xpt,ypt,vptxi,vptyi,ipanel !--translate vpt co-ords to x,y in current panel call getxy(vptxi,vptyi,xpti,ypti,ipanel) !print*,'vptx,y = ',xpti,ypti,vptxi,vptyi,ipanel !--query the position of the colour bar if (ipanel.gt.0) then if (barwmulti(ipanel).gt.tiny(barwmulti)) then iamincolourbar = incolourbar(iColourBarStyle,4,xpti,ypti,xmin(iplotxarr(ipanel)), & xmax(iplotxarr(ipanel)),xmin(iplotyarr(ipanel)),xmax(iplotyarr(ipanel))) else !--for colour bars on tiled plots, use viewport coords iamincolourbar = incolourbar(iColourBarStyle,0,vptxi,vptyi,& minval(vptxmin),maxval(vptxmax),minval(vptymin),maxval(vptymax)) endif else iamincolourbar = .false. endif !--work out if this plot is double rendered or not double_render = (icontourarr(ipanel).gt.0 .and. use_double_rendering) select case(char) case('h') print "(/,a)",' ------- interactive mode commands (multiple plots per page) --------' print*,' SPACE BAR (or n) : skip to next timestep/file' print*,' 0,1,2,3..9 and click : go forward/back n timesteps (back=r.click)' print*,' left click (or A) : zoom/select' print*,' right click (or X or b) : previous timestep' print*,' left click on colour bar : change rendering limits' print*,' +/- : zoom IN/OUT (_ for out by 20%) ' print*,' a : (a)dapt plot limits (inside box, over axes/colour bar)' print*,' l : (l)og / unlog axis (over x/y axis or colour bar)' print*,' o/C : re-centre plot on (o)rigin/(C)ursor position' print*,' backspace: delete annotation (over axes/legend/title/colour bar)' print*,' r : (r)eplot current plot' print*,' R : (R)eset/remove all range restrictions' print*,' g : plot a line and find its g)radient' print*,' ctrl-t : add text at current position' print*,' G/T/H : move le(G)end, (T)itle or (H) vector legend to current position' print*,' m/M/i : change colour map (m=next,M=previous,i=invert) (rendered plots only)' print*,' v/V/w : decrease/increase/adapt arrow size on vector plots (Z for x10)' print*,' s : (s)ave current settings for all steps' print*,' q/Q/esc : (q)uit plotting' print*,' z/Z(oom) : timestepping, zoom and limits-changing multiplied by 10' print*,'--------------------------------------------------------------------' case('g') ! draw a line between two points xline(2) = xpti yline(2) = ypti call set_panel(ipanel) !--mark first point call plot_pt1(xpti,ypti,4) !--select second point print*,' select another point (using left click or g) to plot line ' ierr = plot_band(1,1,xline(2),yline(2),xline(3),yline(3),char2) !--draw line if left click or g select case(char2) case(plot_left_click,'g') print* !--mark second point call plot_pt1(xline(3),yline(3),4) xlength = xline(3)-xline(2) if (abs(xlength).lt.tiny(xlength)) then xline(1) = xline(2) xline(4) = xline(2) yline(1) = xmin(iplotyarr(ipanel)) yline(4) = xmax(iplotyarr(ipanel)) print*,' error: gradient = infinite' elseif (xline(2).lt.xline(3)) then xline(1) = xmin(iplotxarr(ipanel)) xline(4) = xmax(iplotxarr(ipanel)) else xline(1) = xmax(iplotxarr(ipanel)) xline(4) = xmin(iplotxarr(ipanel)) endif ylength = yline(3)-yline(2) dr = sqrt(xlength**2 + ylength**2) print*,' (x1,y1) = (',xline(2),',',yline(2),')' print*,' (x2,y2) = (',xline(3),',',yline(3),')' print*,' dr = ',dr,' dx = ',xlength,' dy = ',ylength if (abs(xlength).gt.tiny(xlength)) then gradient = ylength/xlength yint = yline(3) - gradient*xline(3) print*,' gradient = ',gradient,' y intercept = ',yint yline(1) = gradient*xline(1) + yint yline(4) = gradient*xline(4) + yint endif !--plot line joining the two points call plot_line(4,xline,yline) call reset_panel case default print*,' action cancelled' end select case('s','S') do i=1,size(vptxmin) call save_limits(iplotxarr(i),xmin(iplotxarr(i)),xmax(iplotxarr(i))) call save_limits(iplotyarr(i),xmin(iplotyarr(i)),xmax(iplotyarr(i))) if (irenderarr(i).gt.0) call save_limits(irenderarr(i),xmin(irenderarr(i)),xmax(irenderarr(i))) if (icontourarr(i).gt.0) call save_limits(icontourarr(i),xmin(icontourarr(i)),xmax(icontourarr(i))) if (ivecarr(i).gt.0) then ivecx = iamvec(ivecarr(i)) + iplotxarr(i) - 1 ivecy = iamvec(ivecarr(i)) + iplotyarr(i) - 1 if (ivecx.gt.0) call save_limits(ivecx,-xmax(ivecx),xmax(ivecx)) if (ivecy.gt.0) call save_limits(ivecy,-xmax(ivecy),xmax(ivecy)) endif enddo print*,'> interactively set limits saved <' case(plot_left_click) ! left click ! !--draw rectangle from the point and reset the limits ! print*,'select area: ' print*,'left click : zoom' print*,'x = use particles within x parameter range only' print*,'y = use particles within y parameter range only' print*,'r = use particles within x and y parameter range only' print*,'R = remove all range restrictions' ! !--change colour bar limits ! if (ipanel.gt.0 .and. iamincolourbar .and. irenderarr(ipanel).gt.0) then print*,'click to set rendering limits' if (verticalbar) then ierr = plot_band(3,1,xpt,ypt,xpt2,ypt2,char2) else ierr = plot_band(4,1,xpt,ypt,xpt2,ypt2,char2) endif if (char2 == plot_left_click) then call get_vptxy(xpt2,ypt2,vptx2i,vpty2i) !--use centre point of first click and current click to ! better determine panel vptxceni = 0.5*(vptxi + vptx2i) vptyceni = 0.5*(vptyi + vpty2i) ipanel2 = getpanel(vptxceni,vptyceni) if (ipanel2.gt.0 .and. ipanel2.ne.ipanel) then print*,'panel = ',ipanel2,' was ',ipanel ipanel = ipanel2 endif call getxy(vptx2i,vpty2i,xpt2,ypt2,ipanel) !--reset first point according to current panel call getxy(vptxi,vptyi,xpti,ypti,ipanel) double_render = (icontourarr(ipanel).gt.0 .and. use_double_rendering) if (barwmulti(ipanel).gt.tiny(barwmulti)) then if (double_render) then call adjustcolourbar(iColourBarStyle,vptxi,vptyi,vptx2i,vpty2i,& vptxmin(ipanel),vptxmax(ipanel),vptymin(ipanel),vptymax(ipanel),& xmin(icontourarr(ipanel)),xmax(icontourarr(ipanel))) else call adjustcolourbar(iColourBarStyle,vptxi,vptyi,vptx2i,vpty2i,& vptxmin(ipanel),vptxmax(ipanel),vptymin(ipanel),vptymax(ipanel),& xmin(irenderarr(ipanel)),xmax(irenderarr(ipanel))) endif else !--for global colour bars (ie. on tiled plots) use viewport co-ordinates to set render limits if (double_render) then call adjustcolourbar(iColourBarStyle,vptxi,vptyi,vptx2i,vpty2i,& minval(vptxmin),maxval(vptxmax),minval(vptymin),maxval(vptymax),& xmin(icontourarr(ipanel)),xmax(icontourarr(ipanel))) else call adjustcolourbar(iColourBarStyle,vptxi,vptyi,vptx2i,vpty2i,& minval(vptxmin),maxval(vptxmax),minval(vptymin),maxval(vptymax),& xmin(irenderarr(ipanel)),xmax(irenderarr(ipanel))) endif endif if (double_render) then print*,'setting double-render min, max = ',xmin(icontourarr(ipanel)),xmax(icontourarr(ipanel)) else print*,'setting render min, max = ',xmin(irenderarr(ipanel)),xmax(irenderarr(ipanel)) endif istep = istepnew interactivereplot = .true. iexit = .true. endif else ierr = plot_band(2,1,xpt,ypt,xpt2,ypt2,char2) !call pgrect(xpt,xpt2,ypt,ypt2) call get_vptxy(xpt2,ypt2,vptx2i,vpty2i) !--use centre point of first click and current click to ! better determine panel vptxceni = 0.5*(vptxi + vptx2i) vptyceni = 0.5*(vptyi + vpty2i) ipanel2 = getpanel(vptxceni,vptyceni) if (ipanel2.gt.0 .and. ipanel2.ne.ipanel) then ipanel = ipanel2 print*,'panel = ',ipanel endif if (ipanel.le.0) cycle interactive_loop call getxy(vptx2i,vpty2i,xpt2,ypt2,ipanel) !--reset first point according to current panel call getxy(vptxi,vptyi,xpti,ypti,ipanel) xptmin = min(xpti,xpt2) xptmax = max(xpti,xpt2) yptmin = min(ypti,ypt2) yptmax = max(ypti,ypt2) select case (char2) case(plot_left_click) ! zoom if another left click xmin(iplotxarr(ipanel)) = xptmin xmax(iplotxarr(ipanel)) = xptmax xmin(iplotyarr(ipanel)) = yptmin xmax(iplotyarr(ipanel)) = yptmax print*,'setting limits: xmin = ',xmin(iplotxarr(ipanel)),' xmax = ',xmax(iplotxarr(ipanel)) istep = istepnew interactivereplot = .true. iexit = .true. case('x') call restrict_range(iplotxarr(ipanel),xptmin,xptmax) istep = istepnew interactivereplot = .true. iexit = .true. case('y') call restrict_range(iplotyarr(ipanel),yptmin,yptmax) istep = istepnew interactivereplot = .true. iexit = .true. case('r') call restrict_range(iplotxarr(ipanel),xptmin,xptmax) call restrict_range(iplotyarr(ipanel),yptmin,yptmax) istep = istepnew interactivereplot = .true. iexit = .true. case('R') call reset_ranges istep = istepnew interactivereplot = .true. iexit = .true. case default print*,' action cancelled' end select endif ! !--zooming ! case('-','_','+','o','C') ! zoom in/out if (ipanel.le.0) cycle interactive_loop xlength = xmax(iplotxarr(ipanel)) - xmin(iplotxarr(ipanel)) ylength = xmax(iplotyarr(ipanel)) - xmin(iplotyarr(ipanel)) xcen = 0.5*(xmax(iplotxarr(ipanel)) + xmin(iplotxarr(ipanel))) ycen = 0.5*(xmax(iplotyarr(ipanel)) + xmin(iplotyarr(ipanel))) if (irenderarr(ipanel).gt.0) then renderlength = xmax(irenderarr(ipanel)) - xmin(irenderarr(ipanel)) else renderlength = 0. endif if (icontourarr(ipanel).gt.0) then contlength = xmax(icontourarr(ipanel)) - xmin(icontourarr(ipanel)) else contlength = 0. endif select case(char) case('-') xlength = 1.1*zoomfac*xlength ylength = 1.1*zoomfac*ylength renderlength = 1.1*zoomfac*renderlength contlength = 1.1*zoomfac*contlength case('_') xlength = 1.2*zoomfac*xlength ylength = 1.2*zoomfac*ylength renderlength = 1.2*zoomfac*renderlength contlength = 1.2*zoomfac*contlength case('+') xlength = xlength/(1.1*zoomfac) ylength = ylength/(1.1*zoomfac) renderlength = renderlength/(1.1*zoomfac) contlength = contlength/(1.1*zoomfac) case('o') if (is_coord(iplotxarr(ipanel),ndim)) then xcen = xorigin(iplotxarr(ipanel)) else xcen = 0. endif if (is_coord(iplotyarr(ipanel),ndim)) then ycen = xorigin(iplotyarr(ipanel)) else ycen = 0. endif print*,' centreing plot on origin x,y = ',xcen,ycen case('C') xcen = xpti ycen = ypti end select xmaxin = xmax(iplotxarr(ipanel)) if (iamincolourbar .and. irenderarr(ipanel).gt.0) then if (double_render) then !--rendering zoom does not allow pan - renderpt is always centre of axis renderpt = 0.5*(xmin(icontourarr(ipanel)) + xmax(icontourarr(ipanel))) xmin(icontourarr(ipanel)) = renderpt - 0.5*contlength xmax(icontourarr(ipanel)) = renderpt + 0.5*contlength call assert_sensible_limits(xmin(icontourarr(ipanel)),xmax(icontourarr(ipanel))) print*,'zooming on colour bar: min, max = ',xmin(icontourarr(ipanel)),xmax(icontourarr(ipanel)) else !--rendering zoom does not allow pan - renderpt is always centre of axis renderpt = 0.5*(xmin(irenderarr(ipanel)) + xmax(irenderarr(ipanel))) xmin(irenderarr(ipanel)) = renderpt - 0.5*renderlength xmax(irenderarr(ipanel)) = renderpt + 0.5*renderlength call assert_sensible_limits(xmin(irenderarr(ipanel)),xmax(irenderarr(ipanel))) print*,'zooming on colour bar: min, max = ',xmin(irenderarr(ipanel)),xmax(irenderarr(ipanel)) endif istep = istepnew interactivereplot = .true. iexit = .true. else if (xpti.ge.xmin(iplotxarr(ipanel)) .and. xpti.le.xmax(iplotxarr(ipanel)) .and. ypti.le.xmax(iplotyarr(ipanel))) then xmin(iplotxarr(ipanel)) = xcen - 0.5*xlength xmax(iplotxarr(ipanel)) = xcen + 0.5*xlength call assert_sensible_limits(xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel))) print*,'zooming on x axis: min, max = ',xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel)) istep = istepnew interactivereplot = .true. iexit = .true. endif if (ypti.ge.xmin(iplotyarr(ipanel)) .and. ypti.le.xmax(iplotyarr(ipanel)) .and. xpti.le.xmaxin) then xmin(iplotyarr(ipanel)) = ycen - 0.5*ylength xmax(iplotyarr(ipanel)) = ycen + 0.5*ylength call assert_sensible_limits(xmin(iplotyarr(ipanel)),xmax(iplotyarr(ipanel))) print*,'zooming on y axis: min, max = ',xmin(iplotyarr(ipanel)),xmax(iplotyarr(ipanel)) istep = istepnew interactivereplot = .true. iexit = .true. endif endif case('a') ! adapt plot limits if (iamincolourbar .and. irenderarr(ipanel).gt.0) then if (double_render) then print*,'adapting double-render limits ',xminadapt(icontourarr(ipanel)),xmaxadapt(icontourarr(ipanel)) xmin(icontourarr(ipanel)) = xminadapt(icontourarr(ipanel)) xmax(icontourarr(ipanel)) = xmaxadapt(icontourarr(ipanel)) call assert_sensible_limits(xmin(icontourarr(ipanel)),xmax(icontourarr(ipanel))) else print*,'adapting render limits ',xminadapt(irenderarr(ipanel)),xmaxadapt(irenderarr(ipanel)) xmin(irenderarr(ipanel)) = xminadapt(irenderarr(ipanel)) xmax(irenderarr(ipanel)) = xmaxadapt(irenderarr(ipanel)) call assert_sensible_limits(xmin(irenderarr(ipanel)),xmax(irenderarr(ipanel))) endif istep = istepnew interactivereplot = .true. iexit = .true. else !--save xmax before we go changing it so can check the y axis xmaxin = xmax(iplotxarr(ipanel)) if (xpti.ge.xmin(iplotxarr(ipanel)) .and. xpti.le.xmax(iplotxarr(ipanel)) & .and. ypti.le.xmax(iplotyarr(ipanel))) then print*,'adapting x limits ',xminadapt(iplotxarr(ipanel)),xmaxadapt(iplotxarr(ipanel)) xmin(iplotxarr(ipanel)) = xminadapt(iplotxarr(ipanel)) xmax(iplotxarr(ipanel)) = xmaxadapt(iplotxarr(ipanel)) call assert_sensible_limits(xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel))) istep = istepnew interactivereplot = .true. iexit = .true. endif if (ypti.ge.xmin(iplotyarr(ipanel)) .and. ypti.le.xmax(iplotyarr(ipanel)) & .and. xpti.le.xmaxin) then print*,'adapting y limits ',xminadapt(iplotyarr(ipanel)),xmaxadapt(iplotyarr(ipanel)) xmin(iplotyarr(ipanel)) = xminadapt(iplotyarr(ipanel)) xmax(iplotyarr(ipanel)) = xmaxadapt(iplotyarr(ipanel)) call assert_sensible_limits(xmin(iplotyarr(ipanel)),xmax(iplotyarr(ipanel))) istep = istepnew interactivereplot = .true. iexit = .true. endif endif ! !--zoom in/out on vector plots (arrow size) ! case('v') if (ivecarr(ipanel).gt.0) then print*,'decreasing vector arrow size' xmax(ivecarr(ipanel)) = 1.2*zoomfac*xmax(ivecarr(ipanel)) istep = istepnew interactivereplot = .true. iexit = .true. endif case('V') if (ivecarr(ipanel).gt.0) then print*,'increasing vector arrow size' xmax(ivecarr(ipanel)) = xmax(ivecarr(ipanel))/(1.2*zoomfac) istep = istepnew interactivereplot = .true. iexit = .true. endif case('w','W') if (ivecarr(ipanel).gt.0) then print*,'adapting vector arrow size' xmax(ivecarr(ipanel)) = -1.0 istep = istepnew interactivereplot = .true. iexit = .true. endif ! !--set/unset log axes ! case('l') ! !--change colour bar, y and x itrans between log / not logged ! if (iamincolourbar .and. irenderarr(ipanel).gt.0) then if (double_render) then call change_itrans2(icontourarr(ipanel),xmin(icontourarr(ipanel)),xmax(icontourarr(ipanel)),& xminadapt(icontourarr(ipanel)),xmaxadapt(icontourarr(ipanel))) else call change_itrans2(irenderarr(ipanel),xmin(irenderarr(ipanel)),xmax(irenderarr(ipanel)),& xminadapt(irenderarr(ipanel)),xmaxadapt(irenderarr(ipanel))) endif istep = istepnew interactivereplot = .true. iexit = .true. elseif (xpti.lt.xmin(iplotxarr(ipanel))) then if (is_coord(iplotyarr(ipanel),ndim) .and. irenderarr(ipanel).gt.0) then print "(a)",'error: cannot log coordinate axes with rendering' else call change_itrans2(iplotyarr(ipanel),xmin(iplotyarr(ipanel)),xmax(iplotyarr(ipanel)),& xminadapt(iplotyarr(ipanel)),xmaxadapt(iplotyarr(ipanel))) istep = istepnew interactivereplot = .true. iexit = .true. endif elseif (ypti.lt.xmin(iplotyarr(ipanel))) then if (is_coord(iplotxarr(ipanel),ndim) .and. irenderarr(ipanel).gt.0) then print "(a)",'error: cannot log coordinate axes with rendering' else call change_itrans2(iplotxarr(ipanel),xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel)),& xminadapt(iplotxarr(ipanel)),xmaxadapt(iplotxarr(ipanel))) istep = istepnew interactivereplot = .true. iexit = .true. endif endif ! !--reset all range restrictions ! case('R') call reset_ranges interactivereplot = .true. istep = istepnew iexit = .true. ! !--general plot stuff ! case('G') ! move legend here print*,'setting legend position to current location...' if (ipanel.gt.0) then call mvlegend(xpti,ypti,xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel)),xmax(iplotyarr(ipanel)),ipanel) istep = istepnew interactivereplot = .true. iexit = .true. endif case('T') ! move title here if (ipanel.gt.0) then print*,'setting title position to current location...' call mvtitle(xpti,ypti,xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel)),xmax(iplotyarr(ipanel))) istep = istepnew interactivereplot = .true. iexit = .true. endif case('H') ! move vector legend here if (ipanel.gt.0) then if (ivecarr(ipanel).gt.0) then print*,'setting vector plot legend to current location...' call mvlegendvec(xpti,ypti,xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel)),xmax(iplotyarr(ipanel))) istep = istepnew interactivereplot = .true. iexit = .true. endif endif case('m') ! change colour map (next scheme) call change_colourmap(icolourscheme,1) istep = istepnew interactivereplot = .true. iexit = .true. case('M') ! change colour map (previous scheme) call change_colourmap(icolourscheme,-1) istep = istepnew interactivereplot = .true. iexit = .true. case('i') ! invert colour map icolourscheme = -icolourscheme call change_colourmap(icolourscheme,0) istep = istepnew interactivereplot = .true. iexit = .true. case(achar(20)) ! add text shape print*,' adding text in panel ',ipanel call add_textshape(xpti,ypti,itrans(iplotxarr(ipanel)),itrans(iplotyarr(ipanel)),ipanel,ierr) if (ierr.eq.0) then istep = istepnew interactivereplot = .true. iexit = .true. endif case(achar(8)) ! delete plot annotation / colour bar (backspace) ishape = inshape(xpti,ypti,itrans(iplotxarr(ipanel)),itrans(iplotxarr(ipanel))) if (ishape.gt.0) then call delete_shape(ishape,nshapes) istep = istepnew interactivereplot = .true. iexit = .true. elseif (iamincolourbar .and. irenderarr(ipanel).gt.0) then iColourBarStyle = 0 istep = istepnew interactivereplot = .true. iexit = .true. elseif (xpti.lt.xmin(iplotxarr(ipanel)) .or. xpti.gt.xmax(iplotxarr(ipanel)) & .or. ypti.lt.xmin(iplotyarr(ipanel)) .or. ypti.gt.xmax(iplotyarr(ipanel))) then call deleteaxes() istep = istepnew interactivereplot = .true. iexit = .true. else print*,' nothing to delete at x,y =',xpt,',',ypt endif ! !--timestepping ! case('q','Q',achar(27),achar(3)) iadvance = -666 print*,'quitting...' iexit = .true. case('X','b','B') ! right click -> go back ! iadvance = -abs(iadvance) istep = istepin - (istepjump)*istepsonpage - iadvance*istepsonpage lastpanel = 0 iexit = .true. case('r') ! replot interactivereplot = .true. istep = istepnew iexit = .true. case(' ','n','N') ! space !iadvance = abs(iadvance) istep = istepin + (istepjump-1)*istepsonpage lastpanel = 0 iexit = .true. case('0','1','2','3','4','5','6','7','8','9') read(char,*,iostat=ierr) istepjumpnew if (ierr /=0) then print*,'*** internal error setting timestep jump' istepjumpnew = 1 endif if ((istepjump.gt.1 .or. istepjumpset) .and. istepjump.le.9999) then istepjump = 10*istepjump + istepjumpnew if (istepjump.gt.9999) istepjump = 1 elseif (istepjumpnew.eq.0) then istepjump = 10 else istepjump = istepjumpnew endif istepjump = int(zoomfac*istepjump) print*,' setting timestep jump = ',istepjump istepjumpset = .true. case(')') istepjump = int(zoomfac*10) print*,' setting timestep jump = ',istepjump ! !--multiply everything by a factor of 10 ! case('z','Z') zoomfac = 10.*zoomfac if (zoomfac.gt.1000000.) then zoomfac = 1.0 endif print*,' LIMITS/TIMESTEPPING CHANGES NOW x ',zoomfac ! !--unknown ! case default print*,' x, y = ',xpti,ypti,'; unknown option "',trim(char),'" ',iachar(char) end select ! !--save cursor position relative to the viewport ! call get_vptxy(xpt,ypt,xcursor,ycursor) call reset_panel ! !--do not let timestep go outside of bounds ! if we are at the first/last step, just print message and do nothing ! if iadvance trips over the bounds, jump to last/first step ! if (iadvance.ne.-666 .and. iexit) then if (istep + iadvance .gt. ilaststep .and. iframe.eq.nframes) then print "(1x,a)",'reached last timestep' if (istepin.ne.ilaststep) then istep = ilaststep - istepsonpage*iadvance else istep = istepin iexit = .false. endif elseif (istep + iadvance .lt. 1 .and. ifirstframeonpage.eq.1) then print "(1x,a)",'reached first timestep: can''t go back' if (ifirststeponpage.ne.1) then istep = 1 - iadvance else istep = istepin iexit = .false. endif endif endif enddo interactive_loop return contains !-------- ! utility to return which panel we are in given a point on the viewport ! and the viewport limits for each panel. !-------- integer function getpanel(vptx,vpty) implicit none real, intent(in) :: vptx,vpty real :: vptxmini,vptxmaxi,vptymini,vptymaxi integer :: i,icol getpanel = 0 icol = 0 do i=1,size(vptxmin) icol = icol + 1 if (icol.gt.nacross) icol = 1 if (icol.gt.1) then ! if column>1 assign panel by being to the right of previous panel vptxmini = vptxmax(i-1)+barwmulti(i-1) else vptxmini = -0.1 ! allow for some error endif !--if last column extend xmax to right of page if (icol.eq.nacross) then vptxmaxi = 1.1 elseif (verticalbar) then ! otherwise use max of current panel + space containing the colour bar vptxmaxi = vptxmax(i) + barwmulti(i) else vptxmaxi = vptxmax(i) endif !--if first row extend ymax to top of page if (i.le.nacross) then vptymaxi = 1.1 else vptymaxi = vptymax(i) endif !--if last row then allow ymin to extend to bottom of page if (i.gt.(size(vptxmin)-nacross)) then vptymini = -0.1 ! if not last row assign panel by being above row below elseif (i+nacross.le.size(vptxmin)) then vptymini = vptymax(i+nacross) elseif (.not.verticalbar) then vptymini = vptymin(i) - barwmulti(i) else vptymini = vptymin(i) endif if (vptx.gt.vptxmini .and. vptx.lt.vptxmaxi .and. & vpty.gt.vptymini .and. vpty.lt.vptymaxi) then if (getpanel.ne.0) print*,'Warning: multiple matching panels found ',getpanel,i getpanel = i endif enddo if (getpanel.le.0 .or. getpanel.gt.size(vptxmin)) then !print*,' vptx,y = ',vptx,vpty,vptxmin(:),vptxmax(:) print*,'Error determining panel: assuming last ' getpanel = size(vptxmin) endif end function getpanel !-------- ! utility to return x,y coordinates in a given panel given viewport coords !-------- subroutine getxy(vptx,vpty,x,y,ipanel) implicit none real, intent(in) :: vptx,vpty real, intent(out) :: x,y integer, intent(in) :: ipanel if (ipanel.gt.0) then x = xmin(iplotxarr(ipanel)) + (vptx-vptxmin(ipanel))/(vptxmax(ipanel)-vptxmin(ipanel)) & *(xmax(iplotxarr(ipanel))-xmin(iplotxarr(ipanel))) y = xmin(iplotyarr(ipanel)) + (vpty-vptymin(ipanel))/(vptymax(ipanel)-vptymin(ipanel)) & *(xmax(iplotyarr(ipanel))-xmin(iplotyarr(ipanel))) else x = 0. y = 0. endif return end subroutine getxy !--- ! utility which translates between world co-ordinates (x,y) ! and viewport co-ordinates (relative to the whole viewport) !--- !subroutine get_vptxy(x,y,vptx,vpty,ipanel) ! implicit none ! real, intent(in) :: x,y ! real, intent(out) :: vptx,vpty ! integer, intent(in) :: ipanel ! ! if (ipanel.gt.0) then ! vptx = vptxmin(ipanel) + (x-xmin(iplotxarr(ipanel)))/& ! (xmax(iplotxarr(ipanel))-xmin(iplotxarr(ipanel)))*(vptxmax(ipanel)-vptxmini(ipanel)) ! vpty = vptymin(ipanel) + (y-xmin(iplotyarr(ipanel)))/&(xmax(iplotyarr(ipanel))-xmin(iplotyarr(ipanel)))*(vptymax(ipanel)-vptymini(ipanel)) ! else ! vptx = 0.5 ! vpty = 0.5 ! endif ! !end subroutine get_vptxy !-------- ! utility to reset the drawing surface so we can draw in a panel !-------- subroutine set_panel(ipanel) use plotlib, only:plot_svp,plot_swin implicit none integer, intent(in) :: ipanel if (ipanel.gt.0) then call plot_swin(xmin(iplotxarr(ipanel)),xmax(iplotxarr(ipanel)),xmin(iplotyarr(ipanel)),xmax(iplotyarr(ipanel))) !--really should save viewport setting here, but doesn't matter ! so long as interactive mode is the last thing called call plot_svp(vptxmin(ipanel),vptxmax(ipanel),vptymin(ipanel),vptymax(ipanel)) endif return end subroutine set_panel subroutine reset_panel use plotlib, only:plot_swin implicit none call plot_swin(xmini,xmaxi,ymini,ymaxi) end subroutine reset_panel end subroutine interactive_multi !-------------------------------------------------------------------- ! utilities to determine whether a point is in or out of a selection !-------------------------------------------------------------------- logical function inslice(x,xmin,xmax) implicit none real, intent(in) :: x,xmin,xmax inslice = (x.ge.xmin .and. x.le.xmax) end function inslice logical function inrectangle(x,y,xmin,xmax,ymin,ymax) implicit none real, intent(in) :: x,y,xmin,xmax,ymin,ymax inrectangle = (x.ge.xmin .and. x.le.xmax .and. y.ge.ymin .and. y.le.ymax) end function inrectangle logical function incircle(x,y,r2) implicit none real, intent(in) :: x,y,r2 incircle = ((x*x + y*y) <= r2) end function incircle ! ! Point in polygon ! See: http://en.wikipedia.org/wiki/Even-odd_rule ! logical function inpoly(x,y,xpts,ypts,npts) implicit none real, intent(in) :: x,y real, dimension(:), intent(in) :: xpts,ypts integer, intent(in) :: npts integer :: i,j inpoly = .false. j = npts do i=1,npts if (((ypts(i) > y) .neqv. (ypts(j) > y)) .and. & (x < (xpts(j) - xpts(i))*(y-ypts(i))/(ypts(j) - ypts(i)) + xpts(i))) then inpoly = .not. inpoly endif j = i enddo end function inpoly !------------------------------------------------------------ ! utility which adapts plot limits based only on the ! particles being plotted !------------------------------------------------------------ subroutine adapt_limits_interactive(labeli,np,xarr,xmin,xmax,icolourpart,iamtype,iusetype) use params, only:int1 use limits, only:assert_sensible_limits implicit none character(len=*), intent(in) :: labeli integer, intent(in) :: np real, dimension(np), intent(in) :: xarr real, intent(out) :: xmin,xmax integer(kind=int1), dimension(:) , intent(in) :: iamtype integer, dimension(np), intent(in) :: icolourpart logical, dimension(:), intent(in) :: iusetype integer :: itype,i logical :: mixedtypes xmin = huge(xmin) xmax = -huge(xmax) mixedtypes = size(iamtype).ge.np if (mixedtypes) then do i=1,np itype = int(iamtype(i)) if (iusetype(itype) .and. icolourpart(i).gt.0) then xmin = min(xmin,xarr(i)) xmax = max(xmax,xarr(i)) endif enddo else xmin = minval(xarr,mask=(icolourpart.ge.0)) xmax = maxval(xarr,mask=(icolourpart.ge.0)) endif call assert_sensible_limits(xmin,xmax) print "(1x,a)",' resetting '//trim(labeli)//' limits' end subroutine adapt_limits_interactive !------------------------------------------------------------ ! utility which translates between world co-ordinates (x,y) ! and viewport co-ordinates (relative to the whole viewport) !------------------------------------------------------------ subroutine get_vptxy(x,y,vptx,vpty) use plotlib, only:plot_qvp,plot_qwin implicit none real, intent(in) :: x,y real, intent(out) :: vptx,vpty real :: xmini,xmaxi,ymini,ymaxi real :: vptxmini,vptxmaxi,vptymini,vptymaxi call plot_qvp(0,vptxmini,vptxmaxi,vptymini,vptymaxi) call plot_qwin(xmini,xmaxi,ymini,ymaxi) vptx = vptxmini + (x-xmini)/(xmaxi-xmini)*(vptxmaxi-vptxmini) vpty = vptymini + (y-ymini)/(ymaxi-ymini)*(vptymaxi-vptymini) end subroutine get_vptxy !------------------------------------------------------------ ! utility to return x,y coordinates given viewport coords ! (only works for single-panelled plots) !------------------------------------------------------------ subroutine get_posxy(vptx,vpty,x,y,xmini,xmaxi,ymini,ymaxi) use plotlib, only:plot_qvp implicit none real, intent(in) :: vptx,vpty real, intent(out) :: x,y real, intent(in) :: xmini,xmaxi,ymini,ymaxi real :: vptxmini,vptxmaxi,vptymini,vptymaxi call plot_qvp(0,vptxmini,vptxmaxi,vptymini,vptymaxi) x = xmini + (vptx-vptxmini)/(vptxmaxi-vptxmini)*(xmaxi-xmini) y = ymini + (vpty-vptymini)/(vptymaxi-vptymini)*(ymaxi-ymini) return end subroutine get_posxy !----------------------------------------------------------- ! These subroutines interface to the actual plot settings !----------------------------------------------------------- ! !--plot a label showing the particle ID on the plot ! subroutine plot_number(i,xi,yi) use plotlib, only:plot_numb,plot_qch,plot_sch,plot_text implicit none integer, intent(in) :: i real, intent(in) :: xi,yi integer :: nc real :: charheight character(len=20) :: string !--convert number to text string call plot_numb(i,0,1,string,nc) !--query and store character height call plot_qch(charheight) !--change character height call plot_sch(2.0) !--plot text string call plot_text(xi,yi,string(1:nc)) !--reset character height call plot_sch(charheight) return end subroutine plot_number subroutine deleteaxes() use settings_page, only:iaxis,iPlotLegend,& !iPlotStepLegend, & iPlotTitles,iPlotScale use settings_vecplot, only:iVecplotLegend implicit none if (iaxis.eq.-2) then ! !-- would be better to do this properly by ! determining whether or not the cursor is over ! the legend, shape, title or whatever annotation the user ! wishes to be deleted. Instead at the moment we just ! delete the legends once the axes are already gone, and ! then in a somewhat arbitrary order. ! iVecplotLegend = .false. if (iPlotLegend) then iPlotLegend = .false. elseif (iPlotTitles) then iPlotTitles = .false. elseif (iPlotScale) then iPlotScale = .false. endif elseif (iaxis.le.2 .and. iaxis.gt.-2) then iaxis = iaxis - 1 elseif (iaxis.gt.2) then iaxis = -1 elseif (iaxis.lt.-2) then iaxis = -2 endif end subroutine deleteaxes ! !--move the legend to the current position ! subroutine mvlegend(xi,yi,xmin,xmax,ymax,ipanel) use settings_page, only:hposlegend,vposlegend,fjustlegend,iPlotLegend,iPlotLegendOnlyOnPanel use plotlib, only:plot_qcs implicit none real, intent(in) :: xi,yi,xmin,xmax,ymax integer, intent(in), optional :: ipanel real :: xch,ych iPlotLegend = .true. hposlegend = (xi - xmin)/(xmax-xmin) !--query character height in world coordinates call plot_qcs(4,xch,ych) vposlegend = (ymax - yi)/ych ! !--automatically change justification ! if (hposlegend < 0.25) then fjustlegend = 0.0 ! elseif (hposlegend > 0.75) then ! fjustlegend = 1.0 ! else ! fjustlegend = 0.5 ! endif if (present(ipanel)) then if (ipanel.gt.0 .and. iPlotLegendOnlyOnPanel.gt.0) iPlotLegendOnlyOnPanel = ipanel endif print*,'hpos = ',hposlegend,' vpos = ',vposlegend,' just = ',fjustlegend return end subroutine mvlegend ! !--move the vector legend to the current position ! subroutine mvlegendvec(xi,yi,xmin,xmax,ymax) use settings_vecplot, only:hposlegendvec,vposlegendvec,iVecplotLegend use plotlib, only:plot_qcs implicit none real, intent(in) :: xi,yi,xmin,xmax,ymax real :: xch,ych iVecplotLegend = .true. hposlegendvec = (xi - xmin)/(xmax-xmin) !--query character height in world coordinates call plot_qcs(4,xch,ych) vposlegendvec = (ymax - yi)/ych print*,'hpos = ',hposlegendvec,' vpos = ',vposlegendvec return end subroutine mvlegendvec ! !--move the title to the current position ! subroutine mvtitle(xi,yi,xmin,xmax,ymax) use settings_page, only:hpostitle,vpostitle,fjusttitle,iPlotTitles use plotlib, only:plot_qcs implicit none real, intent(in) :: xi,yi,xmin,xmax,ymax real :: xch,ych iPlotTitles = .true. hpostitle = (xi - xmin)/(xmax-xmin) !--query character height in world coordinates call plot_qcs(4,xch,ych) vpostitle = (yi - ymax)/ych !--automatically change justification if (hpostitle < 0.25) then fjusttitle = 0.0 elseif (hpostitle > 0.75) then fjusttitle = 1.0 else fjusttitle = 0.5 endif print*,'hpos = ',hpostitle,' vpos = ',vpostitle,' just = ',fjusttitle return end subroutine mvtitle ! !--saves current plot limits ! subroutine save_limits(iplot,xmin,xmax,setlim2) use limits, only:lim,lim2 use labels, only:is_coord use multiplot, only:itrans use settings_data, only:ndim use settings_limits, only:iadapt,iadaptcoords use transforms, only:transform_limits_inverse implicit none integer, intent(in) :: iplot real, intent(in) :: xmin,xmax logical, intent(in), optional :: setlim2 logical :: uselim2 real :: xmintemp,xmaxtemp uselim2 = .false. if (present(setlim2)) uselim2 = setlim2 if (itrans(iplot).ne.0) then xmintemp = xmin xmaxtemp = xmax call transform_limits_inverse(xmintemp,xmaxtemp,itrans(iplot)) if (uselim2) then lim2(iplot,1) = xmintemp lim2(iplot,2) = xmaxtemp else lim(iplot,1) = xmintemp lim(iplot,2) = xmaxtemp endif else if (uselim2) then lim2(iplot,1) = xmin lim2(iplot,2) = xmax else lim(iplot,1) = xmin lim(iplot,2) = xmax endif endif ! !--change appropriate plot limits to fixed (not adaptive) ! if (is_coord(iplot,ndim)) then iadaptcoords = .false. else iadapt = .false. endif return end subroutine save_limits ! !--implements parameter range restriction ! subroutine restrict_range(iplot,xmin,xmax) use limits, only:range use multiplot, only:itrans use transforms, only:transform_limits_inverse implicit none integer, intent(in) :: iplot real, intent(in) :: xmin,xmax real :: xmintemp,xmaxtemp if (itrans(iplot).ne.0) then xmintemp = xmin xmaxtemp = xmax call transform_limits_inverse(xmintemp,xmaxtemp,itrans(iplot)) range(iplot,1) = xmintemp range(iplot,2) = xmaxtemp else range(iplot,1) = xmin range(iplot,2) = xmax endif return end subroutine restrict_range ! !--interface to routine which removes all parameter range restrictions ! subroutine reset_ranges() use limits, only:reset_all_ranges implicit none call reset_all_ranges() return end subroutine reset_ranges ! !--interface to routine which resets second set of limits ! subroutine reset_limits2(icol) use limits, only:reset_lim2 implicit none integer, intent(in) :: icol call reset_lim2(icol) return end subroutine reset_limits2 ! !--saves current plot limits for particle tracking ! subroutine save_limits_track(iplot,xmin,xmax,xi) use multiplot, only:itrans use settings_data, only:ndim use settings_limits, only:xminoffset_track,xmaxoffset_track use transforms, only:transform_limits_inverse implicit none integer, intent(in) :: iplot real, intent(in) :: xmin,xmax,xi real :: xmintemp,xmaxtemp if (iplot.gt.ndim) then print*,'ERROR in save_limits_track: iplot>ndim' return elseif (itrans(iplot).ne.0) then xmintemp = xmin xmaxtemp = xmax call transform_limits_inverse(xmintemp,xmaxtemp,itrans(iplot)) xminoffset_track(iplot) = abs(xi - xmintemp) xminoffset_track(iplot) = abs(xmaxtemp - xi) else xminoffset_track(iplot) = abs(xi - xmin) xmaxoffset_track(iplot) = abs(xmax - xi) endif return end subroutine save_limits_track ! !--recalculates radius ! subroutine save_itrackpart_recalcradius(itrackpart) use filenames, only:nsteps,nstepsinfile,ifileopen use settings_data, only:ncalc,DataIsBuffered,iCalcQuantities, & itracktype,itrackoffset use calcquantities, only:calc_quantities,calc_quantities_use_x0 implicit none integer, intent(in) :: itrackpart itracktype = 0 ! cannot interactively track by type itrackoffset = itrackpart if (iCalcQuantities .and. itrackpart.gt.0) then if (ncalc.gt.0 .and. calc_quantities_use_x0()) then print "(a)",' Recalculating radius relative to tracked particle' if (DataIsBuffered) then call calc_quantities(1,nsteps) else call calc_quantities(1,nstepsinfile(ifileopen)) endif endif endif return end subroutine save_itrackpart_recalcradius ! !--toggles log/unlog ! note this only changes a pure log transform: will not change combinations ! subroutine change_itrans(iplot,xmin,xmax) use multiplot, only:itrans use settings_data, only:numplot use transforms, only:transform_limits,transform_limits_inverse implicit none integer, intent(in) :: iplot real, intent(inout) :: xmin, xmax if (iplot.le.numplot) then if (itrans(iplot).eq.1) then itrans(iplot) = 0 !!--untransform the plot limits call transform_limits_inverse(xmin,xmax,1) else itrans(iplot) = 1 !!--transform the plot limits call transform_limits(xmin,xmax,itrans(iplot)) endif endif end subroutine change_itrans subroutine change_itrans2(iplot,xmin,xmax,xmina,xmaxa) use multiplot, only:itrans use settings_data, only:numplot use transforms, only:transform_limits,transform_limits_inverse implicit none integer, intent(in) :: iplot real, intent(inout) :: xmin, xmax, xmina, xmaxa if (iplot.le.numplot) then if (itrans(iplot).eq.1) then itrans(iplot) = 0 !!--untransform the plot limits call transform_limits_inverse(xmin,xmax,1) call transform_limits_inverse(xmina,xmaxa,1) else itrans(iplot) = 1 !!--transform the plot limits call transform_limits(xmin,xmax,itrans(iplot)) call transform_limits(xmina,xmaxa,itrans(iplot)) endif endif end subroutine change_itrans2 ! !--saves rotation options ! subroutine save_rotation(ndim,anglexi,angleyi,anglezi) use settings_xsecrot, only:anglex,angley,anglez implicit none integer, intent(in) :: ndim real, intent(in) :: anglexi,angleyi,anglezi anglez = anglezi if (ndim.ge.3) then anglex = anglexi angley = angleyi endif return end subroutine save_rotation ! !--saves cross section position ! subroutine save_xsecpos(xsecpos,xsec) use settings_xsecrot, only:xsecpos_nomulti,xsec_nomulti implicit none real, intent(in) :: xsecpos logical, intent(in) :: xsec xsecpos_nomulti = xsecpos xsec_nomulti = xsec return end subroutine save_xsecpos ! !--saves 3D perspective ! subroutine save_perspective(zpos,dz) use settings_xsecrot, only:zobserver,dzscreenfromobserver implicit none real, intent(in) :: zpos,dz zobserver = zpos dzscreenfromobserver = dz return end subroutine save_perspective ! !--saves 3D opacity ! subroutine save_opacity(taupartdepthi) use settings_xsecrot, only:taupartdepth implicit none real, intent(in) :: taupartdepthi taupartdepth = taupartdepthi return end subroutine save_opacity ! !--saves circles of interaction ! subroutine save_circles(ncircpartset,icircpartset) use settings_part, only:ncircpart,icircpart implicit none integer, intent(in) :: ncircpartset integer, intent(in), dimension(:) :: icircpartset integer :: imax imax = min(size(icircpartset),size(icircpart),ncircpartset) ncircpart = imax icircpart(1:imax) = icircpartset(1:imax) print*,'saving ',imax,' circles of interaction only' end subroutine save_circles ! !--change colour map ! subroutine change_colourmap(imap,istep) use colours, only:colour_set,ncolourschemes implicit none integer, intent(inout) :: imap integer, intent(in) :: istep imap = imap + istep if (abs(imap).gt.ncolourschemes) imap = 1 if (abs(imap).lt.1) imap = ncolourschemes call colour_set(imap) end subroutine change_colourmap ! !--set movie mode ! subroutine set_movie_mode() use settings_page, only:iaxis,papersizex,aspectratio,ipapersize,ipapersizeunits,iPageColours use settings_limits, only:adjustlimitstodevice use settings_render, only:iColourBarStyle use pagecolours, only:set_pagecolours use plotlib, only:plotlib_is_pgplot,plot_pap implicit none iaxis = -1 iPageColours = 2 if (.not.plotlib_is_pgplot) then ipapersize = 9 ipapersizeunits = 0 papersizex = 1280. aspectratio = 0.5625 call plot_pap(papersizex,aspectratio,ipapersizeunits) iColourBarStyle = 3 call set_pagecolours(iPageColours) adjustlimitstodevice = .true. endif end subroutine set_movie_mode ! !--unset movie mode ! subroutine unset_movie_mode() use settings_page, only:iaxis,papersizex,aspectratio,ipapersize,iPageColours use settings_limits, only:adjustlimitstodevice use settings_render, only:iColourBarStyle use pagecolours, only:set_pagecolours use plotlib, only:plotlib_is_pgplot implicit none iaxis = 0 iPageColours = 0 if (.not.plotlib_is_pgplot) then ipapersize = 0 papersizex = 0. aspectratio = 0. iColourBarStyle = 1 call set_pagecolours(iPageColours) adjustlimitstodevice = .false. endif end subroutine unset_movie_mode end module interactive_routines splash/src/interpolate1D.f90000644 000770 000000 00000012210 12024002741 016556 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! ! Module containing all of the routines required for 1D interpolation ! !---------------------------------------------------------------------- module interpolations1D implicit none public :: interpolate1D contains !-------------------------------------------------------------------------- ! subroutine to interpolate from particle data to even 1D grid of pixels ! ! The data is smoothed using the SPH summation interpolant, ! that is, we compute the smoothed array according to ! ! datsmooth(pixel) = sum_j w_j W(r-r_j, h_j) ! ! where _j is the quantity at the neighbouring particle j and ! W is the smoothing kernel, for which we use the usual cubic spline. ! For an SPH interpolation the weight for each particle should be ! the dimensionless quantity ! ! w_j = m_j / (rho_j * h_j**ndim) ! ! Other weights can be used (e.g. constants), but in this case the ! normalisation option should also be set. ! ! Input: particle coordinates : x (npart) ! smoothing lengths : hh (npart) ! interpolation weights : weight (npart) ! scalar data to smooth : dat (npart) ! ! number of pixels in x : npixx ! pixel width : pixwidth ! option to normalise interpolation : normalise (.true. or .false.) ! ! Output: smoothed data : datsmooth (npixx) ! ! Written by Daniel Price 2003-2006 !-------------------------------------------------------------------------- subroutine interpolate1D(x,hh,weight,dat,itype,npart, & xmin,datsmooth,npixx,pixwidth,normalise) use kernels, only:cnormk1D,radkernel,wfunc implicit none integer, intent(in) :: npart,npixx real, intent(in), dimension(npart) :: x,hh,weight,dat integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,pixwidth real, intent(out), dimension(npixx) :: datsmooth logical, intent(in) :: normalise real, dimension(npixx) :: datnorm integer :: i,ipix,ipixmin,ipixmax real :: hi,hi1,radkern,q2,wab,const real :: term,termnorm,dx,xpix datsmooth = 0. term = 0. if (normalise) then print*,'interpolating (normalised) from particles to 1D grid: npix,xmin,max=',npixx,xmin,xmin+npixx*pixwidth else print*,'interpolating (non-normalised) from particles to 1D grid: npix,xmin,max=',npixx,xmin,xmin+npixx*pixwidth endif if (pixwidth.le.0.) then print*,'interpolate1D: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate1D: warning: ignoring some or all particles with h < 0' endif const = cnormk1D ! normalisation constant ! !--loop over particles ! over_parts: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts ! !--skip particles with zero weights ! termnorm = const*weight(i) if (termnorm.le.0.) cycle over_parts ! !--skip particles with wrong h's ! hi = hh(i) if (hi.le.tiny(hi)) cycle over_parts ! !--set kernel related quantities ! hi1 = 1./hi radkern = radkernel*hi ! radius of the smoothing kernel term = termnorm*dat(i) ! !--for each particle work out which pixels it contributes to ! ipixmin = int((x(i) - radkern - xmin)/pixwidth) ipixmax = int((x(i) + radkern - xmin)/pixwidth) + 1 if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (ipixmax.gt.npixx) ipixmax = npixx ! to pixels in the image ! !--loop over pixels, adding the contribution from this particle ! do ipix = ipixmin,ipixmax xpix = xmin + (ipix-0.5)*pixwidth dx = xpix - x(i) q2 = dx*dx*hi1*hi1 ! !--SPH kernel - standard cubic spline ! wab = wfunc(q2) ! !--calculate data value at this pixel using the summation interpolant ! datsmooth(ipix) = datsmooth(ipix) + term*wab if (normalise) datnorm(ipix) = datnorm(ipix) + termnorm*wab enddo enddo over_parts ! !--normalise dat array ! if (normalise) then where (datnorm > 0.) datsmooth = datsmooth/datnorm end where endif return end subroutine interpolate1D end module interpolations1D splash/src/interpolate2D.f90000644 000770 000000 00000047341 12024002741 016574 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! ! Module containing all of the routines required for 2D interpolation ! !---------------------------------------------------------------------- module interpolations2D use kernels, only:radkernel2,radkernel,cnormk2D,wfunc implicit none public :: interpolate2D, interpolate2D_xsec, interpolate2D_vec public :: interpolate_part, interpolate_part1 contains !-------------------------------------------------------------------------- ! subroutine to interpolate from particle data to even grid of pixels ! ! The data is smoothed using the SPH summation interpolant, ! that is, we compute the smoothed array according to ! ! datsmooth(pixel) = sum_j w_j dat_j W(r-r_j, h_j) ! ! where _j is the quantity at the neighbouring particle j and ! W is the smoothing kernel, for which we use the usual cubic spline. ! For an SPH interpolation the weight for each particle should be ! the dimensionless quantity ! ! w_j = m_j / (rho_j * h_j**ndim) ! ! Other weights can be used (e.g. constants), but in this case the ! normalisation option should also be set. ! ! Input: particle coordinates : x,y (npart) ! smoothing lengths : hh (npart) ! interpolation weights : weight (npart) ! scalar data to smooth : dat (npart) ! ! number of pixels in x,y : npixx,npixy ! pixel width : pixwidth ! option to normalise interpolation : normalise (.true. or .false.) ! ! Output: smoothed data : datsmooth (npixx,npixy) ! ! Written by Daniel Price 2003-2012 !-------------------------------------------------------------------------- subroutine interpolate2D(x,y,hh,weight,dat,itype,npart, & xmin,ymin,datsmooth,npixx,npixy,pixwidthx,pixwidthy,& normalise,periodicx,periodicy) implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,hh,weight,dat integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidthx,pixwidthy real, intent(out), dimension(npixx,npixy) :: datsmooth logical, intent(in) :: normalise,periodicx,periodicy real, dimension(npixx,npixy) :: datnorm integer :: i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax integer :: ipixi,jpixi real :: hi,hi1,radkern,q2,wab,const real :: term,termnorm,dx,dy,xpix,ypix datsmooth = 0. datnorm = 0. if (normalise) then print "(1x,a)",'interpolating from particles to 2D grid (normalised)...' else print "(1x,a)",'interpolating from particles to 2D grid (non-normalised)...' endif if (pixwidthx.le.0. .or. pixwidthy.le.0.) then print "(1x,a)",'interpolate2D: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate2D: warning: ignoring some or all particles with h < 0' endif const = cnormk2D ! normalisation constant ! !--loop over particles ! over_parts: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts ! !--skip particles with zero weights ! termnorm = const*weight(i) if (termnorm.le.0.) cycle over_parts ! !--skip particles with wrong h's ! hi = hh(i) if (hi.le.tiny(hi)) cycle over_parts ! !--set kernel related quantities ! hi1 = 1./hi radkern = radkernel*hi ! radius of the smoothing kernel term = termnorm*dat(i) ! !--for each particle work out which pixels it contributes to ! ipixmin = int((x(i) - radkern - xmin)/pixwidthx) jpixmin = int((y(i) - radkern - ymin)/pixwidthy) ipixmax = int((x(i) + radkern - xmin)/pixwidthx) + 1 jpixmax = int((y(i) + radkern - ymin)/pixwidthy) + 1 if (.not.periodicx) then if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (ipixmax.gt.npixx) ipixmax = npixx ! to pixels in the image endif if (.not.periodicy) then if (jpixmin.lt.1) jpixmin = 1 if (jpixmax.gt.npixy) jpixmax = npixy endif ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax jpixi = jpix if (periodicy) then if (jpixi.lt.1) jpixi = mod(jpixi,npixy) + npixy if (jpixi.gt.npixy) jpixi = mod(jpixi-1,npixy) + 1 endif ypix = ymin + (jpix-0.5)*pixwidthy dy = ypix - y(i) do ipix = ipixmin,ipixmax ipixi = ipix if (periodicx) then if (ipixi.lt.1) ipixi = mod(ipixi,npixx) + npixx if (ipixi.gt.npixx) ipixi = mod(ipixi-1,npixx) + 1 endif xpix = xmin + (ipix-0.5)*pixwidthx dx = xpix - x(i) q2 = (dx*dx + dy*dy)*hi1*hi1 ! !--SPH kernel ! wab = wfunc(q2) ! !--calculate data value at this pixel using the summation interpolant ! datsmooth(ipixi,jpixi) = datsmooth(ipixi,jpixi) + term*wab if (normalise) datnorm(ipixi,jpixi) = datnorm(ipixi,jpixi) + termnorm*wab enddo enddo enddo over_parts ! !--normalise dat array ! if (normalise) then where (datnorm > 0.) datsmooth = datsmooth/datnorm end where endif return end subroutine interpolate2D !-------------------------------------------------------------------------- ! ! ** this version does vector quantities ! ! Input: particle coordinates : x,y (npart) ! smoothing lengths : hh (npart) ! interpolation weights : weight (npart) ! vector data to smooth : vecx (npart) ! vecy (npart) ! ! Output: smoothed vector field : vecsmoothx (npixx,npixy) ! : vecsmoothy (npixx,npixy) ! ! Daniel Price, University of Exeter, March 2005 !-------------------------------------------------------------------------- subroutine interpolate2D_vec(x,y,hh,weight,vecx,vecy,itype,npart, & xmin,ymin,vecsmoothx,vecsmoothy,npixx,npixy,pixwidthx,pixwidthy,& normalise,periodicx,periodicy) implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,hh,weight,vecx,vecy integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidthx,pixwidthy real, intent(out), dimension(npixx,npixy) :: vecsmoothx,vecsmoothy logical, intent(in) :: normalise,periodicx,periodicy real, dimension(npixx,npixy) :: datnorm integer :: i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax integer :: ipixi,jpixi real :: hi,hi1,radkern,q2,wab,const real :: termnorm,termx,termy,dx,dy,xpix,ypix vecsmoothx = 0. vecsmoothy = 0. datnorm = 0. if (normalise) then print "(1x,a)",'interpolating vector field from particles to 2D grid (normalised)...' else print "(1x,a)",'interpolating vector field from particles to 2D grid (non-normalised)...' endif if (pixwidthx.le.0. .or. pixwidthy.le.0.) then print*,'interpolate2D_vec: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate2D_vec: warning: ignoring some or all particles with h < 0' endif const = cnormk2D ! normalisation constant ! !--loop over particles ! over_parts: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts ! !--skip particles with zero weights ! termnorm = const*weight(i) if (termnorm.le.0.) cycle over_parts ! !--skip particles with wrong h's ! hi = hh(i) if (hi.le.tiny(hi)) cycle over_parts ! !--set kernel related quantities ! hi1 = 1./hi radkern = radkernel*hi ! radius of the smoothing kernel termx = termnorm*vecx(i) termy = termnorm*vecy(i) ! !--for each particle work out which pixels it contributes to ! ipixmin = int((x(i) - radkern - xmin)/pixwidthx) jpixmin = int((y(i) - radkern - ymin)/pixwidthy) ipixmax = int((x(i) + radkern - xmin)/pixwidthx) + 1 jpixmax = int((y(i) + radkern - ymin)/pixwidthy) + 1 if (.not.periodicx) then if (ipixmin.lt.1) ipixmin = 1 if (ipixmax.gt.npixx) ipixmax = npixx endif if (.not.periodicy) then if (jpixmin.lt.1) jpixmin = 1 if (jpixmax.gt.npixy) jpixmax = npixy endif ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax jpixi = jpix if (periodicy) then if (jpixi.lt.1) jpixi = mod(jpixi,npixy) + npixy if (jpixi.gt.npixy) jpixi = mod(jpixi-1,npixy) + 1 endif ypix = ymin + (jpix-0.5)*pixwidthy dy = ypix - y(i) do ipix = ipixmin,ipixmax ipixi = ipix if (periodicx) then if (ipixi.lt.1) ipixi = mod(ipixi,npixx) + npixx if (ipixi.gt.npixx) ipixi = mod(ipixi-1,npixx) + 1 endif xpix = xmin + (ipix-0.5)*pixwidthx dx = xpix - x(i) q2 = (dx*dx + dy*dy)*hi1*hi1 ! !--SPH kernel ! wab = wfunc(q2) ! !--calculate data value at this pixel using the summation interpolant ! vecsmoothx(ipixi,jpixi) = vecsmoothx(ipixi,jpixi) + termx*wab vecsmoothy(ipixi,jpixi) = vecsmoothy(ipixi,jpixi) + termy*wab if (normalise) datnorm(ipixi,jpixi) = datnorm(ipixi,jpixi) + termnorm*wab enddo enddo enddo over_parts ! !--normalise dat arrays ! if (normalise) then where (datnorm > 0.) vecsmoothx = vecsmoothx/datnorm vecsmoothy = vecsmoothy/datnorm end where endif return end subroutine interpolate2D_vec !-------------------------------------------------------------------------- ! subroutine to interpolate from particle data to even grid of pixels ! ! this version takes any 1D cross section through a 2D data set ! the 1D line is specified by two points, (x1,y1) and (x2,y2) ! (ie. this is for arbitrary oblique cross sections) ! ! NB: A similar version could be used for 2D oblique cross sections ! of 3D data. In this case we would need to find the intersection ! between the smoothing sphere and the cross section plane. However ! in 3D it is simpler just to rotate the particles first and then take ! a straight cross section. ! ! Input: particle coordinates : x,y (npart) ! smoothing lengths : hh (npart) ! interpolation weights : weight (npart) ! scalar data to smooth : dat (npart) ! ! Output: smoothed data : datsmooth (npixx) ! ! Daniel Price, Institute of Astronomy, Cambridge, Feb 2004 !-------------------------------------------------------------------------- subroutine interpolate2D_xsec(x,y,hh,weight,dat,itype,npart,& x1,y1,x2,y2,datsmooth,npixx,normalise) implicit none integer, intent(in) :: npart,npixx real, intent(in), dimension(npart) :: x,y,hh,weight,dat integer, intent(in), dimension(npart) :: itype real, intent(in) :: x1,y1,x2,y2 real, intent(out), dimension(npixx) :: datsmooth logical, intent(in) :: normalise real, dimension(npixx) :: datnorm integer :: i,ipix,ipixmin,ipixmax real :: hi,hi1,radkern,q2,wab,const real :: term,termnorm,dx,dy,xpix,ypix,pixwidth,xpixwidth,xlength real :: gradient,yintercept,aa,bb,cc,determinant,det real :: xstart,xend,ystart,yend,rstart,rend real :: tol logical :: xsame, ysame, debug debug = .false. ! !--check for errors in input ! tol = 1.e-3 ysame = (abs(y2 - y1).lt.tol) xsame = (abs(x2 - x1).lt.tol) if (xsame.and.ysame) then print*,'error: interpolate2D_xsec: zero length cross section' return endif if (npixx.eq.0) then print*,'error: interpolate2D_xsec: npix = 0 ' return endif print*,'oblique 1D cross section through 2D data: npix =',npixx ! !--work out the equation of the line y = mx + c from the two points input ! gradient = 0. if (.not.xsame) gradient = (y2-y1)/(x2-x1) yintercept = y2 - gradient*x2 print*,'cross section line: y = ',gradient,'x + ',yintercept ! !--work out length of line and divide into pixels ! xlength = sqrt((x2-x1)**2 + (y2-y1)**2) pixwidth = xlength/real(npixx) xpixwidth = (x2 - x1)/real(npixx) if (debug) then print*,'length of line = ',xlength print*,'pixel width = ',pixwidth, ' in x direction = ',xpixwidth endif ! !--now interpolate to the line of pixels ! datsmooth = 0. datnorm = 0. const = cnormk2D ! normalisation constant ! !--loop over particles ! over_parts: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts ! !--skip particles with zero weights ! termnorm = const*weight(i) if (termnorm.le.0.) cycle over_parts ! !--skip particles with wrong h's ! hi = hh(i) if (hi.le.tiny(hi)) cycle over_parts ! !--set kernel related quantities ! hi1 = 1./hi radkern = radkernel*hi ! radius of the smoothing kernel term = termnorm*dat(i) ! !--for each particle work out which pixels it contributes to ! to do this we need to work out the two points at which the line ! intersects the particles smoothing circle ! given by the equation (x-xi)^2 + (y-yi)^2 = (2h)^2. ! The x co-ordinates of these points are the solutions to a ! quadratic with co-efficients: aa = 1. + gradient**2 bb = 2.*gradient*(yintercept - y(i)) - 2.*x(i) cc = x(i)**2 + y(i)**2 - 2.*yintercept*y(i) + yintercept**2 & - radkern**2 ! !--work out whether there are any real solutions and find them ! determinant = bb**2 - 4.*aa*cc if (determinant < 0) then !!print*,' particle ',i,': does not contribute ',x(i),y(i) else det = sqrt(determinant) xstart = (-bb - det)/(2.*aa) xend = (-bb + det)/(2.*aa) if (xstart.lt.x1) xstart = x1 if (xstart.gt.x2) xstart = x2 if (xend.gt.x2) xend = x2 if (xend.lt.x1) xend = x1 ystart = gradient*xstart + yintercept yend = gradient*xend + yintercept ! !--work out position in terms of distance (no. of pixels) along the line ! rstart = sqrt((xstart-x1)**2 + (ystart-y1)**2) rend = sqrt((xend-x1)**2 + (yend-y1)**2) ipixmin = int(rstart/pixwidth) ipixmax = int(rend/pixwidth) + 1 if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (ipixmax.lt.1) ipixmax = 1 if (ipixmax.gt.npixx) ipixmax = npixx if (ipixmin.gt.npixx) ipixmax = npixx ! !--loop over pixels, adding the contribution from this particle ! !if (debug) print*,' particle ',i,': ',ipixmin,ipixmax,xstart,x(i),xend do ipix = ipixmin,ipixmax xpix = x1 + (ipix-0.5)*xpixwidth ypix = gradient*xpix + yintercept dy = ypix - y(i) dx = xpix - x(i) q2 = (dx*dx + dy*dy)*hi1*hi1 ! !--SPH kernel ! wab = wfunc(q2) ! !--calculate data value at this pixel using the summation interpolant ! datsmooth(ipix) = datsmooth(ipix) + term*wab if (normalise) datnorm(ipix) = datnorm(ipix) + termnorm*wab enddo endif enddo over_parts ! !--normalise dat array ! if (normalise) then where (datnorm > 0.) datsmooth = datsmooth/datnorm end where endif return end subroutine interpolate2D_xsec !-------------------------------------------------------------------------- ! subroutine to render particles onto a pixel array ! at the maximum or minimum colour ! ! Written by Daniel Price 21/7/2008 !-------------------------------------------------------------------------- subroutine interpolate_part(x,y,hh,npart,xmin,ymin,datsmooth,npixx,npixy,pixwidth,datval,brightness) implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,hh real, intent(in) :: xmin,ymin,pixwidth,datval real, intent(inout), dimension(npixx,npixy) :: datsmooth real, intent(inout), dimension(npixx,npixy), optional :: brightness integer :: i if (pixwidth.le.0.) then print "(1x,a)",'interpolate_part: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate_part: warning: ignoring some or all particles with h < 0' endif ! !--loop over particles ! if (present(brightness)) then do i=1,npart call interpolate_part1(x(i),y(i),hh(i),xmin,ymin,datsmooth,npixx,npixy,pixwidth,datval) enddo else do i=1,npart call interpolate_part1(x(i),y(i),hh(i),xmin,ymin,datsmooth,npixx,npixy,pixwidth,datval,brightness) enddo endif return end subroutine interpolate_part !-------------------------------------------------------------------------- ! subroutine to render a single particle onto a pixel array ! ! Written by Daniel Price 21/7/2008 !-------------------------------------------------------------------------- subroutine interpolate_part1(xi,yi,hi,xmin,ymin,datsmooth,npixx,npixy,pixwidth,datval,brightness) implicit none real, intent(in) :: xi,yi,hi,xmin,ymin,pixwidth,datval integer, intent(in) :: npixx,npixy real, intent(inout), dimension(npixx,npixy) :: datsmooth real, intent(inout), dimension(npixx,npixy), optional :: brightness integer :: ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax real :: radkern,radkern2,rab2 real :: dx,dy2,xpix,ypix ! !--skip particles with wrong h's ! if (hi.le.tiny(hi)) return ! !--set kernel related quantities ! radkern = max(hi,2.*pixwidth) radkern2 = radkern*radkern ! radius of the smoothing kernel ! !--for each particle work out which pixels it contributes to ! ipixmin = int((xi - radkern - xmin)/pixwidth) jpixmin = int((yi - radkern - ymin)/pixwidth) ipixmax = int((xi + radkern - xmin)/pixwidth) + 1 jpixmax = int((yi + radkern - ymin)/pixwidth) + 1 if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx if (jpixmax.gt.npixy) jpixmax = npixy ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax ypix = ymin + (jpix-0.5)*pixwidth dy2 = (ypix - yi)**2 do ipix = ipixmin,ipixmax xpix = xmin + (ipix-0.5)*pixwidth dx = xpix - xi rab2 = dx**2 + dy2 ! !--set data value at this pixel to maximum ! if (rab2.lt.radkern2) then datsmooth(ipix,jpix) = datval if (present(brightness)) then brightness(ipix,jpix) = 1.0 endif endif enddo enddo return end subroutine interpolate_part1 end module interpolations2D splash/src/interpolate3D.F90000644 000770 000000 00000046404 12024002774 016542 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! ! Module containing all of the routines required for interpolation ! from 3D data to a 3D grid (SLOW!) ! !---------------------------------------------------------------------- module interpolations3D use kernels, only:radkernel2,radkernel,cnormk3D implicit none public :: interpolate3D,interpolate3D_vec contains !-------------------------------------------------------------------------- ! subroutine to interpolate from particle data to even grid of pixels ! ! The data is interpolated according to the formula ! ! datsmooth(pixel) = sum_b weight_b dat_b W(r-r_b, h_b) ! ! where _b is the quantity at the neighbouring particle b and ! W is the smoothing kernel, for which we use the usual cubic spline. ! ! For a standard SPH smoothing the weight function for each particle should be ! ! weight = pmass/(rho*h^3) ! ! this version is written for slices through a rectangular volume, ie. ! assumes a uniform pixel size in x,y, whilst the number of pixels ! in the z direction can be set to the number of cross-section slices. ! ! Input: particle coordinates : x,y,z (npart) ! smoothing lengths : hh (npart) ! weight for each particle : weight (npart) ! scalar data to smooth : dat (npart) ! ! Output: smoothed data : datsmooth (npixx,npixy,npixz) ! ! Daniel Price, Institute of Astronomy, Cambridge 16/7/03 ! Revised for "splash to grid", Monash University 02/11/09 !-------------------------------------------------------------------------- subroutine interpolate3D(x,y,z,hh,weight,dat,itype,npart,& xmin,ymin,zmin,datsmooth,npixx,npixy,npixz,pixwidth,zpixwidth,& normalise,periodicx,periodicy,periodicz) implicit none integer, intent(in) :: npart,npixx,npixy,npixz real, intent(in), dimension(npart) :: x,y,z,hh,weight,dat integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,zmin,pixwidth,zpixwidth real, intent(out), dimension(npixx,npixy,npixz) :: datsmooth logical, intent(in) :: normalise,periodicx,periodicy,periodicz real, dimension(npixx,npixy,npixz) :: datnorm integer :: i,ipix,jpix,kpix integer :: iprintinterval,iprintnext integer :: ipixmin,ipixmax,jpixmin,jpixmax,kpixmin,kpixmax integer :: ipixi,jpixi,kpixi,nxpix,nwarn real :: xminpix,yminpix,zminpix,hmin !,dhmin3 real, dimension(npixx) :: dx2i real :: xi,yi,zi,hi,hi1,hi21,radkern,wab,q2,const,dyz2,dz2 real :: term,termnorm,dy,dz,ypix,zpix,xpixi !real :: t_start,t_end logical :: iprintprogress #ifdef _OPENMP integer :: omp_get_num_threads #else integer(kind=selected_int_kind(10)) :: iprogress ! up to 10 digits #endif datsmooth = 0. datnorm = 0. if (normalise) then print "(1x,a)",'interpolating from particles to 3D grid (normalised) ...' else print "(1x,a)",'interpolating from particles to 3D grid (non-normalised) ...' endif if (pixwidth.le.0.) then print "(1x,a)",'interpolate3D: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate3D: WARNING: ignoring some or all particles with h < 0' endif ! !--print a progress report if it is going to take a long time ! (a "long time" is, however, somewhat system dependent) ! iprintprogress = (npart .ge. 100000) .or. (npixx*npixy .gt.100000) ! !--loop over particles ! iprintinterval = 25 if (npart.ge.1e6) iprintinterval = 10 iprintnext = iprintinterval ! !--get starting CPU time ! !call cpu_time(t_start) xminpix = xmin - 0.5*pixwidth yminpix = ymin - 0.5*pixwidth zminpix = zmin - 0.5*zpixwidth ! !--use a minimum smoothing length on the grid to make ! sure that particles contribute to at least one pixel ! hmin = 0.5*pixwidth !dhmin3 = 1./(hmin*hmin*hmin) const = cnormk3D ! normalisation constant (3D) nwarn = 0 ! !--loop over particles ! !$omp parallel default(none) & !$omp shared(hh,z,x,y,weight,dat,itype,datsmooth,npart) & !$omp shared(xmin,ymin,zmin,radkernel,radkernel2) & !$omp shared(xminpix,yminpix,zminpix,pixwidth,zpixwidth) & !$omp shared(npixx,npixy,npixz,const) & !$omp shared(datnorm,normalise,periodicx,periodicy,periodicz) & !$omp shared(hmin) & !,dhmin3) & !$omp private(hi,xi,yi,zi,radkern,hi1,hi21) & !$omp private(term,termnorm,xpixi) & !$omp private(ipixmin,ipixmax,jpixmin,jpixmax,kpixmin,kpixmax) & !$omp private(ipix,jpix,kpix,ipixi,jpixi,kpixi) & !$omp private(dx2i,nxpix,zpix,dz,dz2,dyz2,dy,ypix,q2,wab) & !$omp reduction(+:nwarn) !$omp master #ifdef _OPENMP print "(1x,a,i3,a)",'Using ',omp_get_num_threads(),' cpus' #endif !$omp end master !$omp do schedule (guided, 2) over_parts: do i=1,npart ! !--report on progress ! #ifndef _OPENMP if (iprintprogress) then iprogress = 100*i/npart if (iprogress.ge.iprintnext) then write(*,"('(',i3,'% -',i12,' particles done)')") iprogress,i iprintnext = iprintnext + iprintinterval endif endif #endif ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts hi = hh(i) if (hi.le.0.) then cycle over_parts elseif (hi.lt.hmin) then ! !--use minimum h to capture subgrid particles ! (get better results *without* adjusting weights) ! termnorm = const*weight(i) !*(hi*hi*hi)*dhmin3 hi = hmin else termnorm = const*weight(i) endif ! !--set kernel related quantities ! xi = x(i) yi = y(i) zi = z(i) hi1 = 1./hi hi21 = hi1*hi1 radkern = radkernel*hi ! radius of the smoothing kernel !termnorm = const*weight(i) term = termnorm*dat(i) ! !--for each particle work out which pixels it contributes to ! ipixmin = int((xi - radkern - xmin)/pixwidth) jpixmin = int((yi - radkern - ymin)/pixwidth) kpixmin = int((zi - radkern - zmin)/zpixwidth) ipixmax = int((xi + radkern - xmin)/pixwidth) + 1 jpixmax = int((yi + radkern - ymin)/pixwidth) + 1 kpixmax = int((zi + radkern - zmin)/zpixwidth) + 1 if (.not.periodicx) then if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (ipixmax.gt.npixx) ipixmax = npixx ! to pixels in the image endif if (.not.periodicy) then if (jpixmin.lt.1) jpixmin = 1 if (jpixmax.gt.npixy) jpixmax = npixy endif if (.not.periodicz) then if (kpixmin.lt.1) kpixmin = 1 if (kpixmax.gt.npixz) kpixmax = npixz endif ! !--precalculate an array of dx2 for this particle (optimisation) ! nxpix = 0 do ipix=ipixmin,ipixmax nxpix = nxpix + 1 ipixi = ipix if (periodicx) then if (ipixi.lt.1) ipixi = mod(ipixi,npixx) + npixx if (ipixi.gt.npixx) ipixi = mod(ipixi-1,npixx) + 1 endif xpixi = xminpix + ipix*pixwidth !--watch out for errors with perioic wrapping... if (nxpix.le.size(dx2i)) then dx2i(nxpix) = ((xpixi - xi)**2)*hi21 endif enddo !--if particle contributes to more than npixx pixels ! (i.e. periodic boundaries wrap more than once) ! truncate the contribution and give warning if (nxpix.gt.npixx) then nwarn = nwarn + 1 ipixmax = ipixmin + npixx - 1 endif ! !--loop over pixels, adding the contribution from this particle ! do kpix = kpixmin,kpixmax kpixi = kpix if (periodicz) then if (kpixi.lt.1) kpixi = mod(kpixi,npixz) + npixz if (kpixi.gt.npixz) kpixi = mod(kpixi-1,npixz) + 1 endif zpix = zminpix + kpix*zpixwidth dz = zpix - zi dz2 = dz*dz*hi21 do jpix = jpixmin,jpixmax jpixi = jpix if (periodicy) then if (jpixi.lt.1) jpixi = mod(jpixi,npixy) + npixy if (jpixi.gt.npixy) jpixi = mod(jpixi-1,npixy) + 1 endif ypix = yminpix + jpix*pixwidth dy = ypix - yi dyz2 = dy*dy*hi21 + dz2 nxpix = 0 do ipix = ipixmin,ipixmax nxpix = nxpix + 1 ipixi = ipix if (periodicx) then if (ipixi.lt.1) ipixi = mod(ipixi,npixx) + npixx if (ipixi.gt.npixx) ipixi = mod(ipixi-1,npixx) + 1 endif q2 = dx2i(nxpix) + dyz2 ! dx2 pre-calculated; dy2 pre-multiplied by hi21 ! !--SPH kernel - standard cubic spline ! if (q2.lt.radkernel2) then wab = wkernel(q2) ! !--calculate data value at this pixel using the summation interpolant ! !$omp atomic datsmooth(ipixi,jpixi,kpixi) = datsmooth(ipixi,jpixi,kpixi) + term*wab if (normalise) then !$omp atomic datnorm(ipixi,jpixi,kpixi) = datnorm(ipixi,jpixi,kpixi) + termnorm*wab endif endif enddo enddo enddo enddo over_parts !$omp end do !$omp end parallel if (nwarn.gt.0) then print "(a,i11,a,/,a)",' interpolate3D: WARNING: contributions truncated from ',nwarn,' particles',& ' that wrap periodic boundaries more than once' endif ! !--normalise dat array ! if (normalise) then where (datnorm > tiny(datnorm)) datsmooth = datsmooth/datnorm end where endif return end subroutine interpolate3D subroutine interpolate3D_vec(x,y,z,hh,weight,datvec,itype,npart,& xmin,ymin,zmin,datsmooth,npixx,npixy,npixz,pixwidth,zpixwidth,& normalise,periodicx,periodicy,periodicz) implicit none integer, intent(in) :: npart,npixx,npixy,npixz real, intent(in), dimension(npart) :: x,y,z,hh,weight real, intent(in), dimension(npart,3) :: datvec integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,zmin,pixwidth,zpixwidth real, intent(out), dimension(3,npixx,npixy,npixz) :: datsmooth logical, intent(in) :: normalise,periodicx,periodicy,periodicz real, dimension(npixx,npixy,npixz) :: datnorm integer :: i,ipix,jpix,kpix integer :: iprintinterval,iprintnext integer :: ipixmin,ipixmax,jpixmin,jpixmax,kpixmin,kpixmax integer :: ipixi,jpixi,kpixi,nxpix,nwarn real :: xminpix,yminpix,zminpix real, dimension(npixx) :: dx2i real :: xi,yi,zi,hi,hi1,hi21,radkern,wab,q2,const,dyz2,dz2 real :: termnorm,dy,dz,ypix,zpix,xpixi,ddatnorm real, dimension(3) :: term !real :: t_start,t_end logical :: iprintprogress #ifdef _OPENMP integer :: omp_get_num_threads #else integer(kind=selected_int_kind(10)) :: iprogress ! up to 10 digits #endif datsmooth = 0. datnorm = 0. if (normalise) then print "(1x,a)",'interpolating from particles to 3D grid (normalised) ...' else print "(1x,a)",'interpolating from particles to 3D grid (non-normalised) ...' endif if (pixwidth.le.0.) then print "(1x,a)",'interpolate3D: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate3D: WARNING: ignoring some or all particles with h < 0' endif ! !--print a progress report if it is going to take a long time ! (a "long time" is, however, somewhat system dependent) ! iprintprogress = (npart .ge. 100000) .or. (npixx*npixy .gt.100000) ! !--loop over particles ! iprintinterval = 25 if (npart.ge.1e6) iprintinterval = 10 iprintnext = iprintinterval ! !--get starting CPU time ! !call cpu_time(t_start) xminpix = xmin - 0.5*pixwidth yminpix = ymin - 0.5*pixwidth zminpix = zmin - 0.5*zpixwidth ! xmax = xmin + npixx*pixwidth ! ymax = ymin + npixy*pixwidth const = cnormk3D ! normalisation constant (3D) nwarn = 0 !$omp parallel default(none) & !$omp shared(hh,z,x,y,weight,datvec,itype,datsmooth,npart) & !$omp shared(xmin,ymin,zmin,radkernel,radkernel2) & !$omp shared(xminpix,yminpix,zminpix,pixwidth,zpixwidth) & !$omp shared(npixx,npixy,npixz,const) & !$omp shared(datnorm,normalise,periodicx,periodicy,periodicz) & !$omp private(hi,xi,yi,zi,radkern,hi1,hi21) & !$omp private(term,termnorm,xpixi) & !$omp private(ipixmin,ipixmax,jpixmin,jpixmax,kpixmin,kpixmax) & !$omp private(ipix,jpix,kpix,ipixi,jpixi,kpixi) & !$omp private(dx2i,nxpix,zpix,dz,dz2,dyz2,dy,ypix,q2,wab) & !$omp reduction(+:nwarn) !$omp master #ifdef _OPENMP print "(1x,a,i3,a)",'Using ',omp_get_num_threads(),' cpus' #endif !$omp end master ! !--loop over particles ! !$omp do schedule (guided, 2) over_parts: do i=1,npart ! !--report on progress ! #ifndef _OPENMP if (iprintprogress) then iprogress = 100*i/npart if (iprogress.ge.iprintnext) then write(*,"('(',i3,'% -',i12,' particles done)')") iprogress,i iprintnext = iprintnext + iprintinterval endif endif #endif ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts hi = hh(i) if (hi.le.0.) cycle over_parts ! !--set kernel related quantities ! xi = x(i) yi = y(i) zi = z(i) hi1 = 1./hi hi21 = hi1*hi1 radkern = radkernel*hi ! radius of the smoothing kernel termnorm = const*weight(i) term(:) = termnorm*datvec(i,:) ! !--for each particle work out which pixels it contributes to ! ipixmin = int((xi - radkern - xmin)/pixwidth) jpixmin = int((yi - radkern - ymin)/pixwidth) kpixmin = int((zi - radkern - zmin)/zpixwidth) ipixmax = int((xi + radkern - xmin)/pixwidth) + 1 jpixmax = int((yi + radkern - ymin)/pixwidth) + 1 kpixmax = int((zi + radkern - zmin)/zpixwidth) + 1 if (.not.periodicx) then if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (ipixmax.gt.npixx) ipixmax = npixx ! to pixels in the image endif if (.not.periodicy) then if (jpixmin.lt.1) jpixmin = 1 if (jpixmax.gt.npixy) jpixmax = npixy endif if (.not.periodicz) then if (kpixmin.lt.1) kpixmin = 1 if (kpixmax.gt.npixz) kpixmax = npixz endif ! !--precalculate an array of dx2 for this particle (optimisation) ! nxpix = 0 do ipix=ipixmin,ipixmax nxpix = nxpix + 1 ipixi = ipix if (periodicx) then if (ipixi.lt.1) ipixi = mod(ipixi,npixx) + npixx if (ipixi.gt.npixx) ipixi = mod(ipixi-1,npixx) + 1 endif xpixi = xminpix + ipix*pixwidth !--watch out for errors with perioic wrapping... if (nxpix.le.size(dx2i)) then dx2i(nxpix) = ((xpixi - xi)**2)*hi21 endif enddo !--if particle contributes to more than npixx pixels ! (i.e. periodic boundaries wrap more than once) ! truncate the contribution and give warning if (nxpix.gt.npixx) then nwarn = nwarn + 1 ipixmax = ipixmin + npixx - 1 endif ! !--loop over pixels, adding the contribution from this particle ! do kpix = kpixmin,kpixmax kpixi = kpix if (periodicz) then if (kpixi.lt.1) kpixi = mod(kpixi,npixz) + npixz if (kpixi.gt.npixz) kpixi = mod(kpixi-1,npixz) + 1 endif zpix = zminpix + kpix*zpixwidth dz = zpix - zi dz2 = dz*dz*hi21 do jpix = jpixmin,jpixmax jpixi = jpix if (periodicy) then if (jpixi.lt.1) jpixi = mod(jpixi,npixy) + npixy if (jpixi.gt.npixy) jpixi = mod(jpixi-1,npixy) + 1 endif ypix = yminpix + jpix*pixwidth dy = ypix - yi dyz2 = dy*dy*hi21 + dz2 nxpix = 0 do ipix = ipixmin,ipixmax ipixi = ipix if (periodicx) then if (ipixi.lt.1) ipixi = mod(ipixi,npixx) + npixx if (ipixi.gt.npixx) ipixi = mod(ipixi-1,npixx) + 1 endif nxpix = nxpix + 1 q2 = dx2i(nxpix) + dyz2 ! dx2 pre-calculated; dy2 pre-multiplied by hi21 ! !--SPH kernel - standard cubic spline ! if (q2.lt.radkernel2) then wab = wkernel(q2) ! !--calculate data value at this pixel using the summation interpolant ! !$omp atomic datsmooth(1,ipixi,jpixi,kpixi) = datsmooth(1,ipixi,jpixi,kpixi) + term(1)*wab !$omp atomic datsmooth(2,ipixi,jpixi,kpixi) = datsmooth(2,ipixi,jpixi,kpixi) + term(2)*wab !$omp atomic datsmooth(3,ipixi,jpixi,kpixi) = datsmooth(3,ipixi,jpixi,kpixi) + term(3)*wab if (normalise) then !$omp atomic datnorm(ipixi,jpixi,kpixi) = datnorm(ipixi,jpixi,kpixi) + termnorm*wab endif endif enddo enddo enddo enddo over_parts !$omp end do !$omp end parallel if (nwarn.gt.0) then print "(a,i11,a,/,a)",' interpolate3D: WARNING: contributions truncated from ',nwarn,' particles',& ' that wrap periodic boundaries more than once' endif ! !--normalise dat array ! if (normalise) then !$omp parallel do default(none) schedule(static) & !$omp shared(datsmooth,datnorm,npixz,npixy,npixx) & !$omp private(kpix,jpix,ipix,ddatnorm) do kpix=1,npixz do jpix=1,npixy do ipix=1,npixx if (datnorm(ipix,jpix,kpix).gt.tiny(datnorm)) then ddatnorm = 1./datnorm(ipix,jpix,kpix) datsmooth(1,ipix,jpix,kpix) = datsmooth(1,ipix,jpix,kpix)*ddatnorm datsmooth(2,ipix,jpix,kpix) = datsmooth(2,ipix,jpix,kpix)*ddatnorm datsmooth(3,ipix,jpix,kpix) = datsmooth(3,ipix,jpix,kpix)*ddatnorm endif enddo enddo enddo !$omp end parallel do endif return end subroutine interpolate3D_vec !------------------------------------------------------------ ! interface to kernel routine to avoid problems with openMP !----------------------------------------------------------- real function wkernel(q2) use kernels, only:wfunc implicit none real, intent(in) :: q2 wkernel = wfunc(q2) end function wkernel end module interpolations3D splash/src/interpolate3D_opacity.f90000644 000770 000000 00000034470 12241043735 020335 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module interpolate3D_opacity use projections3D, only:wfromtable,coltable use kernels, only:radkernel2 use sort, only:indexx use interpolation, only:weight_sink implicit none contains !-------------------------------------------------------------------------- ! $Id: interpolate3D_opacity.f90,v 1.16 2007/11/20 17:05:35 dprice Exp $ ! ! subroutine to do a ray trace through the particle data ! ! we use the radiation transport equation along a ray, that is ! the change in intensity from one side of a particle to the other is ! given by: ! ! I_nu = I_nu(0) exp(-tau_i) + S_nu (1 - exp(-tau_i)) ! ! where tau_i is the integrated optical depth through the particle, ! and S_nu is the colour calculated from a colour table for the rendered data. ! We calculate an intensity in red, green and blue for colour plots. ! ! tau_i = kappa \int rho dz ! ! this is calculated using the SPH kernel for rho, so for each pixel ! the optical depth is incremented as the sum ! ! tau_i = kappa \sum_j m_j \int W dz ! ! where \int W dz is the SPH kernel integrated along one spatial dimension. ! This is interpolated from a pre-calculated table (see module projections3D for this). ! ! kappa is the monochromatic mass extinction coefficient ! (particle cross section per unit mass) and is a constant for all particles ! which must be given as input (although see below for calculations of a ! meaningful values for kappa in terms of "surface depth in units of smoothing lengths") ! ! Input: particle coordinates : x,y,z (npart) - note that z is only required for perspective ! particle masses : pmass (npmass) ! smoothing lengths : hh (npart) ! weight : m/(h^3 rho) (not used, but skips particles with w <= 0) ! scalar data to smooth : dat (npart) ! ! Particle masses can be sent in as either a single scalar (npmass = 1) ! or as an array of length npart (npmass=npart) ! ! Settings: zobs, dz1 : settings for 3D projection ! rkappa : particle cross section per unit mass ! ! Output: smoothed data : datsmooth (npixx,npixy) ! brightness array : brightness (npixx,npixy) ! !-------------------------------------------------------------------------- subroutine interp3D_proj_opacity(x,y,z,pmass,npmass,hh,weight,dat,zorig,itype,npart, & xmin,ymin,datsmooth,brightness,npixx,npixy,pixwidth,zobserver,dscreenfromobserver, & rkappa,zcut) implicit none real, parameter :: pi=3.1415926536 integer, intent(in) :: npart,npixx,npixy,npmass real, intent(in), dimension(npart) :: x,y,z,hh,weight,dat,zorig real, intent(in), dimension(npmass) :: pmass integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidth,zobserver,dscreenfromobserver, & zcut,rkappa real, dimension(npixx,npixy), intent(out) :: datsmooth, brightness integer :: i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax,nused,nsink integer :: iprintinterval, iprintnext,itmin integer, dimension(npart) :: iorder integer(kind=selected_int_kind(12)) :: ipart real :: hi,hi1,hi21,radkern,q2,wab,pmassav real :: term,dy,dy2,ypix,zfrac,hav,zcutoff real :: fopacity,tau,rkappatemp,termi,xi,yi real :: t_start,t_end,t_used,tsec logical :: iprintprogress,adjustzperspective,rendersink real, dimension(npixx) :: xpix,dx2i real :: xminpix,yminpix !#ifdef _OPENMP ! integer :: OMP_GET_NUM_THREADS !#else integer(kind=selected_int_kind(12)) :: iprogress !#endif datsmooth = 0. term = 0. brightness = 0. print "(1x,a)",'ray tracing from particles to pixels...' if (pixwidth.le.0.) then print "(a)",'interpolate3D_opacity: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate3D_opacity: warning: ignoring some or all particles with h < 0' endif !--check that npmass is sensible if (npmass.lt.1 .or. npmass.gt.npart) then print*,'interpolate3D_opacity: ERROR in input number of particle masses ' return endif !--these values for npmass are not sensible but the routine will still work if (npmass.ne.1 .and. npmass.ne.npart) then print*,'WARNING: interpolate3D_opacity: number of particle masses input =',npmass endif if (abs(dscreenfromobserver).gt.tiny(dscreenfromobserver)) then adjustzperspective = .true. zcutoff = zobserver else adjustzperspective = .false. zcutoff = huge(zobserver) endif ! !--kappa is the opacity in units of length^2/mass ! sent as an input parameter as it should be kept constant throughout the simulation ! ! However we compute a reasonable estimate below based on the current plot so that ! we can give the "actual" optical depth for the current frame in terms of number of ! smoothing lengths. This is purely for diagnostic purposes only. ! !--calculate average h hav = sum(hh(1:npart))/real(npart) !--average particle mass pmassav = sum(pmass(1:npmass))/real(npmass) rkappatemp = pi*hav*hav/(pmassav*coltable(0)) print*,'average h = ',hav,' average mass = ',pmassav print "(1x,a,f6.2,a)",'typical surface optical depth is ~',rkappatemp/rkappa,' smoothing lengths' ! !--print a progress report if it is going to take a long time ! (a "long time" is, however, somewhat system dependent) ! iprintprogress = (npart .ge. 100000) .or. (npixx*npixy .gt.100000) ! !--loop over particles ! iprintinterval = 25 if (npart.ge.1e6) iprintinterval = 10 iprintnext = iprintinterval ! !--get starting CPU time ! call cpu_time(t_start) ! !--first sort the particles in z so that we do the opacity in the correct order ! call indexx(npart,z,iorder) ! !--store x value for each pixel (for optimisation) ! xminpix = xmin - 0.5*pixwidth yminpix = ymin - 0.5*pixwidth do ipix=1,npixx xpix(ipix) = xminpix + ipix*pixwidth enddo nused = 0 nsink = 0 !!$OMP PARALLEL default(none) & !!$OMP SHARED(hh,z,x,y,zorig,pmass,dat,itype,datsmooth,npmass,npart) & !!$OMP SHARED(xmin,ymin,xminpix,yminpix,xpix,pixwidth) & !!$OMP SHARED(npixx,npixy,dscreenfromobserver,zobserver,adjustzperspective) & !!$OMP SHARED(zcut,zcutoff,iorder,rkappa,brightness) & !!$OMP PRIVATE(hi,zfrac,xi,yi,radkern) & !!$OMP PRIVATE(hi1,hi21,term,termi) & !!$OMP PRIVATE(ipixmin,ipixmax,jpixmin,jpixmax) & !!$OMP PRIVATE(dx2i,q2,ypix,dy,dy2,wab) & !!$OMP PRIVATE(ipart,i,ipix,jpix,tau,fopacity) & !!$OMP REDUCTION(+:nused) !!$OMP MASTER !#ifdef _OPENMP ! print "(1x,a,i3,a)",'Using ',OMP_GET_NUM_THREADS(),' cpus' !#endif !!$OMP END MASTER !!$OMP DO ORDERED SCHEDULE(dynamic) over_particles: do ipart=1,npart ! !--report on progress ! !#ifndef _OPENMP if (iprintprogress) then iprogress = 100*(ipart/npart) if (iprogress.ge.iprintnext) then write(*,"('(',i3,'% -',i12,' particles done)')") iprogress,ipart iprintnext = iprintnext + iprintinterval endif endif !#endif ! !--render in order from back to front ! i = iorder(ipart) ! !--skip particles with itype < 0 ! if (itype(i) < 0) cycle over_particles ! !--skip particles with weight < 0 ! but not if weight == weight_sink (=-1) ! rendersink = .false. if (abs(weight(i) - weight_sink) < tiny(0.)) then rendersink = .true. elseif (weight(i) <= 0.) then cycle over_particles endif ! !--allow slicing [take only particles with z(unrotated) < zcut] ! particle_within_zcut: if (zorig(i).lt.zcut .and. z(i).lt.zcutoff) then ! count particles within slice nused = nused + 1 ! !--adjust h according to 3D perspective ! need to be careful -- the kernel quantities ! change with z (e.g. radkern, r^2/h^2) ! but *not* the 1/h^2 in tau (because the change in 1/h^2 in tau ! would be cancelled by the corresponding change to h^2 in kappa) ! hi = hh(i) if (hi.le.0.) then cycle over_particles elseif (adjustzperspective) then zfrac = abs(dscreenfromobserver/(z(i)-zobserver)) hi = hi*zfrac endif !--these are the quantities used in the kernel r^2/h^2 radkern = 2.*hi hi1 = 1./hi hi21 = hi1*hi1 !--this is the term which multiplies tau if (npmass.eq.npart) then term = pmass(i)/(hh(i)*hh(i)) else term = pmass(1)/(hh(i)*hh(i)) endif ! !--determine colour contribution of current point ! (work out position in colour table) ! ! dati = dat(i) xi = x(i) yi = y(i) termi = dat(i) ! !--sink particles can have weight set to -1 ! indicating that we should include them in the rendering ! if (rendersink) then termi = pmass(i)/(4./3.*pi*hh(i)**3) ! define "density" of a sink nsink = nsink + 1 endif ! !--for each particle work out which pixels it contributes to ! ipixmin = int((xi - radkern - xmin)/pixwidth) jpixmin = int((yi - radkern - ymin)/pixwidth) ipixmax = int((xi + radkern - xmin)/pixwidth) + 1 jpixmax = int((yi + radkern - ymin)/pixwidth) + 1 if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx ! (note that this optimises if (jpixmax.gt.npixy) jpixmax = npixy ! much better than using min/max) ! !--precalculate an array of dx2 for this particle (optimisation) ! do ipix=ipixmin,ipixmax dx2i(ipix) = ((xpix(ipix) - xi)**2)*hi21 enddo ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax ypix = yminpix + jpix*pixwidth dy = ypix - yi dy2 = dy*dy*hi21 do ipix = ipixmin,ipixmax q2 = dx2i(ipix) + dy2 ! !--SPH kernel - integral through cubic spline ! interpolate from a pre-calculated table ! if (q2.lt.radkernel2) then wab = wfromtable(q2) ! !--get incremental tau for this pixel from the integrated SPH kernel ! tau = rkappa*wab*term fopacity = 1. - exp(-tau) ! !--render, obscuring previously drawn pixels by relevant amount ! also calculate total brightness (`transparency') of each pixel ! datsmooth(ipix,jpix) = (1.-fopacity)*datsmooth(ipix,jpix) + fopacity*termi brightness(ipix,jpix) = brightness(ipix,jpix) + fopacity endif enddo enddo endif particle_within_zcut enddo over_particles !!$OMP END DO !!$OMP END PARALLEL ! !--get ending CPU time ! if (nsink > 99) then print*,'rendered ',nsink,' sink particles' elseif (nsink > 0) then print "(1x,a,i2,a)",'rendered ',nsink,' sink particles' endif call cpu_time(t_end) t_used = t_end - t_start if (t_used.gt.60.) then itmin = int(t_used/60.) tsec = t_used - (itmin*60.) print "(1x,a,i4,a,f5.2,1x,a)",'completed in',itmin,' min ',tsec,'s' else print "(1x,a,f5.2,1x,a)",'completed in ',t_used,'s' endif if (zcut.lt.huge(zcut)) print*,'slice contains ',nused,' of ',npart,' particles' return end subroutine interp3D_proj_opacity subroutine interp3D_proj_opacity_writeppm(datsmooth,brightness,npixx,npixy,datmin,datmax,istep) use colours, only:rgbtable,ncolours implicit none integer, intent(in) :: npixx,npixy real, intent(in), dimension(npixx,npixy) :: datsmooth,brightness real, intent(in) :: datmin,datmax integer, intent(in) :: istep character(len=120) :: filename ! real, dimension(3,npixx,npixy) :: rgb real, dimension(3) :: rgbi,drgb real :: dati,ddatrange,datfraci,ftable integer :: ipix,jpix,ir,ib,ig,ierr,maxcolour,indexi ! !--check for errors ! if (abs(datmax-datmin).gt.tiny(datmin)) then ddatrange = 1./abs(datmax-datmin) else print "(a)",'error: datmin=datmax : pointless writing ppm file' return endif ! !--write PPM-- ! write(filename,"(a,i5.5,a)") 'splash_',istep,'.ppm' open(unit=78,file=filename,status='replace',form='formatted',iostat=ierr) if (ierr /=0) then print*,'error opening ppm file' return endif print "(a)", 'writing to file '//trim(filename) ! !--PPM header ! maxcolour = 255 write(78,"(a)") 'P3' write(78,"(a)") '# splash.ppm created by splash (c) 2005-2007 Daniel Price' write(78,"(i4,1x,i4)") npixx, npixy write(78,"(i3)") maxcolour !--pixel information do jpix = npixy,1,-1 do ipix = 1,npixx dati = datsmooth(ipix,jpix) datfraci = (dati - datmin)*ddatrange datfraci = max(datfraci,0.) datfraci = min(datfraci,1.) !--define colour for current particle ftable = datfraci*ncolours indexi = int(ftable) + 1 indexi = min(indexi,ncolours) if (indexi.lt.ncolours) then !--do linear interpolation from colour table drgb(:) = rgbtable(:,indexi+1) - rgbtable(:,indexi) rgbi(:) = rgbtable(:,indexi) + (ftable - int(ftable))*drgb(:) else rgbi(:) = rgbtable(:,indexi) endif rgbi(:) = rgbi(:)*min(brightness(ipix,jpix),1.0) ir = max(min(int(rgbi(1)*maxcolour),maxcolour),0) ig = max(min(int(rgbi(2)*maxcolour),maxcolour),0) ib = max(min(int(rgbi(3)*maxcolour),maxcolour),0) write(78,"(i3,1x,i3,1x,i3,2x)") ir,ig,ib enddo enddo close(unit=78) return end subroutine interp3D_proj_opacity_writeppm end module interpolate3D_opacity splash/src/interpolate3D_proj_geom.F90000644 000770 000000 00000026713 12051341744 020607 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! ! Module containing routines required for 3D projections ! in different coordinate systems ! !---------------------------------------------------------------------- module projections3Dgeom use projections3D, only:setup_integratedkernel,wfromtable,coltable use kernels, only:radkernel,radkernel2 implicit none public :: interpolate3D_proj_geom ! public :: interpolate3D_proj_geom_vec #ifdef _OPENMP character(len=5), parameter :: str = 'cpu s' #else character(len=1), parameter :: str = 's' #endif contains !-------------------------------------------------------------------------- ! subroutine to interpolate from particle data to even grid of pixels ! ! The data is smoothed using the SPH summation interpolant, ! that is, we compute the smoothed array according to ! ! datsmooth(pixel) = sum_b weight_b dat_b W(r-r_b, h_b) ! ! where _b is the quantity at the neighbouring particle b and ! W is the smoothing kernel, for which we use the usual cubic spline ! ! ** This version is for 3D projections in alternative coordinate ! ** systems, e.g. \Int rho d\phi ! ! The (dimensionless) weight for each particle should be ! ! weight = pmass/(rho*h^3) ! ! the interface is written in this form to avoid floating exceptions ! on physically scaled data. ! ! Input: particle coordinates : x,y,z (npart) ! smoothing lengths : hh (npart) ! weight for each particle : weight (npart) ! scalar data to smooth : dat (npart) ! ! Output: smoothed data : datsmooth (npixx,npixy) ! ! Written by Daniel Price July 2011 !-------------------------------------------------------------------------- subroutine interpolate3D_proj_geom(x,y,z,hh,weight,dat,itype,npart, & xmin,ymin,datsmooth,npixx,npixy,pixwidthx,pixwidthy,normalise,igeom,& iplotx,iploty,iplotz,ix) use geometry, only:igeom_cartesian,coord_transform,coord_is_length, & coord_transform_limits,igeom_cylindrical implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,z,hh,weight,dat integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidthx,pixwidthy real, intent(out), dimension(npixx,npixy) :: datsmooth logical, intent(inout) :: normalise integer, intent(in) :: igeom,iplotx,iploty,iplotz integer, dimension(3), intent(in) :: ix real, dimension(npixx,npixy) :: datnorm real, parameter :: pi = 3.1415926536 integer :: ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax integer :: ixcoord,iycoord,izcoord integer :: iprintinterval, iprintnext, itmin #ifdef _OPENMP integer :: omp_get_num_threads,i #else integer(kind=selected_int_kind(10)) :: iprogress,i ! up to 10 digits #endif real, dimension(3) :: xcoord, xpix real, dimension(3), save :: xpixmin, xpixmax, xci, xi !$omp threadprivate(xpixmin,xpixmax,xci,xi) real :: hi,hi1,hi21,radkern,wab,q2,xminpix,yminpix real :: term,termnorm,dx,dx2,dy,dy2 real :: xmax,ymax real :: t_start,t_end,t_used,tsec logical :: iprintprogress,islengthx,islengthy,islengthz datsmooth = 0. term = 0. if (normalise) then print "(1x,a)",'projecting (normalised, non-cartesian) from particles to pixels...' datnorm = 0. else print "(1x,a)",'projecting (non-cartesian) from particles to pixels...' endif if (pixwidthx.le.0. .or. pixwidthy.le.0) then print "(1x,a)",'interpolate3D_proj_geom: error: pixel width <= 0' return endif if (any(hh(1:npart).le.0.)) then print*,'interpolate3D_proj_geom: warning: ignoring some or all particles with h <= 0' endif ! !--get plotted coordinates in range 1->ndim ! ixcoord = iplotx - ix(1) + 1 iycoord = iploty - ix(1) + 1 izcoord = iplotz - ix(1) + 1 if (ixcoord.le.0 .or. ixcoord.gt.3) then print*,' ERROR finding x coordinate offset, cannot render' return endif if (iycoord.le.0 .or. iycoord.gt.3) then print*,' ERROR finding y coordinate offset, cannot render' return endif if (izcoord.le.0 .or. izcoord.gt.3) then print*,' ERROR finding y coordinate offset, cannot render' return endif ! !--check if coordinate is a length (i.e., not an angle) ! islengthx = coord_is_length(ixcoord,igeom) islengthy = coord_is_length(iycoord,igeom) islengthz = coord_is_length(izcoord,igeom) !print*,' islength = ',islengthx,islengthy,islengthz !print*,' y axis is ',iycoord !print*,' x axis is ',ixcoord ! !--if z coordinate is not a length, use normalised interpolation ! (e.g. azimuthally averaged density) ! if (.not.islengthz) normalise = .true. ! !--check column density table has actually been setup ! if (abs(coltable(1)).le.1.e-5) then call setup_integratedkernel endif ! !--print a progress report if it is going to take a long time ! (a "long time" is, however, somewhat system dependent) ! iprintprogress = (npart .ge. 100000) .or. (npixx*npixy .gt.100000) ! !--loop over particles ! iprintinterval = 25 if (npart.ge.1e6) iprintinterval = 10 iprintnext = iprintinterval ! !--get starting CPU time ! call cpu_time(t_start) xminpix = xmin - 0.5*pixwidthx yminpix = ymin - 0.5*pixwidthy xmax = xmin + npixx*pixwidthx ymax = ymin + npixy*pixwidthy ! !--use a minimum smoothing length on the grid to make ! sure that particles contribute to at least one pixel ! ! hmin = 0.5*max(pixwidthx,pixwidthy) !$omp parallel default(none) & !$omp shared(hh,z,x,y,weight,dat,itype,datsmooth,npart) & !$omp shared(xmin,ymin,xmax,ymax,xminpix,yminpix,pixwidthx,pixwidthy) & !$omp shared(npixx,npixy,ixcoord,iycoord,izcoord,islengthx,islengthy,islengthz,igeom) & !$omp shared(datnorm,normalise,radkernel,radkernel2) & !$omp private(hi,radkern) & !$omp private(hi1,hi21,term,termnorm) & !$omp private(q2,dx,dx2,dy,dy2,wab,xcoord,xpix) & !$omp private(i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax) !$omp master !$ print "(1x,a,i3,a)",'Using ',omp_get_num_threads(),' cpus' !$omp end master !$omp do schedule (guided, 2) over_particles: do i=1,npart ! !--report on progress ! #ifndef _OPENMP if (iprintprogress) then iprogress = 100*i/npart if (iprogress.ge.iprintnext) then write(*,"('(',i3,'% -',i12,' particles done)')") iprogress,i iprintnext = iprintnext + iprintinterval endif endif #endif ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_particles ! !--set h related quantities ! hi = hh(i) if (hi.le.0.) cycle over_particles radkern = radkernel*hi ! radius of the smoothing kernel ! !--get limits of contribution from particle in cartesian space ! xci(1) = x(i) xci(2) = y(i) xci(3) = z(i) xpixmin(:) = xci(:) - radkern xpixmax(:) = xci(:) + radkern ! !--transform these into limits of the contributions ! in the new coordinate system ! !print*,' limits in cart = ',(xpixmin(ipix),xpixmax(ipix),ipix=1,3) call coord_transform_limits(xpixmin,xpixmax,igeom_cartesian,igeom,3) !--get particle coordinates in transformed space call coord_transform(xci,3,igeom_cartesian,xi,3,igeom) !print*,' limits in cyl = ',(xpixmin(ipix),xpixmax(ipix),ipix=1,3) !read* ! !--now work out contributions to pixels in the the transformed space ! ipixmax = int((xpixmax(ixcoord) - xmin)/pixwidthx) if (ipixmax.lt.1) cycle over_particles jpixmax = int((xpixmax(iycoord) - ymin)/pixwidthy) if (jpixmax.lt.1) cycle over_particles ipixmin = int((xpixmin(ixcoord) - xmin)/pixwidthx) if (ipixmin.gt.npixx) cycle over_particles jpixmin = int((xpixmin(iycoord) - ymin)/pixwidthy) if (jpixmin.gt.npixy) cycle over_particles if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx ! (note that this optimises if (jpixmax.gt.npixy) jpixmax = npixy ! much better than using min/max) !print*,i,' contributing to ',ipixmin,ipixmax,jpixmin,jpixmax !read* ! !--set kernel related quantities ! hi1 = 1./hi hi21 = hi1*hi1 ! h gives the z length scale (NB: no perspective) if (islengthz) then termnorm = weight(i)*hi elseif (igeom.eq.igeom_cylindrical) then termnorm = weight(i)*atan(radkern/xi(ixcoord))/pi else termnorm = weight(i) endif term = termnorm*dat(i) ! !--loop over pixels, adding the contribution from this particle ! if (islengthz) then xcoord(izcoord) = 1. !xci(izcoord) else xcoord(izcoord) = 0. ! use phi=0 so get x = r cos(phi) = r endif do jpix = jpixmin,jpixmax xcoord(iycoord) = yminpix + jpix*pixwidthy do ipix = ipixmin,ipixmax xcoord(ixcoord) = xminpix + ipix*pixwidthx !--now transform to get location of pixel in cartesians call coord_transform(xcoord,3,igeom,xpix,3,igeom_cartesian) !--find distances using cartesians and perform interpolation dy = xpix(iycoord) - xci(iycoord) dx = xpix(ixcoord) - xci(ixcoord) dx2 = dx*dx dy2 = dy*dy q2 = (dx2 + dy2)*hi21 ! !--SPH kernel - integral through cubic spline ! interpolate from a pre-calculated table ! if (q2.lt.radkernel2) then wab = wfromtable(q2) ! !--calculate data value at this pixel using the summation interpolant ! !$omp atomic datsmooth(ipix,jpix) = datsmooth(ipix,jpix) + term*wab if (normalise) then !$omp atomic datnorm(ipix,jpix) = datnorm(ipix,jpix) + termnorm*wab endif endif enddo enddo enddo over_particles !$omp end do !$omp end parallel ! !--normalise dat array ! if (normalise) then !--normalise everywhere (required if not using SPH weighting) where (datnorm > tiny(datnorm)) datsmooth = datsmooth/datnorm end where endif ! !--get ending CPU time ! call cpu_time(t_end) t_used = t_end - t_start if (t_used.gt.60.) then itmin = int(t_used/60.) tsec = t_used - (itmin*60.) print "(1x,a,i4,a,f5.2,1x,a)",'completed in',itmin,' min ',tsec,trim(str) else print "(1x,a,f5.2,1x,a)",'completed in ',t_used,trim(str) endif return end subroutine interpolate3D_proj_geom end module projections3Dgeom splash/src/interpolate3D_projection.F90000644 000770 000000 00000067667 12341303633 021014 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! ! Module containing all of the routines required for 3D projections ! (where rendered quantity is integrated along the line of sight) ! !---------------------------------------------------------------------- module projections3D implicit none integer, parameter :: maxcoltable = 1000 real, dimension(0:maxcoltable) :: coltable real, private :: dq2table = 4./maxcoltable real, private :: ddq2table = maxcoltable/4. public :: setup_integratedkernel public :: interpolate3D_projection public :: interpolate3D_proj_vec,interp3D_proj_vec_synctron public :: wfromtable contains subroutine setup_integratedkernel !------------------------------------------------------------- ! tabulates the integral through the cubic spline kernel ! tabulated in (r/h)**2 so that sqrt is not necessary !------------------------------------------------------------- use kernels, only:wfunc,radkernel2,cnormk3D implicit none integer :: i,j real :: rxy2,deltaz,dz,z,q2,wkern,coldens integer, parameter :: npts = 100 !print "(1x,a)",'setting up integrated kernel table...' dq2table = radkernel2/maxcoltable ddq2table = 1./dq2table do i=0,maxcoltable-1 ! !--tabulate for (cylindrical) r**2 between 0 and radkernel**2 ! rxy2 = i*dq2table ! !--integrate z between 0 and sqrt(radkernel^2 - rxy^2) ! deltaz = sqrt(radkernel2 - rxy2) dz = deltaz/real(npts-1) coldens = 0. if (deltaz.ne.deltaz) print "(a)",'WARNING: NaN in kernel table setup' do j=1,npts z = (j-1)*dz q2 = rxy2 + z*z wkern = wfunc(q2) if (j.eq.1 .or. j.eq.npts) then coldens = coldens + 0.5*wkern*dz ! trapezoidal rule else coldens = coldens + wkern*dz endif enddo coltable(i)=2.0*coldens*cnormk3D end do coltable(maxcoltable) = 0. return end subroutine setup_integratedkernel ! ! This function interpolates from the table of integrated kernel values ! to give w(q) ! real function wfromtable(q2) implicit none real, intent(in) :: q2 real :: dxx,dwdx integer :: index, index1 ! !--find nearest index in table ! index = max(int(q2*ddq2table),0) ! the max prevents seg faults on NaNs for q2 !index = min(index,maxcoltable) ! should be unnecessary if q2 < radkernel checked index1 = min(index + 1,maxcoltable) ! !--find increment along from this index ! dxx = q2 - index*dq2table ! !--find gradient ! dwdx = (coltable(index1) - coltable(index))*ddq2table ! !--compute value of integrated kernel ! wfromtable = coltable(index) + dwdx*dxx end function wfromtable !-------------------------------------------------------------------------- ! subroutine to interpolate from particle data to even grid of pixels ! ! The data is smoothed using the SPH summation interpolant, ! that is, we compute the smoothed array according to ! ! datsmooth(pixel) = sum_b weight_b dat_b W(r-r_b, h_b) ! ! where _b is the quantity at the neighbouring particle b and ! W is the smoothing kernel, for which we use the usual cubic spline ! ! ** In this version 3D data is interpolated to a 2D grid by use of an ! ** integrated form of the kernel (that is W_ab in this case is ! ** the integral through the 3D kernel to give a 2D kernel) ! ** This results in a column density map of the interpolated quantity ! ** From a similar routine by Matthew Bate. ! ! The (dimensionless) weight for each particle should be ! ! weight = pmass/(rho*h^3) ! ! the interface is written in this form to avoid floating exceptions ! on physically scaled data. ! ! Input: particle coordinates : x,y,z (npart) - note that z is only required for perspective ! smoothing lengths : hh (npart) ! weight for each particle : weight (npart) ! scalar data to smooth : dat (npart) ! ! Output: smoothed data : datsmooth (npixx,npixy) ! ! Written by Daniel Price September 2003 ! 3D perspective added Nov 2005 !-------------------------------------------------------------------------- subroutine interpolate3D_projection(x,y,z,hh,weight,dat,itype,npart, & xmin,ymin,datsmooth,npixx,npixy,pixwidthx,pixwidthy,normalise,zobserver,dscreen, & useaccelerate) use kernels, only:radkernel,radkernel2 use timing, only:wall_time,print_time implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,z,hh,weight,dat integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidthx,pixwidthy,zobserver,dscreen real, intent(out), dimension(npixx,npixy) :: datsmooth logical, intent(in) :: normalise real, dimension(npixx,npixy) :: datnorm logical, intent(in) :: useaccelerate real :: row(npixx) integer :: ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax,npixpartx,npixparty integer :: iprintinterval, iprintnext,ipixi,jpixi,jpixcopy integer :: nsubgrid,nfull,nok #ifdef _OPENMP integer :: omp_get_num_threads,i #else integer(kind=selected_int_kind(10)) :: iprogress,i ! up to 10 digits #endif real :: hi,hi1,hi21,radkern,wab,q2,xi,yi,xminpix,yminpix real :: term,termnorm,dy,dy2,ypix,zfrac,hsmooth,horigi real :: xpixmin,xpixmax,xmax,ypixmin,ypixmax,ymax real :: hmin,fac,hminall !,dhmin3 real, dimension(npixx) :: xpix,dx2i real :: t_start,t_end,t_used logical :: iprintprogress,use3Dperspective,accelerate datsmooth = 0. term = 0. if (normalise) then print "(1x,a)",'projecting (normalised) from particles to pixels...' datnorm = 0. elseif (useaccelerate) then print "(1x,a)",'projecting (fast) from particles to pixels...' else print "(1x,a)",'projecting from particles to pixels...' endif if (pixwidthx.le.0. .or. pixwidthy.le.0) then print "(1x,a)",'interpolate3D_proj: error: pixel width <= 0' return endif !nout = count(hh(1:npart).le.0.) !if (nout.gt.0) then ! print*,'interpolate3D_projection: warning: ignoring ',nout,' particles with h <= 0' !endif ! !--check column density table has actually been setup ! if (abs(coltable(1)).le.1.e-5) then call setup_integratedkernel endif ! !--print a progress report if it is going to take a long time ! (a "long time" is, however, somewhat system dependent) ! iprintprogress = (npart .ge. 100000) .or. (npixx*npixy .gt.100000) ! !--loop over particles ! iprintinterval = 25 if (npart.ge.1e6) iprintinterval = 10 iprintnext = iprintinterval use3Dperspective = abs(dscreen).gt.tiny(dscreen) ! !--get starting CPU time ! call wall_time(t_start) xminpix = xmin - 0.5*pixwidthx yminpix = ymin - 0.5*pixwidthy xmax = xmin + npixx*pixwidthx ymax = ymin + npixy*pixwidthy ! !--use a minimum smoothing length on the grid to make ! sure that particles contribute to at least one pixel ! hmin = 0.5*max(pixwidthx,pixwidthy) !dhmin3 = 1./(hmin*hmin*hmin) ! !--store x value for each pixel (for optimisation) ! do ipix=1,npixx xpix(ipix) = xminpix + ipix*pixwidthx enddo nsubgrid = 0 nok = 0 hminall = huge(hminall) !$omp parallel default(none) & !$omp shared(hh,z,x,y,weight,dat,itype,datsmooth,npart) & !$omp shared(xmin,ymin,xmax,ymax,xminpix,yminpix,xpix,pixwidthx,pixwidthy) & !$omp shared(npixx,npixy,dscreen,zobserver,use3dperspective,useaccelerate) & !$omp shared(datnorm,normalise,radkernel,radkernel2) & !$omp firstprivate(hmin) & !,dhmin3) & !$omp private(hi,zfrac,xi,yi,radkern,xpixmin,xpixmax,ypixmin,ypixmax) & !$omp private(hsmooth,horigi,hi1,hi21,term,termnorm,npixpartx,npixparty,jpixi,ipixi) & !$omp private(ipixmin,ipixmax,jpixmin,jpixmax,accelerate) & !$omp private(dx2i,row,q2,ypix,dy,dy2,wab) & !$omp private(i,ipix,jpix,jpixcopy,fac) & !$omp reduction(+:nsubgrid,nok) & !$omp reduction(min:hminall) !$omp master #ifdef _OPENMP print "(1x,a,i3,a)",'Using ',omp_get_num_threads(),' cpus' #endif !$omp end master !$omp do schedule (guided, 2) over_particles: do i=1,npart ! !--report on progress ! #ifndef _OPENMP if (iprintprogress) then iprogress = 100*i/npart if (iprogress.ge.iprintnext) then write(*,"('(',i3,'% -',i12,' particles done)')") iprogress,i iprintnext = iprintnext + iprintinterval endif endif #endif ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_particles ! !--set h related quantities ! hi = hh(i) horigi = hi if (hi.le.0.) then cycle over_particles elseif (use3Dperspective) then if (z(i).gt.zobserver) cycle over_particles zfrac = abs(dscreen/(z(i)-zobserver)) hi = hi*zfrac endif radkern = radkernel*hi ! radius of the smoothing kernel !--cycle as soon as we know the particle does not contribute xi = x(i) xpixmin = xi - radkern if (xpixmin.gt.xmax) cycle over_particles xpixmax = xi + radkern if (xpixmax.lt.xmin) cycle over_particles yi = y(i) ypixmin = yi - radkern if (ypixmin.gt.ymax) cycle over_particles ypixmax = yi + radkern if (ypixmax.lt.ymin) cycle over_particles !--take resolution length as max of h and 1/2 pixel width if (hi.lt.hmin) then hminall = min(hi,hminall) nsubgrid = nsubgrid + 1 hsmooth = hmin fac = 1. !(horigi*horigi*horigi)*dhmin3 ! factor by which to adjust the weight else fac = 1. hsmooth = hi nok = nok + 1 endif radkern = radkernel*hsmooth ! !--set kernel related quantities ! hi1 = 1./hsmooth hi21 = hi1*hi1 termnorm = weight(i)*fac*horigi term = termnorm*dat(i) ! h gives the z length scale (NB: no perspective) ! !--for each particle work out which pixels it contributes to ! npixpartx = int(radkern/pixwidthx) + 1 npixparty = int(radkern/pixwidthy) + 1 jpixi = int((yi-ymin)/pixwidthy) + 1 ipixi = int((xi-xmin)/pixwidthx) + 1 ipixmin = ipixi - npixpartx ipixmax = ipixi + npixpartx jpixmin = jpixi - npixparty jpixmax = jpixi + npixparty ! ipixmin = int((xi - radkern - xmin)/pixwidth) ! jpixmin = int((yi - radkern - ymin)/pixwidth) ! ipixmax = ipixmin + npixpart !!int((xi + radkern - xmin)/pixwidth) + 1 ! jpixmax = jpixmin + npixpart !!int((yi + radkern - ymin)/pixwidth) + 1 ! !--loop over pixels, adding the contribution from this particle ! copy by quarters if all pixels within domain ! accelerate = useaccelerate .and. (.not.normalise) & .and. npixpartx.gt.5 .and. npixparty.gt.5 & .and. ipixmin.ge.1 .and. ipixmax.le.npixx & .and. jpixmin.ge.1 .and. jpixmax.le.npixy if (accelerate) then !--adjust xi, yi to centre of pixel xi = xminpix + ipixi*pixwidthx yi = yminpix + jpixi*pixwidthy ! !--precalculate an array of dx2 for this particle (optimisation) ! do ipix=ipixmin,ipixmax dx2i(ipix) = ((xpix(ipix) - xi)**2)*hi21 enddo do jpix = jpixi,jpixmax ypix = yminpix + jpix*pixwidthy dy = ypix - yi dy2 = dy*dy*hi21 do ipix = ipixi,ipixmax q2 = dx2i(ipix) + dy2 ! !--SPH kernel - integral through cubic spline ! interpolate from a pre-calculated table ! if (q2.lt.radkernel2) then wab = wfromtable(q2) ! !--calculate data value at this pixel using the summation interpolant ! datsmooth(ipix,jpix) = datsmooth(ipix,jpix) + term*wab row(ipix) = term*wab else row(ipix) = 0. endif enddo !--NB: the following actions can and should be vectorized (but I don't know how...) !--copy top right -> top left do ipix=ipixmin,ipixi-1 datsmooth(ipix,jpix) = datsmooth(ipix,jpix) + row(ipixmax-(ipix-ipixmin)) enddo if (jpix.ne.jpixi) then jpixcopy = jpixi - (jpix-jpixi) !--copy top right -> bottom left do ipix=ipixmin,ipixi-1 datsmooth(ipix,jpixcopy) = datsmooth(ipix,jpixcopy) + row(ipixmax-(ipix-ipixmin)) enddo !--copy top right -> bottom right do ipix=ipixi,ipixmax datsmooth(ipix,jpixcopy) = datsmooth(ipix,jpixcopy) + row(ipix) enddo endif enddo else ipixmin = int((xi - radkern - xmin)/pixwidthx) ipixmax = int((xi + radkern - xmin)/pixwidthx) jpixmin = int((yi - radkern - ymin)/pixwidthy) jpixmax = int((yi + radkern - ymin)/pixwidthy) if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx ! (note that this optimises if (jpixmax.gt.npixy) jpixmax = npixy ! much better than using min/max) ! !--precalculate an array of dx2 for this particle (optimisation) ! do ipix=ipixmin,ipixmax dx2i(ipix) = ((xpix(ipix) - xi)**2)*hi21 enddo do jpix = jpixmin,jpixmax ypix = yminpix + jpix*pixwidthy dy = ypix - yi dy2 = dy*dy*hi21 do ipix = ipixmin,ipixmax !xpix = xminpix + ipix*pixwidthx !dx = xpix - xi !rab2 = (xminpix + ipix*pixwidthx - xi)**2 + dy2 q2 = dx2i(ipix) + dy2 ! dx2 pre-calculated; dy2 pre-multiplied by hi21 ! !--SPH kernel - integral through cubic spline ! interpolate from a pre-calculated table ! if (q2.lt.radkernel2) then wab = wfromtable(q2) ! !--calculate data value at this pixel using the summation interpolant ! !$omp atomic datsmooth(ipix,jpix) = datsmooth(ipix,jpix) + term*wab if (normalise) then !$omp atomic datnorm(ipix,jpix) = datnorm(ipix,jpix) + termnorm*wab endif endif enddo enddo endif enddo over_particles !$omp end do !$omp end parallel ! !--normalise dat array ! if (normalise) then !--normalise everywhere (required if not using SPH weighting) where (datnorm > tiny(datnorm)) datsmooth = datsmooth/datnorm end where endif ! !--warn about subgrid interpolation ! if (nsubgrid.gt.1) then nfull = int((xmax-xmin)/(hminall)) + 1 if (nsubgrid.gt.0.1*nok) & print "(a,i9,a,/,a,i6,a)",' Warning: pixel size > 2h for ',nsubgrid,' particles', & ' need',nfull,' pixels for full resolution' endif ! !--get/print timings ! call wall_time(t_end) t_used = t_end - t_start if (t_used.gt.10.) call print_time(t_used) return end subroutine interpolate3D_projection !-------------------------------------------------------------------------- ! ! Same as previous but for a vector quantity ! ! Input: particle coordinates : x,y (npart) ! smoothing lengths : hh (npart) ! weight for each particle : weight (npart) ! vector data to smooth : vecx (npart) ! vecy (npart) ! ! Output: smoothed vector field : vecsmoothx (npixx,npixy) ! : vecsmoothy (npixx,npixy) ! ! Daniel Price 23/12/04 !-------------------------------------------------------------------------- subroutine interpolate3D_proj_vec(x,y,z,hh,weight,vecx,vecy,itype,npart,& xmin,ymin,vecsmoothx,vecsmoothy,npixx,npixy,pixwidthx,pixwidthy,normalise,zobserver,dscreen) use kernels, only:radkernel,radkernel2 implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,z,hh,weight,vecx,vecy integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidthx,pixwidthy,zobserver,dscreen real, intent(out), dimension(npixx,npixy) :: vecsmoothx, vecsmoothy logical, intent(in) :: normalise real, dimension(:,:), allocatable :: datnorm integer :: i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax,ierr real :: hi,hi1,hi21,radkern,q2,wab,rab2,const,zfrac,hsmooth real :: termx,termy,termnorm,dx,dy,dy2,xpix,ypix vecsmoothx = 0. vecsmoothy = 0. termx = 0. termy = 0. if (normalise) then print "(1x,a)",'projecting vector (normalised) from particles to pixels...' allocate(datnorm(npixx,npixy),stat=ierr) if (ierr /= 0) then print "(a)",'interpolate3D_proj_vec: error allocating memory' return endif datnorm = 0. else print "(1x,a)",'projecting vector from particles to pixels...' endif if (pixwidthx.le.0. .or. pixwidthy.le.0.) then print "(a)",'interpolate3D_proj_vec: error: pixel width <= 0' return endif ! !--loop over particles ! !$omp parallel default(none) & !$omp shared(hh,z,x,y,weight,vecx,vecy,itype,vecsmoothx,vecsmoothy,npart) & !$omp shared(xmin,ymin,pixwidthx,pixwidthy,zobserver,dscreen,datnorm) & !$omp shared(npixx,npixy,normalise,radkernel,radkernel2) & !$omp private(hi,radkern,const,zfrac,ypix,xpix) & !$omp private(hsmooth,hi1,hi21,termx,termy,termnorm) & !$omp private(ipixmin,ipixmax,jpixmin,jpixmax) & !$omp private(dy,dy2,dx,rab2,q2,wab) & !$omp private(i,ipix,jpix) !$omp do schedule(guided, 2) over_particles: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_particles ! !--set kernel related quantities ! hi = hh(i) const = weight(i)*hi ! h gives the z length scale (NB: no perspective) if (hi.le.0.) then cycle over_particles elseif (abs(dscreen).gt.tiny(dscreen)) then if (z(i).gt.zobserver) cycle over_particles zfrac = abs(dscreen/(z(i)-zobserver)) hi = hi*zfrac endif !--take resolution length as max of h and 1/2 pixel width hsmooth = max(hi,0.5*min(pixwidthx,pixwidthy)) radkern = radkernel*hsmooth ! radius of the smoothing kernel hi1 = 1./hsmooth hi21 = hi1*hi1 termx = const*vecx(i) termy = const*vecy(i) termnorm = const ! !--for each particle work out which pixels it contributes to ! ipixmin = int((x(i) - radkern - xmin)/pixwidthx) jpixmin = int((y(i) - radkern - ymin)/pixwidthy) ipixmax = int((x(i) + radkern - xmin)/pixwidthx) + 1 jpixmax = int((y(i) + radkern - ymin)/pixwidthy) + 1 ! PRINT*,'particle ',i,' x, y, z = ',x(i),y(i),z(i),dat(i),rho(i),hi ! PRINT*,'pixels = ',ipixmin,ipixmax,jpixmin,jpixmax if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx if (jpixmax.gt.npixy) jpixmax = npixy ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax ypix = ymin + (jpix-0.5)*pixwidthy dy = ypix - y(i) dy2 = dy*dy do ipix = ipixmin,ipixmax xpix = xmin + (ipix-0.5)*pixwidthx dx = xpix - x(i) rab2 = dx**2 + dy2 q2 = rab2*hi21 ! !--SPH kernel - integral through cubic spline ! interpolate from a pre-calculated table ! if (q2.lt.radkernel2) then wab = wfromtable(q2) ! !--calculate data value at this pixel using the summation interpolant ! vecsmoothx(ipix,jpix) = vecsmoothx(ipix,jpix) + termx*wab vecsmoothy(ipix,jpix) = vecsmoothy(ipix,jpix) + termy*wab if (normalise) datnorm(ipix,jpix) = datnorm(ipix,jpix) + termnorm*wab endif enddo enddo enddo over_particles !$omp end do !$omp end parallel if (normalise .and. allocated(datnorm)) then !--normalise everywhere where (datnorm > tiny(datnorm)) vecsmoothx = vecsmoothx/datnorm vecsmoothy = vecsmoothy/datnorm end where endif if (allocated(datnorm)) deallocate(datnorm) return end subroutine interpolate3D_proj_vec !-------------------------------------------------------------------------- ! ! Computes synchrotron emission (Stokes Q, U) for a given B field ! at present assuming no faraday rotation ! ! For references see: ! ! Urbanik et al. (1997), A&A 326, 465 ! Sokoloff et al. (1998), MNRAS, 299, 189 ! Gomez & Cox (2004), ApJ 615, 744 (for Cosmic Ray distribution esp.) ! ! Faraday rotation could be included easily but ! I have not yet done so. ! ! Input: particle coordinates : x,y (npart) ! smoothing lengths : hh (npart) ! weight for each particle : weight (npart) ! vector data to smooth : vecx (npart) ! vecy (npart) ! ! Output: smoothed vector field : stokesQ (npixx,npixy) ! : stokesU (npixx,npixy) ! : stokesI (npixx,npixy) ! ! DOES NOT WORK FOR ROTATED CONFIGURATIONS YET!! ! (ie. z is assumed to be z_galaxy in the cosmic ray distribution) ! ! Daniel Price 14/03/07 !-------------------------------------------------------------------------- subroutine interp3D_proj_vec_synctron(x,y,z,hh,weight,vecx,vecy,itype,npart,& xmin,ymin,stokesQ,stokesU,stokesI,npixx,npixy,pixwidth,rcrit,zcrit,alpha, & qpixwidth,getIonly,utherm,uthermcutoff) use kernels, only:radkernel,radkernel2 implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,z,hh,weight,vecx,vecy integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidth,rcrit,zcrit,alpha,qpixwidth logical, intent(in) :: getIonly real, intent(out), dimension(npixx,npixy) :: stokesQ,stokesU,stokesI real, intent(in), dimension(npart), optional :: utherm real, intent(in), optional :: uthermcutoff integer :: i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax real :: hi,hi1,hi21,radkern,q2,wab,const,hsmooth real :: termx,termy,term,dy,dy2,ypix,xi,yi,zi real :: crdens,emissivity,Bperp,angle,pintrinsic,rcyl real, dimension(npixx) :: dx2i if (getIonly) then stokesI = 0. else stokesU = 0. stokesQ = 0. endif termx = 0. termy = 0. term = 0. pintrinsic = (3. + 3.*alpha)/(5. + 3.*alpha) if (getIonly) then print "(1x,a)",'getting synchrotron intensity map from B field...' else print "(1x,a)",'getting synchrotron polarisation map from B field...' print*,' assuming cosmic ray electron distribution exp(-r/',rcrit,' -z/',zcrit,') (kpc)' print*,' synchrotron spectral index I_nu = nu^-',alpha print*,' intrinsic polarisation fraction = ',pintrinsic endif if (present(utherm) .and. present(uthermcutoff)) then print*,' using only particles with utherm > ',uthermcutoff endif if (pixwidth.le.0.) then print "(a)",'interpolate3D_proj_vec_synchrotron: error: pixel width <= 0' return endif ! !--loop over particles ! !$omp parallel default(none) & !$omp shared(hh,z,x,y,weight,vecx,vecy,itype,stokesq,stokesu,stokesi,npart) & !$omp shared(xmin,ymin,pixwidth,rcrit,zcrit,alpha,radkernel,radkernel2) & !$omp shared(npixx,npixy,pintrinsic,qpixwidth,getionly,utherm,uthermcutoff) & !$omp private(hi,xi,yi,zi,radkern,const) & !$omp private(hsmooth,hi1,hi21,term,termx,termy) & !$omp private(rcyl,crdens,bperp,emissivity,angle) & !$omp private(ipixmin,ipixmax,jpixmin,jpixmax) & !$omp private(dy,dy2,dx2i,ypix,q2,wab) & !$omp private(i,ipix,jpix) !$omp do schedule(guided, 2) over_particles: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_particles ! !--skip particles with utherm < uthermcutoff ! if (present(utherm) .and. present(uthermcutoff)) then if (utherm(i).lt.uthermcutoff) cycle over_particles endif ! !--set kernel related quantities ! hi = hh(i) if (hi.le.0.) cycle over_particles const = weight(i)*hi ! h gives the z length scale (NB: no perspective) zi = z(i) !--take resolution length as max of h and 1/2 pixel width ! (for intensity calculation, qpixwidth is pixel width of Q,U calculation) hsmooth = max(hi,0.5*pixwidth,0.5*qpixwidth) hi1 = 1./hsmooth hi21 = hi1*hi1 radkern = radkernel*hsmooth ! radius of the smoothing kernel xi = x(i) yi = y(i) !--assumed distribution of cosmic ray electrons in galaxy ! (should use UNROTATED x,y if rotation added) rcyl = sqrt(xi**2 + yi**2) crdens = exp(-rcyl/rcrit - abs(zi)/zcrit) !--calculate synchrotron emissivity based on Bperp and a spectral index alpha Bperp = sqrt(vecx(i)**2 + vecy(i)**2) emissivity = crdens*Bperp**(1. + alpha) if (getIonly) then term = emissivity*const termx = 0. termy = 0. else term = 0. !--faraday rotation would change angle here angle = atan2(vecy(i),vecx(i)) termx = pintrinsic*emissivity*const*COS(angle) termy = pintrinsic*emissivity*const*SIN(angle) endif ! !--for each particle work out which pixels it contributes to ! ipixmin = int((xi - radkern - xmin)/pixwidth) jpixmin = int((yi - radkern - ymin)/pixwidth) ipixmax = int((xi + radkern - xmin)/pixwidth) + 1 jpixmax = int((yi + radkern - ymin)/pixwidth) + 1 ! PRINT*,'particle ',i,' x, y, z = ',x(i),y(i),z(i),dat(i),rho(i),hi ! PRINT*,'pixels = ',ipixmin,ipixmax,jpixmin,jpixmax if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx if (jpixmax.gt.npixy) jpixmax = npixy ! !--precalculate an array of dx2 for this particle (optimisation) ! do ipix=ipixmin,ipixmax dx2i(ipix) = ((xmin + (ipix-0.5)*pixwidth - xi)**2)*hi21 enddo ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax ypix = ymin + (jpix-0.5)*pixwidth dy = ypix - yi dy2 = dy*dy*hi21 do ipix = ipixmin,ipixmax !xpix = xmin + (ipix-0.5)*pixwidth !dx = xpix - xi q2 = dx2i(ipix) + dy2 ! !--SPH kernel - integral through cubic spline ! interpolate from a pre-calculated table ! if (q2.lt.radkernel2) then wab = wfromtable(q2) ! !--calculate data value at this pixel using the summation interpolant ! if (getIonly) then stokesI(ipix,jpix) = stokesI(ipix,jpix) + term*wab else stokesQ(ipix,jpix) = stokesQ(ipix,jpix) + termx*wab stokesU(ipix,jpix) = stokesU(ipix,jpix) + termy*wab endif endif enddo enddo enddo over_particles !$omp end do !$omp end parallel return end subroutine interp3D_proj_vec_synctron end module projections3D splash/src/interpolate3D_xsec.f90000644 000770 000000 00000027125 12024002741 017615 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------------- ! ! Module containing all of the routines required for cross sections ! through 3D data ! !---------------------------------------------------------------------- module xsections3D use kernels, only:cnormk3D,radkernel,radkernel2,wfunc implicit none public :: interpolate3D_fastxsec, interpolate3D_xsec_vec contains !-------------------------------------------------------------------------- ! ! ** In this version 3D data is interpolated to a single 2D cross section ! ** This is much faster than interpolating to a 3D grid ! ** and is efficient if only one or two cross sections are needed. ! ! ** Note that the cross section is always taken in the z co-ordinate ! ** so should submit the appropriate arrays as x, y and z. ! ! Input: particle coordinates : x,y,z (npart) ! particle masses : pmass (npart) ! density on particles : rho (npart) - must be computed separately ! smoothing lengths : hh (npart) - could be computed from density ! scalar data to smooth : dat (npart) ! cross section location: zslice ! ! Output: smoothed data : datsmooth (npixx,npixy) ! ! Daniel Price, Institute of Astronomy, Cambridge, 23/9/03 !-------------------------------------------------------------------------- subroutine interpolate3D_fastxsec(x,y,z,hh,weight,dat,itype,npart,& xmin,ymin,zslice,datsmooth,npixx,npixy,pixwidthx,pixwidthy,normalise) implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,z,hh,weight,dat integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidthx,pixwidthy,zslice real, intent(out), dimension(npixx,npixy) :: datsmooth logical, intent(in) :: normalise real, dimension(npixx,npixy) :: datnorm integer :: i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax real :: hi,hi1,radkern,q2,wab,const,xi,yi,hi21 real :: termnorm,term,dy,dy2,dz,dz2,ypix,rescalefac real, dimension(npixx) :: dx2i datsmooth = 0. datnorm = 0. if (normalise) then print*,'taking fast cross section (normalised)...',zslice else print*,'taking fast cross section (non-normalised)...',zslice endif if (pixwidthx.le.0. .or. pixwidthy.le.0.) then print*,'interpolate3D_xsec: error: pixel width <= 0' return elseif (npart.le.0) then print*,'interpolate3D_xsec: error: npart = 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate3D_xsec: WARNING: ignoring some or all particles with h < 0' endif const = cnormk3D ! !--renormalise dat array by first element to speed things up ! if (dat(1).gt.tiny(dat)) then rescalefac = dat(1) else rescalefac = 1.0 endif ! !--loop over particles ! over_parts: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts ! !--set kernel related quantities ! hi = hh(i) if (hi.le.0.) cycle over_parts hi1 = 1./hi hi21 = hi1*hi1 radkern = radkernel*hi ! radius of the smoothing kernel ! !--for each particle, work out distance from the cross section slice. ! dz = zslice - z(i) dz2 = dz**2*hi21 ! !--if this is < 2h then add the particle's contribution to the pixels ! otherwise skip all this and start on the next particle ! if (dz2 .lt. radkernel2) then xi = x(i) yi = y(i) termnorm = const*weight(i) term = termnorm*dat(i)/rescalefac ! !--for each particle work out which pixels it contributes to ! ipixmin = int((xi - radkern - xmin)/pixwidthx) jpixmin = int((yi - radkern - ymin)/pixwidthy) ipixmax = int((xi + radkern - xmin)/pixwidthx) + 1 jpixmax = int((yi + radkern - ymin)/pixwidthy) + 1 if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx if (jpixmax.gt.npixy) jpixmax = npixy ! !--precalculate an array of dx2 for this particle (optimisation) ! do ipix=ipixmin,ipixmax dx2i(ipix) = ((xmin + (ipix-0.5)*pixwidthx - xi)**2)*hi21 + dz2 enddo ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax ypix = ymin + (jpix-0.5)*pixwidthy dy = ypix - yi dy2 = dy*dy*hi21 do ipix = ipixmin,ipixmax q2 = dx2i(ipix) + dy2 ! !--SPH kernel - standard cubic spline ! if (q2.lt.radkernel2) then wab = wfunc(q2) ! !--calculate data value at this pixel using the summation interpolant ! datsmooth(ipix,jpix) = datsmooth(ipix,jpix) + term*wab if (normalise) datnorm(ipix,jpix) = datnorm(ipix,jpix) + termnorm*wab endif enddo enddo endif ! if particle within 2h of slice enddo over_parts ! over particles ! !--normalise dat array ! if (normalise) then !--normalise everywhere (required if not using SPH weighting) where (datnorm > tiny(datnorm)) datsmooth = datsmooth/datnorm end where endif datsmooth = datsmooth*rescalefac return end subroutine interpolate3D_fastxsec !-------------------------------------------------------------------------- ! program to interpolate from particle data to even grid of pixels ! ! The data is smoothed using the SPH summation interpolant, ! that is, we compute the smoothed array according to ! ! datsmooth(pixel) = sum_b m_b dat_b/rho_b W(r-r_b, h_b) ! ! where _b is the quantity at the neighbouring particle b and ! W is the smoothing kernel, for which we use the usual cubic spline ! ! ** In this version 3D data is interpolated to a single 2D cross section ! ** This is much faster than interpolating to a 3D grid ! ** and is efficient if only one or two cross sections are needed. ! ! ** Note that the cross section is always taken in the z co-ordinate ! ** so should submit the appropriate arrays as x, y and z. ! ! Input: particle coordinates : x,y,z (npart) ! particle masses : pmass (npart) ! density on particles : rho (npart) - must be computed separately ! smoothing lengths : hh (npart) - could be computed from density ! vector data to smooth : vecx (npart) ! vecy (npart) ! cross section location: zslice ! ! Output: smoothed vector field : vecsmoothx (npixx,npixy) ! : vecsmoothy (npixx,npixy) ! ! Daniel Price, Institute of Astronomy, Cambridge, 23/9/03 !-------------------------------------------------------------------------- subroutine interpolate3D_xsec_vec(x,y,z,hh,weight,vecx,vecy,itype,npart,& xmin,ymin,zslice,vecsmoothx,vecsmoothy,npixx,npixy,pixwidthx,pixwidthy,normalise) implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,z,hh,weight,vecx,vecy integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,pixwidthx,pixwidthy,zslice real, intent(out), dimension(npixx,npixy) :: vecsmoothx, vecsmoothy logical, intent(in) :: normalise real, dimension(npixx,npixy) :: datnorm integer :: i,ipix,jpix,ipixmin,ipixmax,jpixmin,jpixmax real :: hi,hi1,radkern,q2,wab,const real :: termx,termy,termnorm,dx,dy,dz,dz2,xpix,ypix vecsmoothx = 0. vecsmoothy = 0. datnorm = 0. if (normalise) then print*,'taking fast cross section (normalised)...',zslice else print*,'taking fast cross section (non-normalised)...',zslice endif if (pixwidthx.le.0. .or. pixwidthy.le.0.) then print*,'interpolate3D_xsec_vec: error: pixel width <= 0' return endif if (any(hh(1:npart).le.tiny(hh))) then print*,'interpolate3D_xsec_vec: WARNING: ignoring some or all particles with h < 0' endif const = cnormk3D ! normalisation constant (3D) ! !--loop over particles ! over_parts: do i=1,npart ! !--skip particles with itype < 0 ! if (itype(i).lt.0) cycle over_parts ! !--set kernel related quantities ! hi = hh(i) if (hi.le.0.) cycle over_parts hi1 = 1./hi radkern = radkernel*hi ! radius of the smoothing kernel ! !--for each particle, work out distance from the cross section slice. ! dz = zslice - z(i) dz2 = dz**2 ! !--if this is < 2h then add the particle's contribution to the pixels ! otherwise skip all this and start on the next particle ! if (abs(dz) .lt. radkern) then termnorm = const*weight(i) termx = termnorm*vecx(i) termy = termnorm*vecy(i) ! !--for each particle work out which pixels it contributes to ! ipixmin = int((x(i) - radkern - xmin)/pixwidthx) jpixmin = int((y(i) - radkern - ymin)/pixwidthy) ipixmax = int((x(i) + radkern - xmin)/pixwidthx) + 1 jpixmax = int((y(i) + radkern - ymin)/pixwidthy) + 1 if (ipixmin.lt.1) ipixmin = 1 ! make sure they only contribute if (jpixmin.lt.1) jpixmin = 1 ! to pixels in the image if (ipixmax.gt.npixx) ipixmax = npixx if (jpixmax.gt.npixy) jpixmax = npixy ! !--loop over pixels, adding the contribution from this particle ! do jpix = jpixmin,jpixmax ypix = ymin + (jpix-0.5)*pixwidthy dy = ypix - y(i) do ipix = ipixmin,ipixmax xpix = xmin + (ipix-0.5)*pixwidthx dx = xpix - x(i) q2 = (dx*dx + dy*dy + dz2)*hi1*hi1 ! !--SPH kernel - standard cubic spline ! if (q2.lt.radkernel2) then wab = wfunc(q2) ! !--calculate data value at this pixel using the summation interpolant ! vecsmoothx(ipix,jpix) = vecsmoothx(ipix,jpix) + termx*wab vecsmoothy(ipix,jpix) = vecsmoothy(ipix,jpix) + termy*wab if (normalise) datnorm(ipix,jpix) = datnorm(ipix,jpix) + termnorm*wab endif enddo enddo endif ! if particle within 2h of slice enddo over_parts ! over particles ! !--normalise dat array(s) ! if (normalise) then where (datnorm > tiny(datnorm)) vecsmoothx = vecsmoothx/datnorm vecsmoothy = vecsmoothy/datnorm end where endif return end subroutine interpolate3D_xsec_vec end module xsections3D splash/src/interpolate_vec.f90000644 000770 000000 00000014234 12427007365 017254 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !-------------------------------------------------------------------------- ! ! Module with some auxiliary routines related to vector interpolation ! !-------------------------------------------------------------------------- module interpolate_vec implicit none public :: interpolate_vec_average public :: mask_vectors private contains !-------------------------------------------------------------------------- ! ! Hides vector arrows (sets them to zero) where there are no particles ! contained in the pixel (as opposed to merely contributing to the pixel) ! ! means you can avoid funny looking plots with arrows in otherwise ! empty regions ! ! Daniel Price 26/3/07 ! !-------------------------------------------------------------------------- subroutine mask_vectors(xplot,yplot,itype,npart,xmin,xmax,ymin,ymax, & vecpixx,vecpixy,npixvecx,npixvecy,minincell,blankval) implicit none integer, intent(in) :: npart,npixvecx,npixvecy,minincell integer, dimension(npart), intent(in) :: itype real, dimension(npart), intent(in) :: xplot,yplot real, intent(in) :: xmin,xmax,ymin,ymax,blankval real, dimension(npixvecx,npixvecy), intent(inout) :: vecpixx,vecpixy integer, dimension(npixvecx,npixvecy) :: nincell integer :: icellx,icelly,j real :: dxcell1,dycell1 character(len=16) :: chmin !--write nice, neat information line write(chmin,"(g10.0)") minincell print "(2x,a)",'(hiding arrows where there are < '//trim(adjustl(chmin))//' particles in pixel cell)' dxcell1 = (npixvecx - 1)/(xmax-xmin + tiny(xmin)) dycell1 = (npixvecy - 1)/(ymax-ymin + tiny(ymin)) ! !--count particles which fall into each pixel ("cell") ! nincell(:,:) = 0 do j=1,npart if (itype(j).ge.0) then ! exclude not-plotted particles icellx = int((xplot(j) - xmin)*dxcell1) + 1 icelly = int((yplot(j) - ymin)*dycell1) + 1 !--count number of particles in each cell if (icellx.gt.0 .and. icellx.le.npixvecx & .and. icelly.gt.0 .and. icelly.le.npixvecy) then nincell(icellx,icelly) = nincell(icellx,icelly) + 1 endif endif enddo ! !--set vector arrow lengths to zero in cells where there are no particles ! where (nincell.lt.minincell) vecpixx = blankval vecpixy = blankval end where return end subroutine mask_vectors !-------------------------------------------------------------------------- ! Interpolates vector quantity from particles to even grid of pixels ! ! This version just does a simple averaging by binning particles ! and taking the average of vx,vy in the cell to give a vector for ! that cell. This is because the interpolation of a vector quantity is ! usually to a *coarser* grid than the particles. ! ! Input: particle coordinates : x,y (npart) ! vector data to smooth : vecx (npart) ! vecy (npart) ! grid setup : xmin, ymin, dx ! ! Output: smoothed vector field : vecpixx (npixx,npixy) ! : vecpixy (npixx,npixy) ! ! Daniel Price, Institute of Astronomy, Cambridge, 20/8/04 !-------------------------------------------------------------------------- subroutine interpolate_vec_average(x,y,vecx,vecy,itype, & xmin,ymin,dx,dy,vecpixx,vecpixy,npart,npixx,npixy,z,zmin,zmax) implicit none integer, intent(in) :: npart,npixx,npixy real, intent(in), dimension(npart) :: x,y,vecx,vecy integer, intent(in), dimension(npart) :: itype real, intent(in) :: xmin,ymin,dx,dy real, intent(out), dimension(npixx,npixy) :: vecpixx, vecpixy real, intent(in), optional :: z(npart),zmin,zmax integer :: i,j,k,ix,iy integer, dimension(npixx,npixy) :: ihoc,numcell integer, dimension(npart) :: ll logical :: xsec !print "(a,i3,a,i3,a)",' averaging vector field onto ',npixx,'x',npixy,' pixels...' if (dx <= 0. .or. dy <= 0.) then print*,'interpolate_vec: error: pixel width <= 0' return endif ! !--interpolation is to a coarser grid, so just average ! bin particles into cells using a link list ! ihoc(:,:) = -1 ! head of chain numcell(:,:) = 0 xsec = present(z) .and. present(zmin) .and. present(zmax) over_parts: do i=1,npart if (xsec) then if (z(i) < zmin .or. z(i) > zmax) cycle over_parts endif if (itype(i).ge.0) then ix = int((x(i)-xmin)/dx)+1 iy = int((y(i)-ymin)/dy)+1 if ((ix.ge.1).and.(ix.le.npixx).and.(iy.ge.1).and.(iy.le.npixy)) then ll(i)=ihoc(ix,iy) ! set link list of this particle to old head of list ihoc(ix,iy) = i ! set head of chain to this particle endif endif enddo over_parts ! !--add up total vx,vy in each cell ! vecpixx(:,:) = 0. vecpixy(:,:) = 0. do j=1,npixy do i=1,npixx k = ihoc(i,j) do while (k.ne.-1) vecpixx(i,j) = vecpixx(i,j) + vecx(k) vecpixy(i,j) = vecpixy(i,j) + vecy(k) numcell(i,j) = numcell(i,j) + 1 k = ll(k) enddo enddo enddo ! !--divide by number of particles in that cell to get average vx,vy ! do j=1,npixy do i=1,npixx if (numcell(i,j).ne.0) then vecpixx(i,j) = vecpixx(i,j)/float(numcell(i,j)) vecpixy(i,j) = vecpixy(i,j)/float(numcell(i,j)) endif enddo enddo return end subroutine interpolate_vec_average end module interpolate_vec splash/src/interpolation.f90000644 000770 000000 00000023371 12311765227 016762 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! Module containing utility routines for SPH kernel interpolation !----------------------------------------------------------------- module interpolation implicit none public :: set_interpolation_weights real, parameter, public :: weight_sink = -1. private contains !------------------------------------------------------------------- ! Set interpolation weights for the particles. The weights are ! calculated using: ! ! w = m/(rho*h**ndim), ! ! where we need to handle a few special scenarios: ! ! 1) Firstly, the weight should be calculated in a consistent ! set of units. Safest way is to use the data as originally ! read from the dump file, before any unit scaling was applied. ! ! 2) Particle weights are set to zero for particle types not ! used in the rendering. ! ! 3) If particle mass not read, it is still possible to perform ! interpolations, but not using the SPH weights. These ! interpolations *must* therefore be normalised. !------------------------------------------------------------------- subroutine set_interpolation_weights(weighti,dati,iamtypei,usetype, & ninterp,npartoftype,masstype,ntypes,ndataplots,irho,ipmass,ih,ndim, & iRescale,idensityweighted,inormalise,units,unit_interp,required, & rendersinks) use params, only:doub_prec,int1,maxplot use labels, only:get_sink_type implicit none real, dimension(:), intent(out) :: weighti real, dimension(:,:), intent(in) :: dati integer(kind=int1), dimension(:), intent(in) :: iamtypei logical, dimension(:), intent(in) :: usetype logical, dimension(0:maxplot), intent(in) :: required integer, intent(in) :: ih,irho,ipmass,ndim integer, intent(in) :: ninterp,ntypes,ndataplots integer, dimension(:), intent(in) :: npartoftype real, dimension(:), intent(in) :: masstype logical, intent(in) :: iRescale,idensityweighted,rendersinks logical, intent(inout) :: inormalise real, dimension(0:maxplot), intent(in) :: units real(doub_prec), intent(in) :: unit_interp integer :: i2,i1,itype,ipart,isinktype real(doub_prec) :: dunitspmass,dunitsrho,dunitsh ! !-- unit_interp is a multiplication factor that can ! be used to scale the "weight" in case the ! units read from the read_data routine ! are inconsistent (this is the case for the SEREN read) ! dunitspmass = 1.d0 dunitsrho = 1.d0 dunitsh = 1.d0 if (iRescale) then if (ipmass.gt.0) dunitspmass = 1.d0/units(ipmass) if (ih.gt.0) dunitsh = 1.d0/units(ih) if (irho.gt.0) dunitsrho = 1.d0/units(irho) endif dunitspmass = dunitspmass * unit_interp isinktype = get_sink_type(ntypes) if (ipmass.gt.0 .and. ipmass.le.ndataplots .and. & irho.gt.0 .and. irho.le.ndataplots .and. & ih .gt. 0 .and. ih.le.ndataplots .and. & required(ipmass) .and. required(irho) .and. required(ih)) then if (size(iamtypei) > 1) then ! !--particles with mixed types ! !$omp parallel do default(none) & !$omp shared(ninterp,iamtypei,weighti,dati,rendersinks,isinktype) & !$omp shared(usetype,idensityweighted,dunitsrho) & !$omp shared(ipmass,ih,irho,dunitspmass,dunitsh,ndim) & !$omp private(ipart,itype) do ipart=1,ninterp itype = iamtypei(ipart) if (.not.usetype(itype)) then if (rendersinks .and. itype.eq.isinktype) then weighti(ipart) = weight_sink else weighti(ipart) = 0. endif elseif (idensityweighted) then if (dati(ipart,ih) > tiny(dati)) then weighti(ipart) = (dati(ipart,ipmass)*dunitspmass)/ & ((dati(ipart,ih)*dunitsh)**ndim) else weighti(ipart) = 0. endif else if (dati(ipart,irho) > tiny(dati) .and. dati(ipart,ih) > tiny(dati)) then weighti(ipart) = (dati(ipart,ipmass)*dunitspmass)/ & ((dati(ipart,irho)*dunitsrho)*(dati(ipart,ih)*dunitsh)**ndim) else weighti(ipart) = 0. endif endif enddo !$omp end parallel do else ! !--particles ordered by type ! i2 = 0 over_types: do itype=1,ntypes i1 = i2 + 1 i2 = i2 + npartoftype(itype) i2 = min(i2,ninterp) if (i1 > i2) cycle over_types !--set weights to zero for particle types not used in the rendering if (.not.usetype(itype)) then if (rendersinks .and. itype.eq.isinktype) then weighti(i1:i2) = weight_sink else weighti(i1:i2) = 0. endif elseif (idensityweighted) then !--for density weighted interpolation use m/h**ndim where(dati(i1:i2,ih) > tiny(dati)) weighti(i1:i2) = (dati(i1:i2,ipmass)*dunitspmass)/ & ((dati(i1:i2,ih)*dunitsh)**ndim) elsewhere weighti(i1:i2) = 0. endwhere else !--usual interpolation use m/(rho h**ndim) where(dati(i1:i2,irho) > tiny(dati) .and. dati(i1:i2,ih) > tiny(dati)) weighti(i1:i2) = (dati(i1:i2,ipmass)*dunitspmass)/ & ((dati(i1:i2,irho)*dunitsrho)*(dati(i1:i2,ih)*dunitsh)**ndim) elsewhere weighti(i1:i2) = 0. endwhere endif enddo over_types endif if (idensityweighted) then print "(a)",' USING DENSITY WEIGHTED INTERPOLATION ' inormalise = .true. endif elseif (any(masstype(1:ntypes).gt.0.) .and. & irho.gt.0 .and. irho.le.ndataplots .and. & ih .gt. 0 .and. ih.le.ndataplots .and. & required(irho) .and. required(ih)) then if (size(iamtypei) > 1) then ! !--particles with mixed types ! !$omp parallel do default(none) & !$omp shared(ninterp,iamtypei,weighti,dati,rendersinks,isinktype) & !$omp shared(usetype,idensityweighted,dunitsrho,masstype) & !$omp shared(ih,irho,dunitspmass,dunitsh,ndim) & !$omp private(ipart,itype) do ipart=1,ninterp itype = iamtypei(ipart) if (.not.usetype(itype)) then if (rendersinks .and. itype.eq.isinktype) then weighti(ipart) = weight_sink else weighti(ipart) = 0. endif elseif (idensityweighted) then if (dati(ipart,ih) > tiny(dati)) then weighti(ipart) = (masstype(itype)*dunitspmass)/ & ((dati(ipart,ih)*dunitsh)**ndim) else weighti(ipart) = 0. endif else if (dati(ipart,irho) > tiny(dati) .and. dati(ipart,ih) > tiny(dati)) then weighti(ipart) = (masstype(itype)*dunitspmass)/ & ((dati(ipart,irho)*dunitsrho)*(dati(ipart,ih)*dunitsh)**ndim) else weighti(ipart) = 0. endif endif enddo !$omp end parallel do else ! !--particles ordered by type ! i2 = 0 over_types2: do itype=1,ntypes i1 = i2 + 1 i2 = i2 + npartoftype(itype) i2 = min(i2,ninterp) if (i1 > i2) cycle over_types2 !--set weights to zero for particle types not used in the rendering if (.not.usetype(itype)) then if (rendersinks .and. itype.eq.isinktype) then weighti(i1:i2) = weight_sink else weighti(i1:i2) = 0. endif else where(dati(i1:i2,irho) > tiny(dati) .and. dati(i1:i2,ih) > tiny(dati)) weighti(i1:i2) = masstype(itype)/ & ((dati(i1:i2,irho)*dunitsrho)*(dati(i1:i2,ih)*dunitsh)**ndim) elsewhere weighti(i1:i2) = 0. endwhere endif enddo over_types2 endif if (idensityweighted) then print "(a)",' USING DENSITY WEIGHTED INTERPOLATION ' inormalise = .true. endif else if (required(ih) .and. required(irho) .and. ih.gt.0 .and. irho.gt.0) then print "(a)",' WARNING: particle mass not set: using normalised interpolations' endif !--if particle mass has not been set, then must use normalised interpolations weighti(1:ninterp) = 1.0 inormalise = .true. endif end subroutine set_interpolation_weights end module interpolation splash/src/kernels.f90000644 000770 000000 00000015445 12200366325 015532 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------- ! ! Module containing kernel functions used for interpolation ! !------------------------------------------------------------- module kernels implicit none integer, parameter, public :: nkernels = 6 character(len=24), dimension(0:nkernels), parameter, public :: kernelname = & (/'default [cubic] ', & 'M4 cubic spline (2h) ', & 'M5 quartic (2.5h)', & 'M6 quintic spline (3h) ', & 'Wendland C2 (2h) ', & 'Wendland C4 (2h) ', & 'Wendland C6 (2h) '/) real, parameter :: pi = 3.14159236 integer, public :: ikernel = 0 real, public :: radkernel = 2. real, public :: radkernel2 = 4. real, public :: cnormk1D = 2./3. real, public :: cnormk2D = 10./(7.*pi) real, public :: cnormk3D = 1./pi procedure(real), pointer :: wfunc public :: wfunc, select_kernel, select_kernel_by_name private contains !----------------------------------------------- ! ! Kernel selection routine, sets radkernel, ! cnormk values and pointer to kernel function ! !-------------------------------------- subroutine select_kernel(j) integer, intent(in) :: j if (j.ge.1 .and. j.le.nkernels) then !--print only if NOT using the default kernel print "(a,/)",' Using '//trim(kernelname(j))//' kernel' endif select case(j) case(6) ! Wendland 3D C6 ikernel = 6 radkernel = 2. cnormk1D = 15./16. cnormk2D = 39./(14.*pi) cnormk3D = 1365./(512.*pi) wfunc => w_wendlandc6 case(5) ! Wendland 3D C4 ikernel = 5 radkernel = 2. cnormk1D = 27./32. cnormk2D = 9./(4.*pi) cnormk3D = 495./(256.*pi) wfunc => w_wendlandc4 case(4) ! Wendland 3D C2 ikernel = 4 radkernel = 2. cnormk1D = 0.75 cnormk2D = 7./(4.*pi) cnormk3D = 21./(16.*pi) wfunc => w_wendlandc2 case(3) ! M6 quintic, 3h ikernel = 3 radkernel = 3.0 cnormk1D = 1./120. cnormk2D = 7./(478*pi) cnormk3D = 1./(120.*pi) wfunc => w_quintic case(2) ! M5 quartic, 2.5h ikernel = 2 radkernel = 2.5 cnormk1D = 1./24. cnormk2D = 96./(1199.*pi) cnormk3D = 1./(20.*pi) wfunc => w_quartic case default !-- cubic spline kernel if (j.eq.1) then ikernel = 1 ! deliberately chose cubic spline else ikernel = 0 ! just whatever is the default endif radkernel = 2.0 cnormk1D = 2./3. cnormk2D = 10./(7.*pi) cnormk3D = 1./pi wfunc => w_cubic end select radkernel2 = radkernel*radkernel end subroutine select_kernel !-------------------------------------- ! ! Kernel selection based on string ! !-------------------------------------- subroutine select_kernel_by_name(string) use asciiutils, only:lcase character(len=*), intent(in) :: string integer :: i,jkern jkern = 0 ! !--check if string exactly matches a kernel name ! do i=1,nkernels if (trim(adjustl(lcase(string)))==trim(adjustl(lcase(kernelname(i))))) then jkern = i endif enddo ! !--if no match to a kernel name, look for other possible strings ! if (ikernel.eq.0) then select case(trim(adjustl(lcase(string)))) case('wendlandc6','wendland c6','6th order wendland','wendland 3d c6','w6','wendland6') jkern = 6 case('wendlandc4','wendland c4','4th order wendland','wendland 3d c4','w4','wendland4') jkern = 5 case('wendlandc2','wendland c2','2nd order wendland','wendland 3d c2','w2','wendland2') jkern = 4 case('quintic','quintic spline','m6','quintic b-spline') jkern = 3 case('quartic','quartic spline','m5','quartic b-spline') jkern = 2 case('cubic','cubic spline','m4','cubic b-spline') jkern = 1 end select endif call select_kernel(jkern) end subroutine select_kernel_by_name !--------------------------------------- ! ! Functional forms of various kernels ! !-------------------------------------- real function w_cubic(q2) implicit none real, intent(in) :: q2 real :: q if (q2.lt.1.0) then q = sqrt(q2) w_cubic = 1.-1.5*q2 + 0.75*q2*q elseif (q2.lt.4.0) then q = sqrt(q2) w_cubic = 0.25*(2.-q)**3 else w_cubic = 0. endif end function w_cubic real function w_quartic(q2) implicit none real, intent(in) :: q2 real :: q q = sqrt(q2) if (q.lt.0.5) then w_quartic = (2.5-q)**4 - 5.*(1.5-q)**4 + 10.*(0.5-q)**4 elseif (q.lt.1.5) then w_quartic = (2.5-q)**4 - 5.*(1.5-q)**4 elseif (q.lt.2.5) then w_quartic = (2.5-q)**4 else w_quartic = 0. endif end function w_quartic real function w_quintic(q2) implicit none real, intent(in) :: q2 real :: q,q4 if (q2.lt.1.0) then q = sqrt(q2) q4 = q2*q2 w_quintic = 66.-60.*q2 + 30.*q4 - 10.*q4*q elseif ((q2.ge.1.0).and.(q2.lt.4.0)) then q = sqrt(q2) w_quintic = (3.-q)**5 - 6.*(2.-q)**5 elseif ((q2.ge.4.0).and.(q2.lt.9.0)) then q = sqrt(q2) w_quintic = (3.-q)**5 else w_quintic = 0.0 endif end function w_quintic real function w_quartic2h(q2) implicit none real, intent(in) :: q2 real :: q q = sqrt(q2) if (q.lt.0.4) then w_quartic2h = (2.-q)**4 - 5.*(1.2-q)**4 + 10.*(0.4-q)**4 elseif (q.lt.1.2) then w_quartic2h = (2.-q)**4 - 5.*(1.2-q)**4 elseif (q.lt.2.) then w_quartic2h = (2.-q)**4 else w_quartic2h = 0. endif end function w_quartic2h real function w_wendlandc2(q2) implicit none real, intent(in) :: q2 real :: q if (q2.lt.4.) then q = sqrt(q2) w_wendlandc2 = (1. - 0.5*q)**4*(2.*q + 1.) else w_wendlandc2 = 0. endif end function w_wendlandc2 real function w_wendlandc4(q2) implicit none real, intent(in) :: q2 real :: q if (q2.lt.4.) then q = sqrt(q2) w_wendlandc4 = (1. - 0.5*q)**6*(35./12.*q2 + 3.*q + 1.) else w_wendlandc4 = 0. endif end function w_wendlandc4 real function w_wendlandc6(q2) implicit none real, intent(in) :: q2 real :: q if (q2.lt.4.) then q = sqrt(q2) w_wendlandc6 = (1. - 0.5*q)**8*(4.*q2*q + 25./4.*q2 + 4.*q + 1.) else w_wendlandc6 = 0. endif end function w_wendlandc6 end module kernels splash/src/labels.f90000644 000770 000000 00000022423 12350151660 015323 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------- ! ! routines to do with storing and handling of plot labels ! !----------------------------------------------------------- module labels use params, only:maxplot, maxparttypes implicit none integer, parameter :: lenlabel = 80 integer, parameter :: lenunitslabel = 40 ! length of units label character(len=lenlabel), dimension(maxplot+2) :: label,labelvec character(len=20), dimension(maxparttypes) :: labeltype character(len=6), parameter :: labeldefault = 'column' character(len=lenunitslabel), dimension(0:maxplot), public :: unitslabel character(len=lenunitslabel), public :: labelzintegration integer, dimension(3) :: ix integer, dimension(maxplot) :: iamvec integer :: ivx,irho,iutherm,ipr,ih,irad,iBfirst,iBpol,iBtor,iax integer :: ipmass,ike,ispsound integer :: idivb,iJfirst,irhostar integer :: iacplane,ipowerspec integer :: icv,iradenergy integer :: isurfdens,itoomre integer :: ipdf,icolpixmap integer :: irhorestframe,idustfrac,ideltav public contains !-------------------------------------------------------------- ! ! utility to reset default settings for column identification ! !-------------------------------------------------------------- subroutine reset_columnids implicit none ! !--array positions of specific quantities ! Identification is used in exact solution ! plotting and calculation of additional quantities ! ix(:) = 0 ivx = 0 ! vx irho = 0 ! density ipr = 0 ! pressure iutherm = 0 ! thermal energy ih = 0 ! smoothing length irad = 0 ! radius ipmass = 0 ! particle mass ipr = 0 ! pressure irad = 0 ! radius ipowerspec = 0 ! power spectrum iBfirst = 0 ! Bx iax = 0 ! ax (acceleration) iBpol = 0 ! B_polx iBtor = 0 ! B_torx iacplane = 0 ike = 0 idivB = 0 iJfirst = 0 icv = 0 iradenergy = 0 icolpixmap = 0 irhorestframe = 0 return end subroutine reset_columnids !-------------------------------------------------------------- ! ! query function for whether column is a spatial coordinate ! !-------------------------------------------------------------- logical function is_coord(icol,ndim) implicit none integer, intent(in) :: icol,ndim integer :: i is_coord = .false. do i=1,ndim if (ix(i).eq.icol) is_coord = .true. enddo end function is_coord !----------------------------------------------------------------- ! ! utility to strip spaces, escape sequences and ! units labels from strings (this can be called for both ! function strings and variable labels) ! !----------------------------------------------------------------- elemental function shortstring(string,unitslab) use asciiutils, only:string_delete implicit none character(len=lenlabel), intent(in) :: string character(len=*), intent(in), optional :: unitslab character(len=lenlabel) :: shortstring integer :: ipos shortstring = string !--strip off the units label if (present(unitslab)) then if (len_trim(unitslab).gt.0) then !--remove units label (only do this once) ipos = index(trim(shortstring),trim(unitslab)) if (ipos.ne.0) then shortstring = shortstring(1:ipos-1)//& shortstring(ipos+len_trim(unitslab)+1:len_trim(shortstring)) endif endif endif !--remove spaces call string_delete(shortstring,' ') !--remove escape sequences (\d etc.) call string_delete(shortstring,'\d') call string_delete(shortstring,'\u') call string_delete(shortstring,'\g') call string_delete(shortstring,'\') call string_delete(shortstring,'_') end function shortstring !------------------------------------------------------------------ ! ! Same as shortstring, but also strips any arithmetic operators ! should be applied to variable names, but not function strings ! !----------------------------------------------------------------- elemental function shortlabel(string,unitslab) use asciiutils, only:string_delete implicit none character(len=lenlabel), intent(in) :: string character(len=*), intent(in), optional :: unitslab character(len=lenlabel) :: shortlabel if (present(unitslab)) then shortlabel = shortstring(string,unitslab) else shortlabel = shortstring(string) endif !--remove arithmetic operators from labels call string_delete(shortlabel,'**') call string_delete(shortlabel,'/') call string_delete(shortlabel,'*') call string_delete(shortlabel,'+') call string_delete(shortlabel,'-') call string_delete(shortlabel,'^') call string_delete(shortlabel,'sqrt(') call string_delete(shortlabel,'(') call string_delete(shortlabel,')') call string_delete(shortlabel,'{') call string_delete(shortlabel,'}') call string_delete(shortlabel,'[') call string_delete(shortlabel,']') call string_delete(shortlabel,'<') call string_delete(shortlabel,'>') call string_delete(shortlabel,'\(2268)') end function shortlabel !--------------------------------------------------------------- ! interface for adjusting the label for column-integrated plots !--------------------------------------------------------------- function integrate_label(labelin,iplot,izcol,normalise,iRescale,labelzint,& projlabelformat,iapplyprojformat) use asciiutils, only:string_replace implicit none character(len=*), intent(in) :: labelin,labelzint,projlabelformat integer, intent(in) :: iplot,izcol,iapplyprojformat logical, intent(in) :: normalise,iRescale character(len=len(label)+20) :: integrate_label if (len_trim(projlabelformat).ne.0 .and. (iapplyprojformat.eq.0 .or. iapplyprojformat.eq.iplot)) then integrate_label = projlabelformat call string_replace(integrate_label,'%l',trim(labelin)) if (iRescale) then call string_replace(integrate_label,'%z',trim(label(izcol)(1:index(label(izcol),unitslabel(izcol))-1))) call string_replace(integrate_label,'%uz',trim(unitslabel(izcol))) else call string_replace(integrate_label,'%z',trim(label(izcol))) endif else if (normalise) then integrate_label = '< '//trim(labelin)//' >' else if (iRescale) then integrate_label = '\(2268) '//trim(labelin)//' d'// & trim(label(izcol)(1:index(label(izcol),unitslabel(izcol))-1))//trim(labelzint) else integrate_label = '\(2268) '//trim(labelin)//' d'//trim(label(izcol)) endif if (iplot.eq.irho .and. (index(labelin,'density').ne.0 .or. index(labelin,'rho').ne.0)) then integrate_label = 'column density' !--try to get units label right for column density ! would be nice to have a more robust way of knowing what the units mean if (iRescale .and. index(labelzint,'cm').gt.0 & .and. trim(adjustl(unitslabel(irho))).eq.'[g/cm\u3\d]') then integrate_label = trim(integrate_label)//' [g/cm\u2\d]' endif endif endif endif end function integrate_label !----------------------------------------------------------------- ! ! utility to "guess" which particle type contains sink particles ! from the label ! !----------------------------------------------------------------- integer function get_sink_type(ntypes) implicit none integer, intent(in) :: ntypes integer :: i get_sink_type = 0 do i=1,ntypes if (get_sink_type.eq.0 .and. index(labeltype(i),'sink').ne.0) get_sink_type = i enddo end function get_sink_type !----------------------------------------------------------------- ! ! utility to neatly print number of particles by type ! !----------------------------------------------------------------- subroutine print_types(noftype,ltype) integer, dimension(:), intent(in) :: noftype character(len=*), dimension(:), intent(in) :: ltype integer :: itype,n,i character(len=1) :: sp i = 0 sp = ' ' do itype=1,size(noftype) n = noftype(itype) if (n > 0) then i = i + 1 if (i > 1) sp = ',' if (n < 10000) then write(*,"(a,i4)",advance='no') trim(sp)//' n('//trim(ltype(itype))//') = ',n elseif (n < 1000000) then write(*,"(a,i6)",advance='no') trim(sp)//' n('//trim(ltype(itype))//') = ',n elseif (n < 100000000) then write(*,"(a,i8)",advance='no') trim(sp)//' n('//trim(ltype(itype))//') = ',n else write(*,"(a,i10)",advance='no') trim(sp)//' n('//trim(ltype(itype))//') = ',n endif endif enddo write(*,*) end subroutine print_types end module labels splash/src/legends.f90000644 000770 000000 00000033711 12430517364 015512 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! module containing routines for plotting legends in PGPLOT ! subroutines: ! legend : plots time on plots ! legend_vec : plots legend with vector arrow ! legend_markers : plots different particle types ! legend_scale : plots a scale on co-ordinate plots !----------------------------------------------------------------- module legends implicit none public :: legend, legend_vec, legend_markers, legend_scale public :: prompt_panelselect, ipanelselect private contains !----------------------------------------------------------------- ! plots time on plot ! arguments: ! t : current time ! hpos : horizontal position as fraction of viewport ! vpos : vertical position in character heights from top !----------------------------------------------------------------- subroutine legend(legendtext,t,unitslabel,hpos,vpos,fjust,usebox) use plotlib, only:plot_annotate use asciiutils, only:string_replace use parsetext, only:parse_text,rn implicit none real, intent(in) :: t,hpos,vpos,fjust character(len=*), intent(in) :: legendtext,unitslabel logical, intent(in) :: usebox character(len=len(legendtext)+len(unitslabel)+20) :: label integer, parameter :: nvars = 1 real(kind=rn), dimension(nvars) :: vals character(len=1), dimension(nvars) :: vars label = trim(legendtext) ! ! if string does not contain any formatting ! append the time variable to it ! if (index(label,'%') <= 0) then if (t < 1.) then label = trim(label)//'%t.2' else label = trim(label)//'%t.3' endif endif ! ! parse string for functions of time and formatting ! i.e. %t.5 ! vars = (/'t'/) vals(1) = real(t,kind=rn) call parse_text(label,vars,vals) if (index(label,'%ut').gt.0) then call string_replace(label,'%ut',trim(unitslabel)) else label = trim(label)//trim(unitslabel) endif if (usebox) call plot_box_around_text(trim(label),hpos,vpos,fjust) call plot_annotate('T',-vpos,hpos,fjust,trim(label)) return end subroutine legend !----------------------------------------------------------------- ! utility routine for plotting translucent box in legends !----------------------------------------------------------------- subroutine plot_box_around_text(string,hpos,vpos,fjust) use plotlib, only:plot_qwin,plot_qcs,plot_qtxt,plot_qci,plot_sci,plot_sfs, & plot_set_opacity, plot_rect implicit none character(len=*), intent(in) :: string real, intent(in) :: hpos,vpos,fjust real :: xmin,xmax,ymin,ymax,xpos,ypos real :: xbuf,ybuf,dx,dy,xch,ych,x1,x2,y1,y2 real, dimension(4) :: xbox,ybox integer :: ic ! !--convert hpos and vpos to x, y to plot arrow ! call plot_qwin(xmin,xmax,ymin,ymax) xpos = xmin + hpos*(xmax-xmin) call plot_qcs(4,xch,ych) ypos = ymax - (vpos + 1.)*ych ! !--enquire bounding box of string ! call plot_qtxt(xpos,ypos,0.0,0.0,trim(string),xbox,ybox) xbuf = 0.25*xch ybuf = 0.5*ych dx = xbox(3) - xbox(1) dy = ybox(3) - ybox(1) + 0.25*ych x1 = xpos - fjust*dx - xbuf x2 = x1 + dx + 2.*xbuf y1 = ypos y2 = y1 + dy + ybuf ! !--draw box around the string ! call plot_qci(ic) ! query colour index call plot_sci(0) ! background colour call plot_sfs(1) ! solid fill style call plot_set_opacity(0.5) call plot_rect(x1,x2,y1,y2,0.2*ych) ! draw a (rounded) rectangle call plot_set_opacity(1.0) call plot_sci(ic) ! restore colour index end subroutine plot_box_around_text !----------------------------------------------------------------- ! plots vector plot legend ! arguments: ! t : current time ! hpos : horizontal position as fraction of viewport ! vpos : vertical position in character heights from top ! charheight : this is the text character height ! (legend_vec is called directly after plotting the arrows, ! which may use a different character size - so we plot ! the arrow here in the same way, but then revert to ! the text character height to write the text) !----------------------------------------------------------------- subroutine legend_vec(label,unitslabel,vecmax,dx,hpos,vpos,charheight) use plotlib, only:plot_qwin,plot_qch,plot_sch,plot_qcs,plot_numb,plot_qtxt, & plot_qci,plot_sci,plot_sfs,plot_rect,plot_sci,plot_text, & plot_qvp,plot_svp,plot_swin,plot_arro,plot_set_opacity implicit none real, intent(in) :: vecmax,dx,hpos,vpos,charheight character(len=*), intent(in) :: label,unitslabel real :: xmin,xmax,ymin,ymax real :: xch,ych,charheightarrow,adjustlength,vecmaxnew real :: xpos,ypos,xbox(4),ybox(4),dxlabel,dxstring real :: dxbuffer,dybuffer,dxbox,dybox real :: xminnew,xmaxnew,yminnew,ymaxnew,x1,x2,y1,y2 integer :: icolindex,mm,pp,nc,ndec character(len=len(label)+20) :: string ! !--convert hpos and vpos to x, y to plot arrow ! call plot_qwin(xmin,xmax,ymin,ymax) call plot_qch(charheightarrow) call plot_sch(charheight) xpos = xmin + hpos*(xmax-xmin) call plot_qcs(4,xch,ych) ypos = ymax - (vpos + 1.)*ych ! !--format string containing numerical value ! vecmax corresponds to arrow of length dx ! we will draw an arrow of length sqrt(dx^2 + ych^2) ! so adjust vecmax accordingly ! adjustlength = sqrt(0.5*dx**2 + ych**2)/dx vecmaxnew = adjustlength*vecmax ndec = 2 if (vecmaxnew.lt.tiny(vecmaxnew)) then string = '0' nc = 1 else mm=int(vecmaxnew/10.**(int(log10(vecmaxnew)-ndec))) pp=int(log10(vecmaxnew)-ndec) call plot_numb(mm,pp,0,string,nc) endif string = '='//trim(string) ! write(string,"('=',1pe7.1)") vecmax ! !--enquire size of label ! call plot_qtxt(xpos,ypos,0.0,0.0,trim(label),xbox,ybox) dxlabel = xbox(3) - xbox(2) + 0.5*xch ! !--enquire size of string ! call plot_qtxt(xpos,ypos,0.0,0.0,trim(string),xbox,ybox) dxstring = xbox(3) - xbox(2) ! !--set size of box in x direction ! dxbuffer = 0.25*xch ! these are size of margins (x and y) dybuffer = 0.25*ych dxbox = dxlabel + dxstring + 1.1*dx/sqrt(2.) + dxbuffer dybox = ych + 0.5*dybuffer ! !--draw box around all of the legend ! call plot_qci(icolindex) ! draw a (rounded) rectangle in the background colour with solid fill style call plot_sci(0) call plot_sfs(1) call plot_set_opacity(0.66) call plot_rect(xpos-dxbuffer,xpos+dxbox,ypos-dybuffer,ypos + dybox,0.33*ych) call plot_set_opacity(1.0) ! change to foreground colour index call plot_sci(1) ! draw an outline around the box ! call pgsfs(2) ! call pgrect(xpos-dxbuffer,xpos+dxbox,ypos-dybuffer,ypos + dybox) ! call pgsfs(1) ! !--write label ! call plot_text(xpos,ypos,trim(label)) xpos = xpos + dxlabel ! !--Draw arrow. Here we have to perform tricks to get the arrow ! to appear even if outside the usual plotting area ! !--save viewport settings call plot_qvp(0,x1,x2,y1,y2) !--now allow the whole screen to be the viewport... call plot_svp(0.0,1.0,0.0,1.0) ! ...but correspondingly adjust window so that x and y positions ! are the same as in the old viewport xminnew = xmin - x1*(xmax-xmin)/(x2-x1) xmaxnew = xmax + (1.-x2)*(xmax-xmin)/(x2-x1) yminnew = ymin - y1*(ymax-ymin)/(y2-y1) ymaxnew = ymax + (1.-y2)*(ymax-ymin)/(y2-y1) call plot_swin(xminnew,xmaxnew,yminnew,ymaxnew) !--use character height original arrows were drawn with ! (this is to get the arrow head size right) call plot_sch(charheightarrow) !--draw arrow call plot_arro(xpos,ypos,xpos + dx/sqrt(2.),ypos + ych) !--restore viewport settings call plot_svp(x1,x2,y1,y2) call plot_swin(xmin,xmax,ymin,ymax) xpos = xpos + 1.1*dx/sqrt(2.) ! !--write numerical value and units label ! call plot_sch(charheight) !! call pgmtext('t',-vpos,hpos+0.02,0.0,trim(string)) call plot_text(xpos,ypos,trim(string)//trim(unitslabel)) ! !--restore colour index call plot_sci(icolindex) return end subroutine legend_vec !------------------------------------------------------------------------- ! draw a legend for different line/marker styles ! uses current line style and colour ! plots this below the time legend !------------------------------------------------------------------------- subroutine legend_markers(icall,icolour,imarkerstyle,ilinestyle, & iplotpts,iplotline,text,hposlegend,vposlegend,alphalegend) use plotlib, only:plot_qwin,plot_qcs,plot_qci,plot_qls,plot_sci,plot_sls, & plot_line,plot_pt,plot_text,plot_stbg,plot_slc,plot_qlc,plot_set_opacity implicit none integer, intent(in) :: icall,icolour,imarkerstyle,ilinestyle logical, intent(in) :: iplotpts,iplotline character(len=*), intent(in) :: text real, intent(in) :: hposlegend,vposlegend,alphalegend integer :: icolourprev, ilinestyleprev,ilinecapprev real, dimension(3) :: xline,yline real :: xch, ych, xmin, xmax, ymin, ymax real :: vspace, vpos ! !--do not plot anything if string is blank ! if (len_trim(text).le.0) return !call pgstbg(0) ! opaque text to overwrite previous ! !--set horizontal and vertical position and spacing ! in units of the character height ! vspace = 1.5 ! (in units of character heights) vpos = vposlegend + icall*vspace + 0.5 ! distance from top, in units of char height call plot_qwin(xmin,xmax,ymin,ymax) ! query xmax, ymax call plot_qcs(4,xch,ych) ! query character height in x and y units call plot_qci(icolourprev) ! save current colour index call plot_qls(ilinestyleprev) ! save current line style call plot_qlc(ilinecapprev) ! save the current line cap yline(:) = ymax - ((vpos - 0.5)*ych) xline(1) = xmin + hposlegend*(xmax-xmin) xline(2) = xline(1) + 1.5*xch xline(3) = xline(1) + 3.*xch call plot_sci(icolour) call plot_set_opacity(alphalegend) call plot_sls(ilinestyle) ! !--set round caps ! !call plot_slc(1) ! !--draw a small line segment ! if (iplotline) call plot_line(3,xline,yline) call plot_slc(ilinecapprev) call plot_sls(ilinestyleprev) ! !--draw points, only two if line is also plotted so that you can see the line ! three otherwise ! if (iplotpts .and. iplotline) then xline(2) = xline(3) call plot_pt(2,xline(1:2),yline(1:2),imarkerstyle) elseif (iplotpts) then call plot_pt(3,xline,yline,imarkerstyle) endif ! !--add text ! if (iplotline .or. iplotpts .and. len_trim(text).gt.0) then call plot_text(xline(3) + 0.75*xch,yline(1)-0.25*ych,trim(text)) endif call plot_sci(icolourprev) ! reset colour index call plot_set_opacity(1.0) call plot_stbg(-1) ! reset text background to transparent end subroutine legend_markers !------------------------------------------------------------------- ! plots labelled scale (horizontal error bar of a given length) ! can be used on co-ordinate plots to give a length scale ! ! e.g. would produce something like: ! ! |----| ! 10 AU ! ! arguments: ! dxscale : length of scale in current x units ! hpos : horizontal position as fraction of viewport ! vpos : vertical position in character heights from top ! text : label to print above scale !----------------------------------------------------------------- subroutine legend_scale(dxscale,hpos,vpos,text) use plotlib, only:plot_qwin,plot_qcs,plot_err1,plot_annotate implicit none real, intent(in) :: dxscale,hpos,vpos character(len=*), intent(in) :: text real :: xmin,xmax,ymin,ymax,xch,ych,xpos,ypos call plot_qwin(xmin,xmax,ymin,ymax) if (dxscale.gt.(xmax-xmin)) then print "(a)",'Error: scale size exceeds x dimensions: scale not plotted' else call plot_qcs(4,xch,ych) !--draw horizontal "error bar" above text ypos = ymin + (vpos+1.25)*ych xpos = xmin + hpos*(xmax-xmin) call plot_err1(5,xpos,ypos,0.5*dxscale,1.0) !--write text at the position specified call plot_annotate('B',-vpos,hpos,0.5,trim(text)) endif end subroutine legend_scale !------------------------------------------------------------------- ! The following subroutines handle the plotting of annotation ! and legends only on particular panels !------------------------------------------------------------------- subroutine prompt_panelselect(string,iselect) use prompting, only:prompt implicit none character(len=*), intent(in) :: string integer, intent(inout) :: iselect print "(4(/,a))", & ' 0 : plot '//trim(string)//' on every panel ', & ' n : plot '//trim(string)//' on nth panel only ', & ' -1 : plot '//trim(string)//' on first row only ', & ' -2 : plot '//trim(string)//' on first column only ' call prompt('Enter selection ',iselect,-2) end subroutine prompt_panelselect !------------------------------------------------------------------- ! Function that evaluates the logic required to determine ! whether the annotation should be plotted on the current panel ! as per the prompts in prompt_panelselect !------------------------------------------------------------------- logical function ipanelselect(iselect,ipanel,irow,icolumn) implicit none integer, intent(in) :: iselect,ipanel,irow,icolumn ipanelselect = ((iselect.gt.0 .and. ipanel.eq.iselect) & .or.(iselect.eq.-1 .and. irow.eq.1) & .or.(iselect.eq.-2 .and. icolumn.eq.1) & .or.(iselect.eq.0)) end function ipanelselect end module legends splash/src/limits.f90000644 000770 000000 00000031212 12332263313 015355 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------- ! ! subroutines to do with setting of plot limits from data ! and using only a subset of the particles according to a ! range in parameters ! !---------------------------------------------------------- module limits use params implicit none real, dimension(maxplot,2) :: lim,range,lim2 private :: warn_minmax public contains !---------------------------------------------------------- ! set plot limits for all columns ! NB: does not differentiate between particle types at the moment !---------------------------------------------------------- subroutine set_limits(ifromstep,itostep,ifromcol,itocol) use labels, only:label,ix use geometry, only:coord_transform_limits use particle_data, only:npartoftype,dat,maxcol use settings_data, only:ndim,icoords,icoordsnew integer, intent(in) :: ifromstep,itostep,ifromcol,itocol integer :: i,j,k,ntoti,itocoli print 100,ifromstep,itostep,ifromcol,itocol 100 format(/' setting plot limits: steps ',i5,'->',i5,' cols ',i2,'->',i3) if (ifromcol.gt.maxcol .or. maxcol.eq.0) then print "(a)",' *** error: set_limits: column > array size ***' return endif if (ifromcol.gt.itocol) then print "(a)",' *** error in call to set_limits: begin column > end column' return endif itocoli = itocol if (itocol.gt.maxcol) then print "(a,i3,a)",' *** warning: set_limits: only setting limits up to column ',maxcol,' ***' itocoli = maxcol endif !!--find limits of particle properties lim(ifromcol:itocol,1) = huge(lim) lim(ifromcol:itocol,2) = -huge(lim) do i=ifromstep,itostep ntoti = sum(npartoftype(:,i)) do j=ifromcol,itocoli do k=1,ntoti lim(j,1) = min(lim(j,1),dat(k,j,i)) lim(j,2) = max(lim(j,2),dat(k,j,i)) enddo enddo enddo ! !--warn if limits are the same ! do j=ifromcol,itocol call warn_minmax(label(j),lim(j,1),lim(j,2)) enddo !print "(a/)",' plot limits set' lim2(ifromcol:itocol,:) = 0. ! !--transform coord limits into new coordinate system if coord transform is applied ! if (icoordsnew.ne.icoords .and. ndim.gt.0) then if (ifromcol.le.ix(ndim)) then ! separate if is to avoid referencing ix(0) if ndim=0 call coord_transform_limits(lim(ix(1):ix(ndim),1),lim(ix(1):ix(ndim),2), & icoords,icoordsnew,ndim) endif endif return end subroutine set_limits !---------------------------------------------------------- ! save plot limits for all columns to a file !---------------------------------------------------------- subroutine write_limits(limitsfile) use settings_data, only:numplot,ndataplots character(len=*), intent(in) :: limitsfile integer :: i print*,'saving plot limits to file ',trim(limitsfile) open(unit=55,file=limitsfile,status='replace',form='formatted',ERR=998) do i=1,numplot if (rangeset(i) .and. i.lt.ndataplots .and. lim2set(i)) then write(55,"(6(1x,1pe14.6))",err=999) lim(i,1),lim(i,2),range(i,1),range(i,2),lim2(i,1),lim2(i,2) elseif (lim2set(i) .and. i.lt.ndataplots) then write(55,"(6(1x,1pe14.6))",err=999) lim(i,1),lim(i,2),0.,0.,lim2(i,1),lim2(i,2) elseif (rangeset(i) .and. i.lt.ndataplots) then write(55,"(4(1x,1pe14.6))",err=999) lim(i,1),lim(i,2),range(i,1),range(i,2) else write(55,"(2(1x,1pe14.6))",err=999) lim(i,1),lim(i,2) endif enddo close(unit=55) return 998 continue print*,'*** error opening limits file: limits not saved' return 999 continue print*,'*** error saving limits' close(unit=55) return end subroutine write_limits !---------------------------------------------------------- ! read plot limits for all columns from a file !---------------------------------------------------------- subroutine read_limits(limitsfile,ierr) use labels, only:label use settings_data, only:numplot,ncolumns,ncalc use asciiutils, only:ncolumnsline character(len=*), intent(in) :: limitsfile integer, intent(out) :: ierr integer :: i,ncolsline character(len=120) :: line logical :: iexist ierr = 0 inquire(file=limitsfile,exist=iexist) if (.not.iexist) then print "(1x,a)",trim(limitsfile)//' not found' ierr = 1 return endif open(unit=54,file=limitsfile,status='old',form='formatted',err=997) print "(a)",' read '//trim(limitsfile) do i=1,numplot read(54,"(a)",err=998,end=999) line ncolsline = ncolumnsline(line) if (ncolsline.lt.2) then goto 998 elseif (ncolsline.ge.6) then read(line,*,err=998,end=999) lim(i,1),lim(i,2),range(i,1),range(i,2),lim2(i,1),lim2(i,2) elseif (ncolsline.ge.4) then read(line,*,err=998,end=999) lim(i,1),lim(i,2),range(i,1),range(i,2) else read(line,*,err=998,end=999) lim(i,1),lim(i,2) endif call assert_sensible_limits(lim(i,1),lim(i,2)) ! !--warn if limits are the same ! call warn_minmax(label(i),lim(i,1),lim(i,2)) enddo close(unit=54) return 997 continue print*,trim(limitsfile),' not found' ierr = 1 return 998 continue call print_rangeinfo() call print_lim2info() print*,'*** error reading limits from file' ierr = 2 close(unit=54) return 999 continue !--only give error if we really do not have enough columns ! (on first call nextra is not set) if (i.le.ncolumns+ncalc) then print "(a,i3)",' end of file in '//trim(limitsfile)//': limits read to column ',i ierr = -1 endif !--print info about range restrictions read from file call print_rangeinfo() call print_lim2info() close(unit=54) return end subroutine read_limits !---------------------------------------------------------- ! get a subset of the particles by enforcing range restrictions !---------------------------------------------------------- subroutine get_particle_subset(icolours,datstep,ncolumns) use labels, only:label integer, intent(inout) :: icolours(:) real, intent(in) :: datstep(:,:) integer, intent(in) :: ncolumns integer :: icol if (anyrangeset()) then !--reset colours of all particles (to not hidden) if using range restriction where (icolours(:).eq.-1000) icolours(:) = 0 elsewhere icolours(:) = abs(icolours(:)) endwhere do icol=1,ncolumns if (rangeset(icol)) then print "(a,1pe10.3,a,1pe10.3,a)",' | using only particles in range ', & range(icol,1),' < '//trim(label(icol))//' < ',range(icol,2),' |' ! !--loop over the particles and colour those outside the range ! NB: background colour (0) is set to -1000 ! where (datstep(:,icol).lt.range(icol,1) .or. & datstep(:,icol).gt.range(icol,2)) where (icolours.eq.0) icolours = -1000 elsewhere icolours = -abs(icolours) end where end where endif enddo endif return end subroutine get_particle_subset !---------------------------------------------------------- ! reset all range restrictions to zero !---------------------------------------------------------- subroutine reset_all_ranges() use particle_data, only:icolourme print "(a)",' removing all range restrictions ' where (icolourme(:).eq.-1000) icolourme(:) = 0 elsewhere icolourme(:) = abs(icolourme(:)) endwhere range(:,:) = 0. return end subroutine reset_all_ranges !---------------------------------------------------------- ! function which returns whether or not a range ! has been set for a given column !---------------------------------------------------------- logical function rangeset(icol) integer, intent(in) :: icol rangeset = .false. if (abs(range(icol,2)-range(icol,1)).gt.tiny(range)) rangeset = .true. return end function rangeset !---------------------------------------------------------- ! function which returns whether or not lim2 ! has been set for a given column !---------------------------------------------------------- logical function lim2set(icol) integer, intent(in) :: icol lim2set = .false. if (abs(lim2(icol,2)).gt.tiny(lim2) .or. abs(lim2(icol,1)).gt.tiny(lim2)) lim2set = .true. return end function lim2set !---------------------------------------------------------- ! reset all range restrictions to zero !---------------------------------------------------------- subroutine reset_lim2(icol) integer, intent(in) :: icol print "(a)",' contour limits same as render limits' if (icol.gt.0 .and. icol.le.maxplot) lim2(icol,:) = 0 return end subroutine reset_lim2 !---------------------------------------------------------- ! function which returns whether or not a range ! has been set for any column !---------------------------------------------------------- logical function anyrangeset() use settings_data, only:ndataplots integer :: i anyrangeset = .false. do i=1,ndataplots if (rangeset(i)) anyrangeset = .true. enddo return end function anyrangeset !---------------------------------------------------------- ! prints info about current range restriction settings !---------------------------------------------------------- subroutine print_rangeinfo() use settings_data, only:ndataplots use labels, only:label integer :: i if (anyrangeset()) then print "(/,a,/)",'>> current range restrictions set: ' do i=1,ndataplots if (rangeset(i)) then print "(a,1pe10.3,a,1pe10.3,a)", & ' ( ',range(i,1),' < '//trim(label(i))//' < ',range(i,2),' )' endif enddo print "(/,2(a,/))",'>> only particles within this range will be plotted ', & ' and/or used in interpolation routines' !else !print "(/,a,/)",'>> no current parameter range restrictions set ' endif end subroutine print_rangeinfo !---------------------------------------------------------- ! prints info about current range restriction settings !---------------------------------------------------------- subroutine print_lim2info() use settings_data, only:ndataplots use labels, only:label integer :: i do i=1,ndataplots if (lim2set(i)) then print "(a,1pe10.3,a,1pe10.3,a)", & ' ( contours use ',lim2(i,1),' < '//trim(label(i))//' < ',lim2(i,2),' )' endif enddo end subroutine print_lim2info !---------------------------------------------------------- ! prints warning if min=max in limits setting !---------------------------------------------------------- subroutine warn_minmax(labelx,xmin,xmax) character(len=*), intent(in) :: labelx real, intent(in) :: xmin,xmax if (abs(xmin-xmax).lt.tiny(xmax)) then print "(a,a20,a,1pe9.2)",' warning: ',labelx,' min = max = ',xmin endif return end subroutine warn_minmax !---------------------------------------------------------- ! Makes sure that variable is within a given range ! If no range specified, ensures that it is within ! the allowed range for the variable type, ! i.e. -0.5*huge(x)->0.5*huge(x) !---------------------------------------------------------- subroutine assert_range(x,min,max) real, intent(inout) :: x real, intent(in), optional :: min,max real :: xmin,xmax xmin = -0.5*huge(xmin) ! for limits need xmax - xmin to xmax = 0.5*huge(xmax) ! be less than huge(x) if (present(min)) xmin = min if (present(max)) xmax = max if (x < xmin) x = xmin if (x > xmax) x = xmax if (x /= x) x = 0. return end subroutine assert_range !---------------------------------------------------------- ! Interface to the above, but checks two numbers at once ! and checks that max > min !---------------------------------------------------------- subroutine assert_sensible_limits(xmin,xmax) real, intent(inout) :: xmin,xmax real :: xtmp call assert_range(xmin) call assert_range(xmax) if (xmax < xmin) then xtmp = xmin xmin = xmax xmax = xtmp endif return end subroutine assert_sensible_limits end module limits splash/src/menu.f90000644 000770 000000 00000075274 12611360561 015043 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !-------------------- ! SPLASH MAIN MENU !-------------------- module mainmenu implicit none public :: menu,allowrendering,set_extracols private contains subroutine menu use filenames, only:defaultsfile,limitsfile,fileprefix,set_filenames use labels, only:label,labelvec,iamvec,isurfdens,itoomre,ipdf,icolpixmap,is_coord,ix use limits, only:write_limits,lim2,lim,reset_lim2,lim2set use options_data, only:submenu_data use settings_data, only:ndim,numplot,ndataplots,nextra,ncalc,ivegotdata, & buffer_data,ncolumns,icoords,icoordsnew use settings_limits, only:submenu_limits,iadapt use settings_part, only:submenu_particleplots use settings_page, only:submenu_page,submenu_legend,interactive,nacross,ndown use settings_render, only:submenu_render,iplotcont_nomulti,icolours,double_rendering use settings_vecplot, only:submenu_vecplot,iplotpartvec use settings_xsecrot, only:submenu_xsecrotate,xsec_nomulti use multiplot use prompting, only:prompt,print_logical use transforms, only:transform_label use defaults, only:defaults_write use getdata, only:get_data use geomutils, only:set_coordlabels use timestepping implicit none integer :: i,icol,ihalf,iadjust,indexi,ierr integer :: ipicky,ipickx,irender,ivecplot,icontourplot integer :: iamvecprev, ivecplottemp,ichoose character(len=2) :: ioption character(len=100) :: vecprompt,string character(len=20) :: rprompt character(len=*), parameter :: sep="(55('-'))" logical :: iAllowRendering irender = 0 icontourplot = 0 ivecplot = 0 if (ndim > 1 .and. ix(1) > 0) then ipickx = ix(1) else ipickx = 1 endif ipicky = 1 menuloop: do !--------------------------------------------------------------------------- ! preliminaries !--------------------------------------------------------------------------- ! !--make sure the number of columns is set appropriately ! (nextra can change depending on what options are set) ! ! !--numplot is the total number of data columns (read + calculated) ! not including the particle co-ordinates ! nextra are extra graphs to plot (e.g. convergence plots, power spectrum) ! ! note that numplot and ndataplots should *only* be set here ! this means that even if ncolumns changes during data reads while plotting ! we don't start plotting new quantities ! call set_extracols(ncolumns,ncalc,nextra,numplot,ndataplots) ! !--set the coordinate and vector labels ! if working in a different coordinate system ! call set_coordlabels(numplot) !--set contents of the vector plotting prompt vecprompt(1:6) = '0=none' indexi = 7 iamvecprev = 0 do icol=1,numplot if (iamvec(icol).ne.0 .and. iamvec(icol).ne.iamvecprev) then iamvecprev = iamvec(icol) if (iamvec(icol).ge.10) then write(vecprompt(indexi:),"(',',1x,i2,'=',a)") & iamvec(icol),trim(labelvec(icol)) else write(vecprompt(indexi:),"(',',1x,i1,'=',a)") & iamvec(icol),trim(labelvec(icol)) endif indexi = len_trim(vecprompt) + 1 endif enddo ichoose = 0 !--------------------------------------------------------------------------- ! print menu !--------------------------------------------------------------------------- if (numplot.gt.0) then ! !--data columns ! call print_header() print sep ihalf = numplot/2 ! print in two columns iadjust = mod(numplot,2) print "(1x,i2,')',1x,a20,1x,i2,')',1x,a20)", & (i,transform_label(label(i),itrans(i)), & ihalf + i + iadjust, transform_label(label(ihalf + i + iadjust), & itrans(ihalf+i+iadjust)),i=1,ihalf) if (iadjust.ne.0) then print "(1x,i2,')',1x,a20)", & ihalf + iadjust,transform_label(label(ihalf + iadjust), & itrans(ihalf+iadjust)) endif ! !--multiplot ! print sep print "(1x,i2,')',1x,a,'[ ',i2,' ]',5x,a2,') ',a)", & numplot+1,'multiplot ',nyplotmulti,'m','set multiplot ' else ! !--if no data ! print "(/a)",' No data: You may choose from the options below ' endif ! !--options ! print sep if (ndim.le.1) then print "(a)",' d(ata) p(age) o(pts) l(imits) le(g)end s,S(ave) q(uit)' else print "(a)",' d(ata) p(age) o(pts) l(imits) le(g)end h(elp)' print "(a)",' r(ender) v(ector) x(sec/rotate) s,S(ave) q(uit)' endif print sep ! !--prompt user for selection ! write(*,"(a)",ADVANCE='NO') 'Please enter your selection now (y axis or option):' read(*,"(a)",iostat=ierr) string if (ierr < 0) stop 'reached end of input' ! end of input (e.g. in script) if (ierr > 0) stop !'error reading input' ioption = string(1:2) !------------------------------------------------------------ ! if input is an integer and within range, plot data !------------------------------------------------------------ read(ioption,*,iostat=ierr) ipicky if (ierr /= 0) ipicky = -1 !--try to read more integers from the string ! if present, use these to set up an "instant multiplot" if (ipicky > 0 .and. ipicky < numplot+1 .and. len_trim(string) > 2) then call set_instant_multiplot(string,ipicky,ipickx,numplot,nyplotmulti,& multiplotx,multiploty,nacross,ndown) endif if (ipicky > 0 .and. ipicky <= numplot+1) then if (.not.ivegotdata) then ! !--do not allow plotting if no data - instead try to read data ! print*,' no data ' if (buffer_data) then call get_data(-1,.false.) else call get_data(1,.false.,firsttime=.true.) endif else ! !--if needed prompt for x axis selection ! if (ipicky <= (numplot-nextra)) then if (ipickx==0) then if (ndim > 1 .and. ix(1) > 0) then ipickx = ix(1) else ipickx = 1 ! do not allow zero as default endif endif if (ipickx==ipicky) then ! do not allow x same as y by default if (ipickx > 1) then ipickx = ipicky-1 else ipickx = ipicky+1 endif endif call prompt(' (x axis) ',ipickx) !--go back to y prompt if out of range if (ipickx.gt.numplot .or. ipickx.le.0) cycle menuloop ! !--work out whether rendering is allowed ! iAllowRendering = allowrendering(ipickx,ipicky,xsec_nomulti) ! !--prompt for render and vector plots ! -> only allow if in "natural" coord system, otherwise h's would be wrong) ! (a future feature might be to interpolate in icoord then translate the pixels ! to icoordsnew, or alternatively plot non-cartesian pixel shapes) ! -> also do not allow if transformations are applied ! if (is_coord(ipicky,ndim) .and. is_coord(ipickx,ndim)) then if (iAllowRendering) then call prompt('(render) (0=none)',irender,0,(numplot-nextra)) if (irender > 0 .and. iplotcont_nomulti .and. icolours /= 0) then if (double_rendering) then rprompt = '2nd render' else rprompt = 'contours' endif call prompt('('//trim(rprompt)//') (0=none)',icontourplot,0,(numplot-nextra)) if (icontourplot==irender) then if (iadapt) then print "(a)",' limits for '//trim(rprompt)//' are adaptive' else if (.not.lim2set(icontourplot)) lim2(icontourplot,:) = lim(icontourplot,:) call prompt(' enter min for '//trim(rprompt)//':',lim2(icontourplot,1)) call prompt(' enter max for '//trim(rprompt)//':',lim2(icontourplot,2)) if (all(abs(lim2(icontourplot,:)-lim(icontourplot,:)) < tiny(lim))) then call reset_lim2(icontourplot) endif endif endif endif else irender = 0 endif if (any(iamvec(1:numplot).ne.0) .and. (icoordsnew.eq.icoords)) then ivecplottemp = -1 ierr = 1 do while(ierr /= 0 .and. ivecplottemp /= 0) ivecplottemp = ivecplot ierr = 0 call prompt('(vector plot) ('//trim(vecprompt)//')',ivecplottemp,0,maxval(iamvec)) if (.not.any(iamvec(1:numplot).eq.ivecplottemp)) then print "(a)",'Error, value not in list' ierr = 1 endif enddo ivecplot = ivecplottemp else ivecplot = 0 endif if (ivecplot.gt.0 .and. irender.eq.0) then call prompt('plot particles?',iplotpartvec) endif else irender = 0 ivecplot = 0 endif elseif (ipicky > 0 .and. ipicky==itoomre .or. ipicky==isurfdens) then if (ipicky==isurfdens) print "(a)",' setting x axis to r for surface density plot' if (ipicky==itoomre) print "(a)",' setting x axis to r for Toomre Q plot' ipickx = 1 irender = 0 ivecplot = 0 elseif (ipicky > 0 .and. ipicky==ipdf) then call prompt(' enter x axis for PDF calculation ',ipickx,1,ndataplots) irender = 0 ivecplot = 0 elseif (ipicky > 0 .and. ipicky==icolpixmap) then call prompt(' enter corresponding SPH column for particle data ',irender,0,ndataplots) ipickx = 0 ivecplot = 0 elseif (ipicky==numplot+1) then ! !--for multiplots, check that options are valid. If not, re-prompt for multiplot ! settings ! ipickx = 0 irender = 0 ivecplot = 0 if (any(multiploty(1:nyplotmulti) <= 0) .or. & any(multiploty(1:nyplotmulti) > numplot) .or. & any(multiplotx(1:nyplotmulti) <= 0) .or. & any(multiplotx(1:nyplotmulti) > numplot)) then print "(/,a,/)",'ERROR: multiplot settings out of range, please re-enter these' call options_multiplot endif endif ! !--call main plotting routine ! call timestep_loop(ipicky,ipickx,irender,icontourplot,ivecplot) endif !------------------------------------------------------------------------ ! if input is an integer > numplot+1, quit !------------------------------------------------------------------------ elseif (ipicky > numplot+1) then return else !------------------------------------------------------------------------ ! if input is a string, use menu options !------------------------------------------------------------------------ !-- Menu shortcuts; so you can type e.g. o2 and get the o)ptions menu, item 2 read(ioption(2:2),*,iostat=ierr) ichoose if (ierr /= 0) ichoose = 0 select case(ioption(1:1)) !------------------------------------------------------------------------ !+ Sets up plotting of (m)ultiple quantities per timestep case('m','M') call options_multiplot !------------------------------------------------------------------------ !+ This submenu sets options relating to the (d)ata read case('d','D') call submenu_data(ichoose) !------------------------------------------------------------------------ !+ This option turns (i)nteractive mode on/off case('i','I') interactive = .not.interactive print "(a)",' Interactive mode is '//print_logical(interactive) !------------------------------------------------------------------------ !+ This submenu sets (p)age setup options case('p','P') call submenu_page(ichoose) !------------------------------------------------------------------------ !+ This submenu sets particle plot (o)ptions case('o','O') call submenu_particleplots(ichoose) !------------------------------------------------------------------------ !+ This submenu sets le(g)end and title options case('g','G') call submenu_legend(ichoose) !------------------------------------------------------------------------ !+ This submenu sets (r)endering options case('r','R') if (ndim.le.1) print "(a)",'WARNING: these options have no effect in < 2D' call submenu_render(ichoose) !------------------------------------------------------------------------ !+ This submenu sets (v)ector plotting options case('v','V') if (ndim.le.1) print "(a)",'WARNING: these options have no effect in < 2D' call submenu_vecplot(ichoose) !------------------------------------------------------------------------ !+ This submenu sets cross section and rotation options case('x','X') if (ndim.le.1) print "(a)",'WARNING: these options have no effect in < 2D' call submenu_xsecrotate(ichoose) !------------------------------------------------------------------------ !+ This submenu sets options relating to the plot limits case('l','L') call submenu_limits(ichoose) !------------------------------------------------------------------------ !+ The (s)ave option saves the default options to a !+ file called `splash.defaults'' in the current directory which !+ is read automatically upon the next invocation of splash. !+ This file uses namelist formatting and may be edited !+ manually prior to startup if so desired. This is quite !+ useful for setting multiplots with many plots per page !+ The (S)ave option writes both the defaults file and !+ also saves the current plot limits to a file called !+ 'splash.limits' which is also read automatically !+ at startup. case('s') if (ioption(2:2).eq.'a') then call prompt('enter prefix for defaults file: ',fileprefix,noblank=.true.) if (index(fileprefix,'.defaults').eq.0) then defaultsfile = trim(fileprefix)//'.defaults' else defaultsfile = trim(fileprefix) endif endif call defaults_write(defaultsfile) case('S') if (ioption(2:2).eq.'a' .or. ioption(2:2).eq.'A') then call prompt('enter prefix for filenames: ',fileprefix,noblank=.true.) call set_filenames(trim(fileprefix)) endif call defaults_write(defaultsfile) call write_limits(limitsfile) !------------------------------------------------------------------------ !+ Slightly obsolete: prints whatever help may be helpful case('h','H') print "(10(/a))",' Hint: menu items can be shortcut by typing, e.g. o2 for ',& ' the o)ptions menu, item 2.',' ', & ' for detailed help, consult the user guide',' ',& ' (splash/docs/splash.pdf ',& ' or http://users.monash.edu.au/~dprice/splash/userguide/)', & ' ',' and/or the online FAQ. If you''re really stuck, email me! ' read* !------------------------------------------------------------------------ !+ (q)uit, unsurprisingly, quits. Typing a number greater !+ than the number of data columns also exits the program !+ (e.g. I often simply type 99 to exit). case('q','Q') return !------------------------------------------------------------------------ case DEFAULT print "(a)",'unknown option '//trim(ioption) end select endif enddo menuloop return contains !---------------------------------------------------- ! multiplot setup !---------------------------------------------------- subroutine options_multiplot use settings_page, only:nacross, ndown use settings_render, only:iplotcont_nomulti use limits, only:lim,lim2,lim2set,reset_lim2 use labels, only:is_coord,labeltype use params, only:maxparttypes use settings_data, only:ntypes implicit none integer :: ifac,ierr,itype,nvalues logical :: isamex, isamey, icoordplot, anycoordplot, imultisamepanel integer, dimension(maxparttypes) :: itypelist call prompt('Enter number of plots per timestep:',nyplotmulti,1,numplot) isamey = all(multiploty(1:nyplotmulti).eq.multiploty(1)) if (ndim.ge.2) call prompt('Same y axis for all?',isamey) if (isamey) then call prompt('Enter y axis for all plots',multiploty(1),1,numplot) multiploty(2:nyplotmulti) = multiploty(1) endif isamex = all(multiplotx(1:nyplotmulti).eq.multiplotx(1)) call prompt('Same x axis for all?',isamex) if (isamex) then call prompt('Enter x axis for all plots',multiplotx(1),1,numplot) multiplotx(2:nyplotmulti) = multiplotx(1) endif anycoordplot = .false. do i=1,nyplotmulti print*,'-------------- Plot number ',i,' --------------' if (.not.isamey) then call prompt(' y axis ',multiploty(i),1,numplot) endif if (multiploty(i).le.ndataplots .and. .not.isamex) then call prompt(' x axis ',multiplotx(i),1,ndataplots) else if (multiploty(i).eq.isurfdens) then print "(a)",' setting x axis to r for surface density plot' multiplotx(i) = 1 elseif (multiploty(i).eq.itoomre) then print "(a)",' setting x axis to r for Toomre Q plot' multiplotx(i) = 1 elseif (multiploty(i).eq.ipdf) then call prompt(' enter x axis for PDF calculation ',multiplotx(i),1,ndataplots) elseif (multiploty(i).eq.icolpixmap) then call prompt(' enter corresponding SPH column for particle data ',irendermulti(i),0,ndataplots) multiplotx(i) = 1 elseif(.not.isamex) then multiplotx(i) = multiploty(i) endif endif ! !--work out whether rendering is allowed ! iAllowRendering = allowrendering(multiplotx(i),multiploty(i)) icoordplot = (is_coord(multiplotx(i),ndim) .and. is_coord(multiploty(i),ndim)) if (icoordplot) anycoordplot = icoordplot if (icoordplot) then if (iAllowRendering) then call prompt('(render) (0=none)',irendermulti(i),0,numplot-nextra) if (irendermulti(i).gt.0 .and. iplotcont_nomulti .and. icolours.ne.0) then if (double_rendering) then rprompt = '2nd render' else rprompt = 'contours' endif call prompt('('//trim(rprompt)//') (0=none)',icontourmulti(i),0,numplot-nextra) if (icontourmulti(i).eq.irendermulti(i)) then if (iadapt) then print "(a)",' limits for '//trim(rprompt)//' are adaptive ' else if (.not.lim2set(icontourmulti(i))) lim2(icontourmulti(i),:) = lim(icontourmulti(i),:) call prompt(' enter min for '//trim(rprompt)//':',lim2(icontourmulti(i),1)) call prompt(' enter max for '//trim(rprompt)//':',lim2(icontourmulti(i),2)) if (all(abs(lim2(icontourmulti(i),:)-lim(icontourmulti(i),:)) < tiny(lim))) then call reset_lim2(icontourmulti(i)) endif endif endif else icontourmulti(i) = 0 endif !iplotcontmulti(i) = iplotcont_nomulti endif if (any(iamvec(1:numplot).gt.0)) then ivecplottemp = -1 ierr = 1 do while(ierr.ne.0 .and. ivecplottemp.ne.0) ivecplottemp = ivecplotmulti(i) ierr = 0 call prompt('(vector plot) ('//trim(vecprompt)//')',ivecplottemp,0,maxval(iamvec)) if (.not.any(iamvec(1:numplot).eq.ivecplottemp)) then print "(a)",'Error, value not in list' ierr = 1 endif enddo ivecplotmulti(i) = ivecplottemp else ivecplotmulti(i) = 0 endif if (ivecplotmulti(i).gt.0 .and. irendermulti(i).eq.0) then call prompt('plot particles?',iplotpartvec) endif else ! !--set irender, icontour and ivecplot to zero if no rendering allowed ! if (multiploty(i).ne.icolpixmap) irendermulti(i) = 0 icontourmulti(i) = 0 ivecplotmulti(i) = 0 endif if (icoordplot .and. ndim.ge.2) then call prompt(' is this a cross section (no=projection)? ',x_secmulti(i)) if (x_secmulti(i)) then call prompt('enter co-ordinate location of cross section slice',xsecposmulti(i)) endif endif ! !--prompt for selection of different particle types ! if more than one SPH particle type is present ! itypelist = 0 if (ntypes.ge.2) then call prompt('use all active particle types?',iusealltypesmulti(i)) if (iusealltypesmulti(i)) then nvalues = 0 itypelist(:) = 0 else ! !--prepare list of types based on current iplotpartoftypemulti ! nvalues = 0 do itype=1,ntypes if (iplotpartoftypemulti(itype,i)) then nvalues = nvalues + 1 itypelist(nvalues) = itype endif enddo if (nvalues.eq.0) then print*,'warning: internal error in type list' itypelist(:) = 0 nvalues = 1 endif ! !--prompt for list of types to use ! do itype=1,ntypes print "(i2,':',1x,a)",itype,'use '//trim(labeltype(itype))//' particles' enddo call prompt('Enter type or list of types to use',itypelist,nvalues,1,ntypes) ! !--set which particle types to plot ! iplotpartoftypemulti(:,i) = .false. iplotpartoftypemulti(itypelist(1:nvalues),i) = .true. endif else ! !--if ntypes < 2 always use the (only) particle type ! iusealltypesmulti(i) = .true. endif enddo if (isamex .and. .not.anycoordplot) then imultisamepanel = .false. !call prompt('plot all plots in same panel? (default is different panels)',imultisamepanel) else imultisamepanel = .false. endif if (nyplotmulti.eq.1 .or. imultisamepanel) then nacross = 1 ndown = 1 print*,'setting nacross,ndown = ',nacross,ndown elseif (mod(nacross*ndown,nyplotmulti).ne.0) then !--guess nacross,ndown based on largest factor ifac = nyplotmulti/2 do while (mod(nyplotmulti,ifac).ne.0 .and. ifac.gt.1) ifac = ifac - 1 end do if (ifac.le.1) then nacross = nyplotmulti/2 else nacross = ifac endif if (nacross.le.0) nacross = 1 ndown = nyplotmulti/nacross print*,'setting nacross,ndown = ',nacross,ndown else print*,'nacross = ',nacross,' ndown = ',ndown endif return end subroutine options_multiplot end subroutine menu !---------------------------------------------- ! utility function which determines whether ! or not rendering is allowed or not !---------------------------------------------- logical function allowrendering(iplotx,iploty,xsec) use labels, only:ih,irho !,ipmass use multiplot, only:itrans use settings_data, only:ndataplots,icoords,icoordsnew use settings_render, only:icolour_particles implicit none integer, intent(in) :: iplotx,iploty logical, intent(in), optional :: xsec integer :: itransx,itransy logical :: is_xsec if (present(xsec)) then is_xsec = xsec else is_xsec = .true. endif itransx = 0 itransy = 0 if (iplotx.gt.0) itransx = itrans(iplotx) if (iploty.gt.0) itransy = itrans(iploty) ! !--work out whether rendering is allowed based on presence of rho, h & m in data read ! also must be in base coordinate system and no transformations applied ! if ((ih.gt.0 .and. ih.le.ndataplots) & .and.(irho.gt.0 .and. irho.le.ndataplots) & .and.(icoords.eq.icoordsnew .or. .not.is_xsec) & .and.(itransx.eq.0 .and. itransy.eq.0)) then allowrendering = .true. else allowrendering = .false. if (icolour_particles) allowrendering = .true. endif end function allowrendering !---------------------------------------------- ! utility function which sets up the "extra" ! plot columns and returns the total number ! of allowed columns for plotting !---------------------------------------------- subroutine set_extracols(ncolumns,ncalc,nextra,numplot,ndataplots) use params, only:maxplot use labels, only:ipowerspec,iacplane,isurfdens,itoomre,iutherm,ipdf,label,icolpixmap use settings_data, only:ndim,icoordsnew,ivegotdata,debugmode use settings_part, only:iexact use system_utils, only:lenvironment use write_pixmap, only:ireadpixmap implicit none integer, intent(in) :: ncolumns integer, intent(inout) :: ncalc integer, intent(out) :: nextra,numplot,ndataplots ! !-add extra columns (but not if nothing read from file) ! if (ncolumns.gt.0) then nextra = 0 ipowerspec = 0 iacplane = 0 isurfdens = 0 itoomre = 0 if (ndim.eq.3 .and. icoordsnew.eq.2 .or. icoordsnew.eq.3) then nextra = nextra + 1 isurfdens = ncolumns + ncalc + nextra label(isurfdens) = 'Surface density' if (iutherm.gt.0 .and. iutherm.le.ncolumns) then nextra = nextra + 1 itoomre = ncolumns + ncalc + nextra label(itoomre) = 'Toomre Q parameter' endif endif if (ndim.eq.3 .and. lenvironment('SPLASH_TURB')) then !--Probability Density Function nextra = nextra + 1 ipdf = ncolumns + ncalc + nextra label(ipdf) = 'PDF' endif if (ndim.le.1 .and. lenvironment('SPLASH_TURB')) then !! .or. ndim.eq.3) then ! if 1D or no coord data (then prompts for which x) nextra = nextra + 1 ! one extra plot = power spectrum ipowerspec = ncolumns + ncalc + nextra label(ipowerspec) = '1D power spectrum' else ipowerspec = 0 endif if (iexact.eq.6) then ! toy star plot a-c plane nextra = nextra + 1 iacplane = ncolumns + ncalc + nextra label(iacplane) = 'a-c plane' else iacplane = 0 endif !nextra = nextra + 1 !label(ncolumns+ncalc+nextra) = 'gwaves' if (ndim.ge.2) then if (ireadpixmap) then nextra = nextra + 1 icolpixmap = ncolumns + ncalc + nextra label(icolpixmap) = '2D pixel map' endif endif endif ! !--now that we know nextra, set the total number of allowed plots (numplot). ! if (ivegotdata) then numplot = ncolumns + ncalc + nextra if (numplot.gt.maxplot) then print "(a,i3,a)",' ERROR: total number of columns = ',numplot,' is greater ' print "(a,i3,a)",' than the current allowed maximum (',maxplot,').' print "(a)",' This is set by the parameter "maxplot" in the params module' print "(a)",' in the file globaldata.f90 -- edit this and recompile splash' print "(a)",' (or email me if this happens to increase the default limit)' stop endif ndataplots = ncolumns + ncalc else numplot = 0 ndataplots = 0 ncalc = 0 endif if (debugmode) print*,'DEBUG: numplot = ',numplot, ' ncalc = ',ncalc,' ndataplots = ',ndataplots return end subroutine set_extracols !---------------------------------------- ! instant multiplot setup from main menu !---------------------------------------- subroutine set_instant_multiplot(string,ipicky,ipickx,numplot,nmulti,multiplotx,multiploty,nx,ny) use params, only:maxplot use prompting, only:prompt character(len=*), intent(in) :: string integer, intent(in) :: numplot integer, intent(inout) :: ipicky,ipickx integer, intent(inout) :: nmulti,nx,ny integer, intent(inout) :: multiplotx(:),multiploty(:) integer :: ipickarr(maxplot),ierr,i ipickarr = 0 read(string,*,iostat=ierr) ipickarr i = 1 do while (i < size(ipickarr) .and. ipickarr(i) /= 0 .and. ipickarr(i) <= numplot) i = i + 1 enddo if (i > 2) then nmulti = i-1 !--make sure nmulti matches the number of panels on the page if (nmulti /= nx*ny) then nx = 1 ny = nmulti endif multiploty(1:nmulti) = ipickarr(1:nmulti) ipicky = numplot + 1 if (ipickx==0) ipickx = 1 ! do not allow zero as default call prompt(' (x axis) ',ipickx) multiplotx(1:nmulti) = ipickx endif end subroutine set_instant_multiplot !-------------------- ! print menu header !-------------------- subroutine print_header integer :: v(8),i integer, parameter :: m(48) = (/32,68,111,110,39,116,32,102,111,114,103,101,116,32,116,111,& 32,115,101,110,100,32,68,97,110,105,101,108,32,97,32,98,& 105,114,116,104,100,97,121,32,109,101,115,115,97,103,101,33/) integer, parameter :: c(49) = (/32,120,111,120,111,120,111,120,111,32,77,101,114,114,121,32,& 67,104,114,105,115,116,109,97,115,32,102,114,111,109,32,115,& 112,108,97,115,104,33,32,120,111,120,111,120,111,120,111,120,111/) integer, parameter :: d(49) = (/32,79,111,79,111,79,111,79,32,83,80,76,65,83,72,32,119, & 105,115,104,101,115,32,121,111,117,32,97,32,118,101,114,121,32,104,& 97,112,112,121,32,33,32,79,111,79,111,79,111,79/) call date_and_time(values=v) if (v(2)==m(1)/4 .and. v(3)==v(2)-2) then print "(/,48(a))",(achar(m(i)),i=1,48) elseif (v(2)==(m(1)-20) .and. v(3)>20) then print "(/,49(a))",(achar(c(i)),i=1,49) elseif (v(2)==nint(0.6) .and. v(3)==d(2)/79) then print "(/,40(a),i4,9(a))",(achar(d(i)),i=1,40),v(1),(achar(d(i)),i=41,49) else print "(/a)",' You may choose from a delectable sample of plots' endif end subroutine print_header end module mainmenu splash/src/options_data.f90000644 000770 000000 00000021331 12160267416 016550 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing settings and options related to the data read ! includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module options_data implicit none public :: submenu_data,defaults_set_data private contains !--------------------------------------------- ! set default values for these options ! (most should be set upon call to read_data) !--------------------------------------------- subroutine defaults_set_data use settings_data use params, only:maxplot implicit none integer :: i numplot=maxplot ! reset if read from file ncalc = 0 ! number of columns to calculate(e.g. radius) nextra = 0 ! extra plots aside from particle data ncolumns=maxplot-ncalc ! number of columns in data file ndataplots = ncolumns ndim = 0 ! number of coordinate dimensions ndimV = ndim ! default velocity same dim as coords istartatstep = 1 ! timestep to start from iendatstep = 1000 ! timestep to finish on nfreq = 1 ! frequency of timesteps to read icoords = 1 ! coordinate system of simulation iformat = 0 ! file format buffer_data = .false. iUseStepList = .false. do i=1,size(isteplist) isteplist(i) = i enddo iCalcQuantities = .false. DataIsBuffered = .false. iRescale = .false. ivegotdata = .false. ntypes = 1 xorigin = 0. itracktype = 0 ! particle tracking limits (none) itrackoffset = 0 ipartialread = .false. ! strictly unnecessary as set in get_data iverbose = 1 return end subroutine defaults_set_data !---------------------------------------------------------------------- ! sets options relating to current data ! (read new data or change timesteps plotted) !---------------------------------------------------------------------- subroutine submenu_data(ichoose) use filenames, only:nsteps,nstepsinfile,ifileopen,unitsfile use prompting, only:prompt,print_logical use getdata, only:get_data,get_labels use settings_data, only:istartatstep,iendatstep,nfreq,iUseStepList, & isteplist,buffer_data,iCalcQuantities,iRescale, & DataIsBuffered,numplot,ncalc,ncolumns use calcquantities, only:calc_quantities,setup_calculated_quantities use limits, only:set_limits use labels, only:label,unitslabel,labelzintegration use settings_units, only:units,set_units,write_unitsfile,unitzintegration implicit none integer, intent(in) :: ichoose integer :: ians, i character(len=30) :: fmtstring logical :: ireadnow,UnitsHaveChanged,iRescaleprev,iwriteunitsfile ians = ichoose print "(a)",'----------------- data read options -------------------' if (ians.le.0 .or. ians.gt.8) then if (iUseStepList) then print 10, iendatstep,print_logical(iUseStepList),print_logical(buffer_data), & print_logical(iCalcQuantities),print_logical(iRescale) else print 10, (iendatstep-istartatstep+1)/nfreq,print_logical(iUseStepList), & print_logical(buffer_data),print_logical(iCalcQuantities), & print_logical(iRescale) endif 10 format( & ' 0) exit ',/, & ' 1) read new data /re-read data',/, & ' 2) change number of timesteps used ( ',i5, ' )',/, & ' 3) plot selected steps only ( ',a,' )',/, & ' 4) buffering of data on/off ( ',a,' )',/, & ' 5) turn calculate extra quantities on/off ( ',a,' )',/, & ' 6) edit list of calculated quantities ',/, & ' 7) use physical units ( ',a,' )',/,& ' 8) change physical unit settings ') call prompt('enter option',ians,0,8) endif ! !--options ! select case(ians) !------------------------------------------------------------------------ case(1) if (buffer_data) then call get_data(-1,.false.) else call get_data(1,.false.,firsttime=.true.) endif !------------------------------------------------------------------------ case(2) iUseStepList = .false. call prompt('Start at timestep ',istartatstep,1,nsteps) call prompt('End at timestep ',iendatstep,istartatstep,nsteps) call prompt(' Frequency of steps to read',nfreq,1,nsteps) print *,' Steps = ',(iendatstep-istartatstep+1)/nfreq !------------------------------------------------------------------------ case(3) iUseStepList = .true. istartatstep = 1 nfreq = 1 iendatstep = min(iendatstep,size(isteplist),nsteps) call prompt('Enter number of steps to plot ', & iendatstep,1,size(isteplist)) do i=1,iendatstep if (isteplist(i).le.0 .or. isteplist(i).gt.nsteps) isteplist(i) = i write(fmtstring,"(a,i2)") 'Enter step ',i call prompt(fmtstring,isteplist(i),1,nsteps) enddo !------------------------------------------------------------------------ case(4) buffer_data = .not.buffer_data print "(/a)",' Buffering of data = '//print_logical(buffer_data) if (buffer_data) then call prompt('Do you want to read all files into memory now?',ireadnow) if (ireadnow) then call get_data(-1,.true.) endif endif !------------------------------------------------------------------------ case(5,6) if (ians.eq.5) iCalcQuantities = .not.iCalcQuantities if (iCalcQuantities .or. ians.eq.6) then call setup_calculated_quantities(ncalc) if (ians.eq.6 .and. .not.iCalcQuantities) then if (ncalc.gt.0) iCalcQuantities = .true. endif if (iCalcQuantities) then if (DataIsBuffered) then call calc_quantities(1,nsteps) call set_limits(1,nsteps,ncolumns+1,ncolumns+ncalc) else if (ifileopen.gt.0) then call calc_quantities(1,nstepsinfile(ifileopen)) call set_limits(1,nstepsinfile(ifileopen),ncolumns+1,ncolumns+ncalc) endif endif endif else print "(/a)",' Calculation of extra quantities is '//print_logical(iCalcQuantities) endif !------------------------------------------------------------------------ case(7) print "(a)",'current settings for conversion to physical units are:' call get_labels ! reset labels for printing do i=1,ncolumns print "(a,a3,a,a3,es10.3)",trim(label(i))//trim(unitslabel(i)),' = ',trim(label(i)),' x ',units(i) enddo print "(a,a3,a,a3,es9.2)",'time'//trim(unitslabel(0)),' = ','time',' x ',units(0) print "(a,a3,a,a3,es9.2)",'dz '//trim(labelzintegration),' = ','dz',' x ',unitzintegration iRescaleprev = iRescale iRescale = .not.iRescale call prompt('Use physical units?',iRescale) if ((iRescale .and..not. iRescaleprev) .or. (iRescaleprev .and..not.iRescale)) then if (buffer_data) then call get_data(-1,.true.) else call get_data(1,.true.,firsttime=.true.) endif endif !------------------------------------------------------------------------ case(8) UnitsHaveChanged = .false. call set_units(ncolumns,numplot,UnitsHaveChanged) iwriteunitsfile = .true. call prompt(' save units to file? ',iwriteunitsfile) if (iwriteunitsfile) call write_unitsfile(trim(unitsfile),numplot) if (.not.iRescale .and. UnitsHaveChanged) call prompt('Apply physical units to data?',iRescale) ! !--re-read/rescale data if units have changed ! if (UnitsHaveChanged) then if (buffer_data) then call get_data(-1,.true.) else call get_data(1,.true.,firsttime=.true.) endif else call get_labels endif !------------------------------------------------------------------------ end select return end subroutine submenu_data end module options_data splash/src/options_limits.f90000644 000770 000000 00000027125 12114012535 017134 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing settings and options related to the plot limits ! includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module settings_limits implicit none logical :: iadapt, iadaptcoords, adjustlimitstodevice real :: scalemax real, dimension(3) :: xminoffset_track, xmaxoffset_track contains !--------------------------------------------- ! set default values for these options !--------------------------------------------- subroutine defaults_set_limits use multiplot, only:itrans implicit none iadapt = .true. ! adaptive plot limits iadaptcoords = .false. adjustlimitstodevice = .false. scalemax = 1.0 ! for rescaling adaptive limits itrans(:) = 0 ! no transformations (log10 etc) xminoffset_track = 0.5 ! offset of limits from tracked particle xmaxoffset_track = 0.5 ! return end subroutine defaults_set_limits !---------------------------------------------------------------------- ! submenu with options relating to plot limits !---------------------------------------------------------------------- subroutine submenu_limits(ichoose) use filenames, only:nsteps,nstepsinfile,ifileopen use settings_data, only:ndataplots,numplot,ndim,ivegotdata,iCalcQuantities, & DataIsBuffered,itracktype,itrackoffset,ntypes use calcquantities, only:calc_quantities !use settings_page, only:nstepsperpage use multiplot, only:itrans use prompting, only:prompt,print_logical use limits, only:lim,set_limits,range,rangeset,anyrangeset,print_rangeinfo use labels, only:label,ix,irad,is_coord,labeltype use transforms, only:ntrans,transform_label implicit none integer, intent(in) :: ichoose integer :: iaction,ipick,i,index,ierr integer :: itracktypeprev,itrackoffsetprev ! real :: diff, mid, zoom character(len=120) :: transprompt character(len=12) :: string,string2 character(len=20) :: pstring,pstring2 ! zoom = 1.0 iaction = ichoose if (iadapt) then string = 'ADAPT' else string = 'FIXED' endif if (iadaptcoords) then string2 = 'ADAPT' else string2 = 'FIXED' endif write(pstring,"(i12)") itrackoffset pstring = adjustl(pstring) if (itracktype.gt.0) then write(pstring2,"(i12)") itracktype pstring=trim(adjustl(pstring2))//':'//trim(pstring) else pstring=trim(pstring) endif print "(a)",'------------------ limits options ---------------------' 10 format( & ' 0) exit ',/, & ' 1) use adaptive/fixed limits ( ',a,', ',a,' ) ',/, & ' 2) set limits manually ',/, & ' 3) xy limits/radius relative to particle ( ',a,' )',/, & ' 4) auto-adjust limits to match device aspect ratio ( ',a,' )',/, & ' 5) apply log/other transformations to columns ',/, & ' 6) reset limits for all columns ',/, & ' 7) use subset of data restricted by parameter range ( ',a,')') if (iaction.le.0 .or. iaction.gt.7) then print 10,trim(string),trim(string2),trim(pstring),& print_logical(adjustlimitstodevice),print_logical(anyrangeset()) call prompt('enter option ',iaction,0,7) endif ! !--limits ! select case(iaction) !------------------------------------------------------------------------ case(1) !+ With limits set to adaptive, plot limits are minimum !+ and maximum of quantities at current timestep. !+ However, the co-ordinate limits are not adapted !+ in the case of rendered plots. With fixed limits, the !+ plot limits retain their default values for all timesteps. call prompt('Use adaptive plot limits?',iadapt) call prompt('Use adaptive plot limits on coordinate axes?',iadaptcoords) call prompt('Adjust limits to aspect ratio of device?',adjustlimitstodevice) print "(a)",'adaptive plot limits = '//print_logical(iadapt)// & ' on coords = '//print_logical(iadaptcoords) !if (nstepsperpage.gt.1 .and. (iadapt .or. iadaptcoords)) then ! print*,'WARNING: adaptive limits and multiple steps per page don''t mix' !endif !------------------------------------------------------------------------ case(2) !+ Manually sets the plot limits for each column of data ipick = 1 do while (ipick.gt.0) ipick = 0 !write(*,*) call prompt('Enter column number to set limits (0=quit)',ipick,0,numplot) if (ipick.gt.0) then call prompt(trim(label(ipick))//' min ',lim(ipick,1)) call prompt(trim(label(ipick))//' max ',lim(ipick,2)) print*,'>> '//trim(label(ipick))//' limits set (min,max) = ',lim(ipick,1),lim(ipick,2) if (is_coord(ipick,ndim)) then iadaptcoords = .false. elseif (ipick.le.numplot) then iadapt = .false. endif endif enddo return !------------------------------------------------------------------------ case(3) !+ Co-ordinate limits are centred on the selected !+ particle for all timesteps, with offsets as input by the user. !+ This effectively gives the `Lagrangian' perspective. itrackoffsetprev = itrackoffset itracktypeprev = itracktype print "(a,/,a,/)",'To track particle 4923, enter 4923', & 'To track the 43rd particle of type 3, enter 3:43' call prompt('Enter particle to track: ',pstring,noblank=.true.) call get_itrackpart(pstring,itracktype,itrackoffset,ierr) do while (ierr.ne.0 .or. itracktype.lt.0 .or. itracktype.gt.ntypes .or. itrackoffset.lt.0) if (itracktype.lt.0 .or. itracktype.gt.ntypes) print "(a)",'invalid particle type' if (itrackoffset.lt.0) print "(a)",'invalid particle index' if (ierr.ne.0) print "(a)",'syntax error in string' pstring = '0' call prompt('Enter particle to track: ',pstring,noblank=.true.) call get_itrackpart(pstring,itracktype,itrackoffset,ierr) enddo if (itracktype.gt.0) then write(string,"(i12)") itrackoffset string = adjustl(string) print "(a)",'=> tracking '//trim(labeltype(itracktype))//' particle #'//trim(string) elseif (itrackoffset.gt.0) then write(string,"(i12)") itrackoffset string = adjustl(string) print "(a)",'=> tracking particle '//trim(string) else print "(a)",'=> particle tracking limits OFF' endif if (itrackoffset.gt.0) then do i=1,ndim call prompt('Enter offset for '//trim(label(ix(i)))//'min:', & xminoffset_track(i)) call prompt('Enter offset for '//trim(label(ix(i)))//'max :', & xmaxoffset_track(i)) enddo if ((itrackoffset.ne.itrackoffsetprev .or. itracktype.ne.itracktypeprev) & .and. iCalcQuantities .and. irad.gt.0 .and. irad.le.numplot) then !--radius calculation is relative to tracked particle print "(a)",' recalculating radius relative to tracked particle ' if (DataIsBuffered) then call calc_quantities(1,nsteps) else call calc_quantities(1,nstepsinfile(ifileopen)) endif endif endif !------------------------------------------------------------------------ case(4) !+ Adjust plot limits to match device aspect ratio call prompt('Adjust limits to aspect ratio of device?',adjustlimitstodevice) !!+ Zooms in/out (alternatively do this in interactive mode) ! ! if (.not.iadapt) then ! call prompt('Enter zoom factor for fixed limits',zoom,0.0) ! do i=1,numplot ! diff = lim(i,2)- lim(i,1) ! mid = 0.5*(lim(i,1) + lim(i,2)) ! lim(i,1) = mid - 0.5*zoom*diff ! lim(i,2) = mid + 0.5*zoom*diff ! enddo ! else ! call prompt('Enter scale factor (adaptive limits)',scalemax,0.0) ! endif !------------------------------------------------------------------------ case(5) !+ Applies log, inverse and other transformations to data columns index = 1 do i=1,ntrans write(transprompt(index:),"(1x,i1,'=',a,',')") i,trim(transform_label('x',i)) index = len_trim(transprompt) + 1 enddo ipick = 1 do while (ipick.gt.0 .and. ipick.le.numplot) ipick = 0 call prompt('Enter column to apply transform (0=quit,-1=all) ',ipick) if (ipick.le.numplot .and. ipick.ne.0) then print "(a)", trim(transprompt) if (ipick.lt.0) then ipick = 0 call prompt('Which transform (or multiple e.g. 321)?',ipick,0) itrans(:) = ipick ipick = -99 else call prompt('Which transform (or multiple e.g. 321)?',itrans(ipick),0) endif endif enddo return !------------------------------------------------------------------------ case(6) !+ Resets plot limits using all data currently in memory !+ Note that these limits will only apply when fixed limits are used if (ivegotdata) then if (DataIsBuffered) then call set_limits(1,nsteps,1,ndataplots) else call set_limits(1,nstepsinfile(ifileopen),1,ndataplots) endif else print*,'no data with which to set limits!!' endif !------------------------------------------------------------------------ case(7) !+ Plot subset of data by restricting parameter range ipick = 1 do while (ipick.gt.0) ipick = 0 call print_rangeinfo() call prompt('Enter column to use to restrict data set (-1=none/unset all,0=quit)',ipick,-1,ndataplots) if (ipick.gt.0) then print*,'current plot limits for '//trim(label(ipick))//': (min,max) = ',lim(ipick,1),lim(ipick,2) call prompt(trim(label(ipick))//' min value ',range(ipick,1)) call prompt(trim(label(ipick))//' max value ',range(ipick,2),range(ipick,1)) if (.not.rangeset(ipick)) then print*,'>> min=max: no restriction set' endif elseif (ipick.eq.-1) then print "(a)",'>> removing all range restrictions on data set' range(:,:) = 0. endif write(*,*) enddo return end select return end subroutine submenu_limits subroutine get_itrackpart(string,itracktype,itrackpart,ierr) implicit none character(len=*), intent(in) :: string integer, intent(out) :: itracktype,itrackpart,ierr integer :: ic ic = index(string,':') if (ic.gt.0) then read(string(1:ic-1),*,iostat=ierr) itracktype read(string(ic+1:),*,iostat=ierr) itrackpart if (itrackpart.eq.0) itracktype = 0 else itracktype = 0 read(string,*,iostat=ierr) itrackpart endif end subroutine get_itrackpart end module settings_limits splash/src/options_page.f90000644 000770 000000 00000057060 12551734365 016571 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing page settings and options ! includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module settings_page use settings_limits, only:iadapt,iadaptcoords,adjustlimitstodevice,xminoffset_track,xmaxoffset_track use labels, only:lenlabel implicit none integer :: iaxis,nacross,ndown,ipapersize,nstepsperpage,linewidth,iscalepanel integer :: iPlotLegendOnlyOnPanel,modlinestyle,modcolour,maxlinestyle,maxcolour integer :: iPageColours,ipapersizeunits logical :: iColourEachStep,iChangeStyles,tile,interactive,nomenu logical :: iPlotLegend,iPlotStepLegend,iPlotTitles,usecolumnorder logical :: iPlotScale,iUseBackgroundColourForAxes,usesquarexy real :: papersizex,aspectratio real :: hposlegend,vposlegend,fjustlegend,hpostitle,vpostitle,fjusttitle real :: charheight,alphalegend real :: dxscale,hposscale,vposscale,yscalealt character(len=lenlabel) :: legendtext, scaletext character(len=60) :: device character(len=lenlabel) :: labelyalt namelist /pageopts/ iaxis,nacross,ndown,interactive,iadapt,iadaptcoords, & nstepsperpage,iColourEachStep,iChangeStyles,tile,ipapersize,papersizex,aspectratio, & iPlotLegend,iPlotStepLegend,hposlegend,vposlegend,iPlotTitles,hpostitle, & vpostitle,fjusttitle,legendtext,iPageColours,charheight,linewidth,& fjustlegend,iPlotLegendOnlyOnPanel, & iPlotScale,dxscale,scaletext,hposscale,vposscale,iscalepanel,iUseBackgroundColourForAxes, & usesquarexy,maxlinestyle,modlinestyle,maxcolour,modcolour,usecolumnorder,ipapersizeunits,& adjustlimitstodevice,alphalegend,yscalealt,labelyalt,xminoffset_track,xmaxoffset_track contains !--------------------------------------------- ! set default values for these options !--------------------------------------------- subroutine defaults_set_page use shapes, only:defaults_set_shapes use plotlib, only:plotlib_maxlinecolour implicit none interactive = .true. ! default for interactive mode iaxis = 0 ! turns axes off/on nstepsperpage = 1 iColourEachStep = .true. ! change colours if nstepsperpage > 1 iChangeStyles = .false. ! change marker/ line styles if nstepsperpage > 1 tile = .true. usecolumnorder = .true. nacross = 1 ! number of plots across page ndown = 1 ! number of plots down page ipapersize = 0 ! paper size option papersizex = 0.0 ! size of x paper (no call to PGPAP if zero) aspectratio = 0.0 ! aspect ratio of paper (no call to PGPAP if zero) ipapersizeunits = 1 ! units in which the paper size is set iPlotLegend = .true. ! whether or not to plot legend iPlotStepLegend = .false. ! timestep legend hposlegend = 0.95 ! horizontal legend position as fraction of viewport vposlegend = 2.0 ! vertical legend position in character heights fjustlegend = 1.0 ! justification factor for legend alphalegend = 0.5 ! transparency of overlaid annotation legendtext = 't=' iPlotLegendOnlyOnPanel = 0 iPlotTitles = .false. ! whether or not to plot titles hpostitle = 0.5 ! horizontal title position as fraction of viewport vpostitle = 1.0 ! vertical title position in character heights fjusttitle = 0.5 ! justification factor for title iPageColours = 0 charheight = 1.0 ! character height linewidth = 0 ! line width iPlotScale = .false. hposscale = 0.5 vposscale = 1.0 dxscale = 1.0 scaletext = '1 unit' iscalepanel = 0 maxlinestyle = 5 modlinestyle = 1 modcolour = 1 maxcolour = plotlib_maxlinecolour yscalealt = 1. labelyalt = ' ' usesquarexy = .true. ! spatial dimensions have same scale call defaults_set_shapes return end subroutine defaults_set_page !--------------------------------------------- ! changed default values for evsplash !--------------------------------------------- subroutine defaults_set_page_ev implicit none nstepsperpage = 1000 iColourEachStep = .true. ! change colours if nstepsperpage > 1 iChangeStyles = .true. ! change marker/ line styles if nstepsperpage > 1 iPlotLegend = .true. ! whether or not to plot legend iPlotStepLegend = .true. ! timestep legend hposlegend = 0.1 ! horizontal legend position as fraction of viewport vposlegend = 2.0 ! vertical legend position in character heights fjustlegend = 0.0 ! justification factor for legend return end subroutine defaults_set_page_ev !---------------------------------------------------------------------- ! submenu with options relating to page setup !---------------------------------------------------------------------- subroutine submenu_page(ichoose) use params, only:maxplot use prompting, only:prompt,print_logical use pagecolours, only:pagecolourscheme,colour_fore,colour_back,maxpagecolours use plotlib, only:plotlib_supports_alpha,plotlib_maxlinecolour,plotlib_maxlinestyle,plotlib_is_pgplot implicit none integer, intent(in) :: ichoose integer :: iaction,i,iunitsprev,ierr real :: papersizey character(len=15) :: paperfmtstr character(len=3) :: string iaction = ichoose papersizey = papersizex*aspectratio if (ipapersizeunits.gt.0) then write(paperfmtstr,"(f5.2,1x,f5.2)") papersizex,papersizey else write(paperfmtstr,"(i5,' x ',i4)") nint(papersizex),nint(papersizey) endif print "(a)",'---------------- page setup options -------------------' if (iaction.le.0 .or. iaction.gt.9) then print "( "// & "' 0) exit ',/, "// & "' 1) plot n steps on top of each other (n =',i4,')',/, "// & "' 2) axes options (',i2,')',/, "// & "' 3) change paper size ("//trim(paperfmtstr)//" )',/, "// & "' 4) subdivide page into panels (',i2,1x,'x',1x,i2,', tiling is ',a,')',/, "// & "' 5) spatial dimensions have same scale ( ',a,' )',/,"// & "' 6) set character height (',f4.1,')',/,"// & "' 7) adjust line width (',i2, ')',/,"// & "' 8) interactive mode on/off ( ',a,' )',/,"// & "' 9) set foreground/background colours ( ',a,' )')", & nstepsperpage,iaxis,nacross,ndown,print_logical(tile), & trim(print_logical(usesquarexy)),charheight,linewidth,& trim(print_logical(interactive)), & trim(pagecolourscheme(iPageColours,short=.true.)) call prompt('enter option ',iaction,0,9) endif select case(iaction) !------------------------------------------------------------------------ case(1) call prompt('Enter number of timesteps per panel ',nstepsperpage,0) print*,'Plotting up to ',nstepsperpage,' timesteps per panel' if (nstepsperpage.gt.1) then if (iadapt .or. iadaptcoords) then print "(a)",'(note that adaptive plot limits are now off)' iadapt = .false. iadaptcoords = .false. endif if (nstepsperpage.gt.14) then print "(a)",'(warning: steps per panel > number of colours, ie. colours will repeat)' endif call prompt('Use different colours for each step?',iColourEachStep) if (iColourEachStep) then call prompt('How often to change colour? (1=every step, 2=every 2nd step etc.)',modcolour,1) call prompt('Enter max number of colours to use before repeating (16=plot lib max)',& maxcolour,1,plotlib_maxlinecolour) endif !! if (.not.iColourEachStep) icolourthisstep = 1 call prompt('Use different markers/line style for each step? ',iChangeStyles) if (iChangeStyles) then call prompt('How often to change line style (1=every step, 2=every 2nd step etc.)',modlinestyle,1) write(string,"(i3)",iostat=ierr) plotlib_maxlinestyle call prompt('Enter max number of line styles to cycle through before repeating ('// & trim(adjustl(string))//'=plot lib max)',maxlinestyle,1,plotlib_maxlinestyle) endif if (iColourEachStep .or. iChangeStyles) then print "(/,a,/,a)",' (to change the legend text, create a file called', & ' ''legend'' in the working directory, with one label per line)' call prompt('Plot legend of marker styles/colours?',iPlotStepLegend) endif endif return !------------------------------------------------------------------------ case(2) print*,'-4 : draw box and major tick marks only;' print*,'-3 : draw box and tick marks (major and minor) only;' print*,'-2 : draw no box, axes or labels;' print*,'-1 : draw box only;' print*,' 0 : draw box and label it with coordinates;' print*,' 1 : same as AXIS=0, but also draw the coordinate axes (X=0, Y=0);' print*,' 2 : same as AXIS=1, but also draw grid lines at major increments of the coordinates;' print*,' 3 : draw box, ticks and numbers but no axes labels;' print*,' 4 : same as AXIS=0, but with a second y-axis scaled and labelled differently' print*,'10 : draw box and label X-axis logarithmically;' print*,'20 : draw box and label Y-axis logarithmically;' print*,'30 : draw box and label both axes logarithmically.' call prompt('enter axis option ',iaxis,-4,30) if (iaxis.eq.4) then call prompt('enter scale factor for alternative y axis',yscalealt,0.) call prompt('enter label for alternative y axis',labelyalt) endif print *,' axis = ',iaxis return !------------------------------------------------------------------------ case(3) print*,' 0) plotting library default ' print*,' 1) small square : 2.92 x 2.92 inches' print*,' 2) medium square : 5.85 x 5.85 inches' print*,' 3) large square : 8.00 x 8.00 inches' print*,' 4) single small graph : 5.85 x 4.13 inches' print*,' 5) duo small graph : 11.70 x 4.13 inches' print*,' 6) duo graph : 11.70 x 6.00 inches' if (plotlib_is_pgplot) then print*,' 7) Custom size ' call prompt(' Enter option for paper size ',ipapersize,0,7) else print*,' 7) 800 x 600 pixels' print*,' 8) 640 x 360 pixels (360p)' print*,' 9) 1280 x 720 pixels (720p)' print*,'10) 1920 x 1080 pixels (1080p/Full HD)' print*,'11) 1024 x 768 pixels' print*,'12) 1440 x 900 pixels' print*,'13) 2560 x 1440 pixels' print*,'14) 2560 x 1600 pixels' print*,'15) 3840 x 2160 pixels (4KTV/Ultra HD)' print*,'16) 4096 x 2160 pixels (Cinema 4K)' print*,'17) 5120 x 2880 pixels (5K)' print*,'18) 27320 x 3072 pixels (CAVE-2)' print*,'19) Custom size ' call prompt(' Enter option for paper size ',ipapersize,0,19) endif select case(ipapersize) case(1) ipapersizeunits = 1 papersizex = 0.25*11.7 aspectratio = 1.0 case(2) ipapersizeunits = 1 papersizex = 0.5*11.7 aspectratio = 1.0 case(3) ipapersizeunits = 1 papersizex = 8.0 aspectratio = 1.0 case(4) ipapersizeunits = 1 papersizex = 0.5*11.7 aspectratio = 1./sqrt(2.) case(5) ipapersizeunits = 1 papersizex = 11.7 aspectratio = 0.5/sqrt(2.) case(6) ipapersizeunits = 1 papersizex = 11.7 papersizey = 6.0 aspectratio = papersizey/papersizex case(7) if (plotlib_is_pgplot) then ipapersizeunits = 1 call prompt(' x size (inches) ',papersizex,0.0) call prompt(' y size (inches) or aspect ratio (-ve)',papersizey) if (papersizey.lt.0.0) then aspectratio = abs(papersizey) else aspectratio = papersizey/papersizex endif else ipapersizeunits = 0 papersizex = 800. papersizey = 600. aspectratio = papersizey/papersizex endif case(8:18) if (plotlib_is_pgplot) then ipapersizeunits = 1 papersizex = 0. ! use PGPLOT default aspectratio = 0. else ipapersizeunits = 0 select case(ipapersize) case(8) papersizex = 640. papersizey = 360. case(9) papersizex = 1280. papersizey = 720. case(10) papersizex = 1920. papersizey = 1080. case(11) papersizex = 1024. papersizey = 768. case(12) papersizex = 1440. papersizey = 900. case(13) papersizex = 2560. papersizey = 1440. case(14) papersizex = 2560. papersizey = 1600. case(15) papersizex = 3840. papersizey = 2160. case(16) papersizex = 4096. papersizey = 2160. case(17) papersizex = 5120. papersizey = 2880. case(18) papersizex = 27320. papersizey = 3072. end select aspectratio = papersizey/papersizex endif case(19) if (plotlib_is_pgplot) then ipapersizeunits = 1 papersizex = 0. ! use PGPLOT default aspectratio = 0. else iunitsprev = ipapersizeunits print*,' 0) pixels ' print*,' 1) inches ' print*,' 2) cm ' call prompt(' choose units for paper size',ipapersizeunits,0,2) if (ipapersizeunits.ne.iunitsprev) then select case(ipapersizeunits) case(2) papersizex = 29.7 papersizey = 21.0 case(1) papersizex = 11.0 papersizey = 8.5 case(0) papersizex = 800. papersizey = -0.75 case default papersizex = 0. papersizey = 0. end select endif call prompt(' x size in above units ',papersizex,1.) call prompt(' y size or aspect ratio (-ve)',papersizey) if (papersizey.lt.0.0) then aspectratio = abs(papersizey) else aspectratio = papersizey/papersizex endif endif case default ipapersizeunits = 1 papersizex = 0.0 ! no call to PGPAP if they are zero aspectratio = 0.0 end select call prompt('Adjust plot limits to match device aspect ratio?',adjustlimitstodevice) return !------------------------------------------------------------------------ case(4) call prompt('Enter number of plots across (columns):',nacross,1,maxplot) call prompt('Enter number of plots down (rows):',ndown,1,maxplot/nacross) if (nacross*ndown.gt.1) then call prompt('Tile plots on the page where possible?',tile) call prompt('Plot panels across-then-down? (no=down-then-across)',usecolumnorder) endif return !------------------------------------------------------------------------ case(5) usesquarexy = .not.usesquarexy print "(a)",' Same scale for spatial dimensions is '//print_logical(usesquarexy) !------------------------------------------------------------------------ case(6) call prompt('Enter character height ',charheight,0.1,10.) return !------------------------------------------------------------------------ case(7) print "(3(/,a))",' Setting line width to 0 means automatic line width choice:', & ' This gives width = 2 for vector devices (/ps,/cps etc)', & ' and width = 1 elsewhere (e.g. for pixel devices)' print* call prompt('Enter line width (0=auto)',linewidth,0) return !------------------------------------------------------------------------ case(8) interactive = .not.interactive print "(a)",' Interactive mode is '//print_logical(interactive) !------------------------------------------------------------------------ case(9) print "(3(/,i1,')',1x,a))",(i,pagecolourscheme(i),i=0,maxpagecolours) call prompt(' Choose page colour scheme ',iPageColours,0,maxpagecolours) write(*,"(3(/,a))",advance='no') & ' Overlaid (that is, drawn inside the plot borders) axis ',& ' ticks, legend text and titles are by default plotted ', & ' in the foreground colour' if (iPageColours.gt.0) then print "(a,/)",' [i.e. '//trim(colour_fore(iPageColours))//'].' call prompt('Do you want to plot these in background colour [i.e. '& //trim(colour_back(iPageColours))//'] instead?',& iUseBackgroundColourForAxes) else print "(a,/)",'.' call prompt('Use background colour for these? ',iUseBackgroundColourForAxes) endif if (iUseBackgroundColourForAxes .and. plotlib_supports_alpha) then call prompt('Enter opacity for overlaid text and annotation ',alphalegend,0.0,1.0) endif return end select return end subroutine submenu_page !---------------------------------------------------------------------- ! submenu with options relating to legend and title settings !---------------------------------------------------------------------- subroutine submenu_legend(ichoose) use filenames, only:fileprefix use prompting, only:prompt,print_logical use shapes, only:nshapes,labelshapetype,shape,submenu_shapes use legends, only:prompt_panelselect implicit none integer, intent(in) :: ichoose integer :: iaction,i,ierr,i1,i2 character(len=50) :: string iaction = ichoose print "(a)",'---------------- legend and title options -------------------' if (iPlotStepLegend) then print "(/,a,/,a,/)",' Hint: to change the step legend text, create a file called', & ' '''//trim(fileprefix)//'.legend'' in the working directory, with one label per line' endif if (iPlotTitles) then if (.not.iPlotStepLegend) print "(a)" print "(a,/,a,/)",' To set the plot titles, create a file called', & ' '''//trim(fileprefix)//'.titles'' in the working directory, with one title per line' endif if (iaction.le.0 .or. iaction.gt.6) then !--format shape settings string if (nshapes.gt.0) then i2 = 2 string = ': ' else i2 = 0 string = ' ' endif do i=1,nshapes i1 = i2 + 1 i2 = min(i1 + len_trim(labelshapetype(shape(i)%itype)),len(string)) write(string(i1:i2),"(a)",iostat=ierr) trim(labelshapetype(shape(i)%itype)(1:i2-i1)) if (i.lt.nshapes .and. i2.lt.len(string)) then write(string(i2:i2+1),"(', ')",iostat=ierr) i2 = i2 + 1 endif enddo !--print menu print 20,print_logical(iPlotLegend),hposlegend,vposlegend,fjustlegend,trim(legendtext), & print_logical(iPlotTitles),hpostitle,vpostitle,fjusttitle, & print_logical(iPlotStepLegend), print_logical(iPlotScale),iPlotLegendOnlyOnPanel, & nshapes,trim(string) 20 format(' 0) exit ',/, & ' 1) time legend on/off/settings (',1x,a,1x,f5.2,1x,f5.2,1x,f5.2,1x,'"',a,'")',/, & ' 2) titles on/off/settings (',1x,a,1x,f5.2,1x,f5.2,1x,f5.2,')',/, & ' 3) legend for multiple steps per page on/off (',1x,a,1x,')',/, & ' 4) plot scale |---| on coordinate plots (',1x,a,1x,')',/, & ' 5) legend only on nth panel/first row/column (',1x,i2,1x,')',/, & ' 6) annotate plot (e.g. arrow,square,circle,text) (',1x,i2,a,')') iaction = 0 call prompt(' Enter option ',iaction,0,6) endif select case(iaction) case(1) call prompt('Plot time legend? ',iPlotLegend) print "(a)",'Time legend is '//print_logical(iPlotLegend) if (iPlotLegend) then print "(7(/,a),/)", & ' Example format strings: ', & ' t = : this is the default format "t = 0.1 years"', & ' t = %t.5 : with time to 5 significant figures', & ' Time: %t dog-%ut : gives "Time: 0.1 dog-years"', & ' %(t + 2013) : prints time offset by 2013', & ' %(t + 2013).5 : as above, to 5 sig. figs.', & ' %(t*100) : multiplied by 100' call prompt('Enter legend text ',legendtext) print "(a)",'------ set legend position (can also be done interactively) --------' call prompt('Enter horizontal position as fraction of viewport', & hposlegend,0.0,1.0) call prompt('Enter vertical position in character heights from top',vposlegend) call prompt('Enter justification factor (0.0=left 1.0=right)',fjustlegend,0.0,1.0) call prompt_panelselect('legend',iPlotLegendOnlyOnPanel) endif case(2) print "(/,a,/,a,/)",' To set the plot titles, create a file called', & ' '''//trim(fileprefix)//'.titles'' in the working directory, with one title per line' call prompt('Use plot titles? ',iPlotTitles) print "(a)",'Titles are '//print_logical(iPlotTitles) if (iPlotTitles) then print "(a)",'------ set title position (can also be done interactively) --------' call prompt('Enter horizontal position as fraction of viewport', & hpostitle,0.0,1.0) call prompt('Enter vertical position in character heights above top',vpostitle) call prompt('Enter justification factor (0.0=left 1.0=right)',fjusttitle,0.0,1.0) endif case(3) iPlotStepLegend = .not.iPlotStepLegend print "(a)",'Step legend is '//print_logical(iPlotStepLegend) if (iPlotStepLegend) then print "(/,a,/,a,/)",' Hint: to change the step legend text, create a file called', & ' '''//trim(fileprefix)//'.legend'' in the working directory, with one label per line' print*,' press return to continue ' read* endif case(4) call prompt('Plot scale on co-ordinate plots? ',iPlotScale) if (iPlotScale) then call prompt('Enter length of scale in the current x,y,z units ',dxscale) call prompt('Enter text to appear below scale (e.g. ''10 AU'')',scaletext) call prompt('Enter horizontal position as fraction of viewport', & hposscale,0.0,1.0) call prompt('Enter vertical position in character heights above bottom',vposscale) if (nacross*ndown.gt.1) then call prompt('Enter which panel on the plotting page the scale should appear on '// & '(0=all co-ordinate plots)',iscalepanel,0,nacross*ndown) endif endif case(5) call prompt_panelselect('legend',iPlotLegendOnlyOnPanel) case(6) call submenu_shapes() end select return end subroutine submenu_legend end module settings_page splash/src/options_particleplots.f90000644 000770 000000 00000035564 12516110272 020531 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing settings and options relating to particle plots ! includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module settings_part use params use settings_data, only:icoordsnew,iexact implicit none integer, dimension(maxparttypes) :: imarktype,idefaultcolourtype,itypeorder integer, dimension(100) :: icircpart integer, dimension(maxplot) :: ilocerrbars logical, dimension(maxparttypes) :: iplotpartoftype,PlotOnRenderings,UseTypeInContours integer :: ncircpart integer :: linestyle, linecolour,linestylethisstep,linecolourthisstep,ErrorBarType logical :: iplotline,ilabelpart,ifastparticleplot,iploterrbars real :: hfacmarkers namelist /plotopts/ iplotline,linestyle,linecolour, & imarktype,iplotpartoftype,PlotOnRenderings, & iexact,icoordsnew,ifastparticleplot,idefaultcolourtype,& itypeorder,UseTypeInContours,iploterrbars,ilocerrbars,hfacmarkers,& ErrorBarType contains !--------------------------------------------- ! set default values for these options !--------------------------------------------- subroutine defaults_set_part use settings_data, only:icoords implicit none integer :: i ncircpart = 0 iplotline = .false. ! plot line joining the particles linestyle = 1 ! line style for above linecolour = 1 linestylethisstep = 1 linecolourthisstep = 1 iexact = 0 ! exact solution to plot ilabelpart = .false. ! plot particle numbers icoordsnew = icoords icircpart(:) = 0 iplotpartoftype(1) = .true. ! whether or not to plot particles of certain types iplotpartoftype(2:maxparttypes) = .false. PlotOnRenderings = .false. imarktype = 1 ! marker type for all particles imarktype(2) = 4 ! marker type for ghost/dark matter particles imarktype(3) = 17 ! marker type for sink particles imarktype(5) = 3 ! marker type for star particles (gadget) idefaultcolourtype = -1 ! default colour for each particle type ifastparticleplot = .true. ! allow crowded-field elimination on particle plots do i=1,maxparttypes itypeorder(i) = i enddo UseTypeInContours(:) = iplotpartoftype(:) iploterrbars = .false. ! plot error bars for a particular column ilocerrbars(:) = 0 ! location of data for error bars in dat array hfacmarkers = 1.0 ErrorBarType = 0 return end subroutine defaults_set_part !--------------------------------------------- ! changed default values for these options !--------------------------------------------- subroutine defaults_set_part_ev implicit none iplotline = .true. ! plot line joining the particles iplotpartoftype(1:maxparttypes) = .false. ! whether or not to plot particles of certain types UseTypeInContours(:) = iplotpartoftype(:) return end subroutine defaults_set_part_ev !---------------------------------------------------------------------- ! submenu with options relating to particle plots !---------------------------------------------------------------------- subroutine submenu_particleplots(ichoose) use exact, only:options_exact,submenu_exact use labels, only:labeltype,ih,label use limits, only:lim use settings_data, only:icoords,ntypes,ndim,UseTypeInRenderings,ndataplots use settings_render, only:iplotcont_nomulti use particle_data, only:npartoftype,iamtype use prompting, only:prompt,print_logical use geometry, only:maxcoordsys,labelcoordsys,coord_transform_limits use multiplot, only:itrans use plotlib, only:plotlib_maxlinestyle,plotlib_maxlinecolour use calcquantities, only:calc_quantities use settings_data, only:DataIsBuffered,numplot use filenames, only:nsteps,nstepsinfile,ifileopen use geomutils, only:set_coordlabels implicit none integer, intent(in) :: ichoose integer :: i,iaction,n,itype,icoordsprev,ierr,icol character(len=2) :: charntypes character(len=20) :: substring1,substring2 character(len=1000) :: fmtstring character(len=120) :: contline iaction = ichoose !--we require some tricks with the format string to print only the actual number of ! particle types rather than the whole array ! if (ntypes.gt.100) print*,'WARNING: Internal error: ntypes too large for formatting in particle plot menu' if (ntypes.le.0) then substring1 = "no types specified" substring2 = "not applicable" elseif (ntypes.eq.1) then substring1 = "a" substring2 = "i2" else write(charntypes,"(i2)") ntypes-1 substring1 = charntypes//"(a,',',1x),a" substring2 = charntypes//"(i2,',',1x),i2" endif if (iplotcont_nomulti) then contline = "' use in contour plots: ( ',"//trim(substring1)//",' )',/," else contline = ' ' endif fmtstring="("// & "' 0) exit ',/,"// & "' 1) turn on/off particles by type ( ',"//trim(substring1)//",' )',/,"//trim(contline)// & "' 2) change graph markers for each type ( ',"//trim(substring2)//",' )',/,"// & "' 3) set colour for each particle type ( ',"//trim(substring2)//",' )',/,"// & "' 4) change plotting order of types ( ',"//trim(substring2)//",' )',/,"// & "' 5) plot line joining particles ( ',a,' ) ',/,"// & "' 6) plot error bars/smoothing circles ( ',a,' ) ',/,"// & "' 7) change coordinate systems ( ',i2,' ) ',/,"// & "' 8) plot exact solution ( ',i2,' ) ',/,"// & "' 9) exact solution plot options ')" print "(a)",'------------- particle plot options -------------------' if (iaction.le.0 .or. iaction.gt.9) then if (iplotcont_nomulti) then print fmtstring,(trim(print_logical(iplotpartoftype(i))),i=1,ntypes), & (trim(print_logical(UseTypeInContours(i),mask=UseTypeInRenderings(i))),i=1,ntypes), & imarktype(1:ntypes),idefaultcolourtype(1:ntypes),itypeorder(1:ntypes), & print_logical(iplotline),print_logical(ncircpart.gt.0 .or.iploterrbars),icoordsnew,iexact else print fmtstring,(trim(print_logical(iplotpartoftype(i))),i=1,ntypes), & imarktype(1:ntypes),idefaultcolourtype(1:ntypes),itypeorder(1:ntypes), & print_logical(iplotline),print_logical(ncircpart.gt.0 .or.iploterrbars),icoordsnew,iexact endif call prompt('enter option',iaction,0,9) endif ! select case(iaction) !------------------------------------------------------------------------ case(1) ! plot particles by type? do itype=1,ntypes if (UseTypeinRenderings(itype) .and. ndim.gt.1) then call prompt('Plot '//trim(labeltype(itype))//' particles / use in renderings?',iplotpartoftype(itype)) if (iplotcont_nomulti) then call prompt('Use '//trim(labeltype(itype))//' particles in contour plots?',UseTypeInContours(itype)) endif else call prompt('Plot '//trim(labeltype(itype))//' particles?',iplotpartoftype(itype)) UseTypeInContours(itype) = .false. endif if (iplotpartoftype(itype) .and. itype.gt.1) then if (.not.UseTypeInRenderings(itype)) then call prompt('>> Plot '//trim(labeltype(itype))//' particles on top of rendered plots?',PlotOnRenderings(itype)) else PlotonRenderings(itype) = .false. endif elseif (.not.iplotpartoftype(itype)) then PlotonRenderings(itype) = .false. endif enddo return !------------------------------------------------------------------------ case(2) print "(/,' Marker options (for all from -8->31, see plot library userguide):',11(/,i2,') ',a))", & 0,'square',1,'.',2,'+',3,'*',4,'o',5,'x',17,'bold circle',-8,'large bold circle', & 32,'solid circle, size proportional to h', & 33,'open circle, size proportional to h', & 34,'outlined solid circle, size prop. to h' !print*,'(0 Square) (1 .) (2 +) (3 *) (4 o) (5 x) (17 bold circle) (-8 bigger bold circle)' do itype=1,ntypes call prompt(' Enter marker to use for '//trim(labeltype(itype)) & //' particles:',imarktype(itype),-8,35) enddo if (any(imarktype(1:ntypes).ge.32)) then print* call prompt(' Enter proportionality factor for scalable markers (radius = fac*h)',hfacmarkers) endif return !------------------------------------------------------------------------ case(3) print "(2(a,/),/,4(a,/))", & ' Warning: setting a colour for a particle type overrides', & ' (at each new timestep) colours set interactively ', & ' -1 = retain interactively set colours between timesteps', & ' 0 = background ',& ' 1 = foreground ',& ' 2->10 = various colours (see default colour indices for plot library)' do itype=1,ntypes call prompt(' Enter default colour for '//trim(labeltype(itype)) & //' particles:',idefaultcolourtype(itype),-1,14) enddo return !------------------------------------------------------------------------ case(4) if (size(iamtype(:,1)).gt.1) then print "(3(/,a),/)", & ' WARNING: changing type plotting order currently has no effect ', & ' when particle types are mixed in the dump file', & ' (for sphNG read disable this using -lowmem on the command line)' endif print "(9(i1,'=',a,', '))",(i,trim(labeltype(i)),i=1,ntypes) call prompt('enter first particle type to plot',itypeorder(1),1,ntypes) do i=2,ntypes ierr = 1 do while (ierr /= 0) itype = itypeorder(i) call prompt('enter next particle type to plot',itype,1,ntypes) if (any(itypeorder(1:i-1).eq.itype)) then print "(a)",' error: cannot be same as previous type' ierr = 1 else itypeorder(i) = itype ierr = 0 endif enddo enddo print "(/,a,/,a,/)",' Fast particle plotting excludes particles in crowded regions', & ' Turn this option off to always plot every particle' call prompt('Allow fast particle plotting?',ifastparticleplot) return !------------------------------------------------------------------------ case(5) call prompt('plot line joining particles?',iplotline) if (iplotline) then call prompt('Enter line style to use ',linestyle,1,plotlib_maxlinestyle) call prompt('Enter colour for line ',linecolour,0,plotlib_maxlinecolour) endif return !------------------------------------------------------------------------ case(6) if (ndim.le.1 .or. ih.le.0) then icol = 0 do icol=1,ndataplots if (ilocerrbars(icol).gt.0) print "(a,i2,a,i2,a)", & 'column ',ilocerrbars(icol),' contains errors for column ',icol,':'//label(icol) enddo if (any(ilocerrbars(1:ndataplots).gt.0)) then call prompt('turn on plotting of error bars? ',iploterrbars) if (.not.iploterrbars) return else iploterrbars = .false. endif icol = 1 do while(icol.ne.0) icol = 0 call prompt('Enter column to set location of error bars for (0=none)',icol,0,ndataplots) if (icol.gt.0) then call prompt('Enter location of error data for this column in the data',ilocerrbars(icol),0) if (ilocerrbars(icol) <= 0 .or. ilocerrbars(icol) > ndataplots) then print "(a,i2)",' WARNING: currently no data in column ',ilocerrbars(icol) else iploterrbars = .true. endif if (all(ilocerrbars(1:ndataplots).le.0)) iploterrbars = .false. else if (all(ilocerrbars(1:ndataplots).le.0)) iploterrbars = .false. endif enddo print "(2(/,a))",' 0) Default style |--|',& ' 1) Semi-transparent shaded region' call prompt('Select error bar style',ErrorBarType,0,1) else print*,'Circles of interaction can also be set interactively' call prompt('Enter number of circles to draw',ncircpart,0,size(icircpart)) if (ncircpart.gt.0) then do n=1,ncircpart if (icircpart(n).eq.0) then if (n.gt.1) then icircpart(n) = icircpart(n-1)+1 else icircpart(n) = 1 endif endif call prompt('Enter particle number to plot circle around', & icircpart(n),1,maxval(npartoftype(1,:))) enddo endif endif return !------------------------------------------------------------------------ case(7) print 20,icoords do i=1,maxcoordsys print 30,i,labelcoordsys(i) enddo 20 format(' 0) reset (=',i2,')') 30 format(1x,i1,')',1x,a) icoordsprev = icoordsnew call prompt(' Enter coordinate system to plot in:', & icoordsnew,0,maxcoordsys) if (icoordsnew.eq.0) icoordsnew = icoords if (icoordsnew.ne.icoordsprev) then itrans(1:ndim) = 0 call coord_transform_limits(lim(1:ndim,1),lim(1:ndim,2), & icoordsprev,icoordsnew,ndim) call set_coordlabels(numplot) if (DataIsBuffered) then call calc_quantities(1,nsteps) else call calc_quantities(1,nstepsinfile(ifileopen)) endif endif return !------------------------------------------------------------------------ case(8) call submenu_exact(iexact) return !------------------------------------------------------------------------ case(9) call options_exact return !------------------------------------------------------------------------ case default return end select return end subroutine submenu_particleplots end module settings_part splash/src/options_powerspec.f90000644 000770 000000 00000010051 12564237444 017651 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2010 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing settings and options relating to power spectrum ! and Probability Distribution Function plots ! includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module settings_powerspec implicit none integer :: ipowerspecy, ipowerspecx, nfreqspec integer :: nwavelengths,npdfbins logical :: idisordered real :: freqmax,freqmin namelist /powerspecopts/ ipowerspecy,idisordered,nwavelengths,nfreqspec,npdfbins,freqmin,freqmax contains !--------------------------------------------- ! set default values for these options !--------------------------------------------- subroutine defaults_set_powerspec use settings_data, only:ndim implicit none idisordered = .true. ipowerspecy = max(ndim+1,2) ipowerspecx = 0 ! reset later nwavelengths = 128 freqmin = 1.0 freqmax = nwavelengths*freqmin nfreqspec = 1 npdfbins = 0 return end subroutine defaults_set_powerspec !---------------------------------------------------------------------- ! sets options and parameters for power spectrum calculation/plotting !---------------------------------------------------------------------- subroutine options_powerspec use settings_data, only:ndim,ndataplots,numplot use limits, only:lim use labels, only:ipowerspec use prompting, only:prompt implicit none real :: boxsize if (ipowerspecy.lt.ndim+1) ipowerspecy = ndim+1 if (ipowerspecy.gt.ndataplots) ipowerspecy = ndataplots call prompt('enter data to take power spectrum of',ipowerspecy,ndim+1,ndataplots) if (ipowerspecx.ne.1) then if (ipowerspecx.lt.1) ipowerspecx = 1 if (ipowerspecx.gt.ndataplots) ipowerspecx = ndataplots call prompt('enter column to use as "time" or "space"',ipowerspecx,1,ndataplots) endif ! !--if box size has not been set then use x limits ! if (abs(freqmin-1.0).lt.tiny(1.)) then boxsize = abs(lim(1,2) - lim(1,1)) if (boxsize.gt.tiny(boxsize)) freqmin = 1./boxsize endif call prompt('enter min frequency (default=1/box size)',freqmin,0.0) call prompt('enter max frequency ',freqmax,min=freqmin) if (ipowerspec.le.ndataplots .or. ipowerspec.gt.numplot) then !--this should never happen print*,'*** ERROR: something wrong in powerspectrum limit setting' else print*,' wavelength range ',1./freqmax,'->',1./freqmin lim(ipowerspec,1) = freqmin lim(ipowerspec,2) = freqmax print*,' frequency range ',lim(ipowerspec,1),'->',lim(ipowerspec,2) if (nfreqspec.le.1) nfreqspec = 2*nwavelengths call prompt('how many frequency points between these limits? ',nfreqspec,nwavelengths) endif !! call prompt('use Lomb periodogram? (no=interpolate and fourier) ',idisordered) return end subroutine options_powerspec !----------------------------------------------------------------- ! ! settings for PDF calculation ! !----------------------------------------------------------------- subroutine options_pdf use prompting, only:prompt implicit none call prompt(' Enter number of bins between min and max of plot (0=auto)',npdfbins,0) end subroutine options_pdf end module settings_powerspec splash/src/options_render.f90000644 000770 000000 00000035570 12556617254 017140 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing settings and options relating to renderings ! includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module settings_render use colourbar, only:ColourBarDisp,iplotcolourbarlabel,ColourBarPosx,ColourBarPosy,& ColourBarLen,ColourBarFmtStr,ColourBarWidth use labels, only:lenlabel use kernels, only:ikernel implicit none integer :: ncontours,npix,icolours,iColourBarStyle,iColourBarPos logical :: iplotcont_nomulti,ilabelcont logical :: icolour_particles,inormalise_interpolations logical :: ifastrender,idensityweightedinterpolation logical :: double_rendering character(len=lenlabel+20) :: projlabelformat integer :: iapplyprojformat namelist /renderopts/ npix,icolours,ncontours,iplotcont_nomulti, & icolour_particles,ColourBarDisp,inormalise_interpolations, & ifastrender,idensityweightedinterpolation,iColourBarStyle, & iplotcolourbarlabel,ilabelcont,projlabelformat,iapplyprojformat, & double_rendering,ikernel,ColourBarPosx,ColourBarPosy,ColourBarLen,& ColourBarFmtStr,ColourBarWidth,iColourBarPos contains !--------------------------------------------- ! set default values for these options !--------------------------------------------- subroutine defaults_set_render implicit none icolours = 2 ! colour scheme to use npix = 0 ! pixels in x direction for rendering iColourBarStyle = 1 ! whether or not to plot the colour bar and style iplotcont_nomulti = .false. ! plot contours icolour_particles = .false. ! colour particles instead of using pixels ncontours = 30 ! number of contours to plot ColourBarDisp = 5.0 ! displacement of colour bar label from edge inormalise_interpolations = .false. ! do not normalise interpolations ifastrender = .false. ! use accelerated rendering idensityweightedinterpolation = .false. iplotcolourbarlabel = .true. ilabelcont = .false. ! print numeric labels on contours projlabelformat = ' ' iapplyprojformat = 0 double_rendering = .false. ikernel = 0 ! just take default kernel ColourBarPosx = 0.75 ! default values used for floating colour bars ColourBarPosy = 0.7 ColourBarLen = 0.25 ColourBarWidth = 2. ColourBarFmtStr = 'BCMSTV' iColourBarPos = 3 return end subroutine defaults_set_render !----------------------------------------------------------------------------- ! options for rendered plots !----------------------------------------------------------------------------- subroutine submenu_render(ichoose) use colourbar, only:maxcolourbarstyles,labelcolourbarstyles,barisvertical,& isfloating,iscustombar use colours, only:schemename,ncolourschemes,colour_demo use prompting, only:prompt,print_logical use params, only:maxplot use plotlib, only:plotlib_supports_alpha use filenames, only:fileprefix use kernels, only:select_kernel,kernelname,nkernels use projections3D, only:setup_integratedkernel implicit none integer, intent(in) :: ichoose character(len=5) :: string character(len=20) :: kname integer :: ians,i,ierr,icolourprev ! !--rendering options ! ians = ichoose print "(a)",'----------------- rendering options -------------------' if (ians.le.0 .or. ians.gt.8) then if (npix.gt.0) then write(string,"(i5)") npix else string = 'AUTO' endif kname = '' if (ikernel.ge.0 .and. ikernel.le.nkernels) kname = trim(kernelname(ikernel)) print 10,trim(string),icolours,print_logical(iplotcont_nomulti),ncontours, & iColourBarStyle,print_logical(icolour_particles), & print_logical(inormalise_interpolations),print_logical(ifastrender),& print_logical(idensityweightedinterpolation),trim(projlabelformat),& trim(kname) 10 format( & ' 0) exit ',/, & ' 1) set number of pixels ( ',a,' )',/, & ' 2) change colour scheme (',i2,' )',/, & ' 3) 2nd render/contour prompt ( ',a,' )',/, & ' 4) change number of contours (',i3,' )',/, & ' 5) colour bar options ( ',i2,' )',/,& ' 6) use particle colours not pixels ( ',a,' )',/,& ' 7) normalise interpolations ( ',a,' )',/,& ' 8) use accelerated rendering ( ',a,' )',/,& ' 9) use density weighted interpolation ( ',a,' )',/, & ' 10) customize label on projection plots ( ',a,' )',/,& ' 11) change kernel ( ',a,' )') call prompt('enter option',ians,0,11) endif ! !--options ! select case(ians) !------------------------------------------------------------------------ case(1) print "(5(/,a),/)",' Note: setting number of pixels = 0 means that ', & ' the number of pixels will be automatically ', & ' chosen to match the device used for plotting.', & ' The number of pixels is then determined by ', & ' the page size (set in the p)age menu).' call prompt('enter number of pixels along x axis (0=auto)',npix,0,100000) !------------------------------------------------------------------------ case(2) ierr = 1 icolourprev = icolours write(*,"(i2,a,1x)") (i,': '//trim(schemename(i)),i=1,ncolourschemes) write(*,"(i2,a,1x)") ncolourschemes+1,': demo plot of all schemes' print "(a)",'(-ve = inverse, 0 = contours only)' promptloop: do while (ierr /= 0) call prompt('enter colour scheme for rendering ',icolours,-ncolourschemes,ncolourschemes+1) ! ! demonstration plot of all colour schemes ! ierr = 0 if (abs(icolours).eq.ncolourschemes+1) then call colour_demo icolours = icolourprev ierr = 1 endif enddo promptloop !------------------------------------------------------------------------ case(3) if (icolours.eq.0) then print "(2(/,a),/)",' Warning: this option has no effect if colour scheme 0 is set', & ' (cannot plot contours on top of contours)' endif if (plotlib_supports_alpha) then call prompt(' allow contour/double render prompt?',iplotcont_nomulti) print "(3(/,a),/)",' Double rendering renders the first quantity in black and white', & ' and the second in colour with a transparent background ', & ' (such that data below the colour bar minimum appears transparent)' call prompt('use double rendering instead of contours?',double_rendering) else call prompt('allow contour plotting prompt?',iplotcont_nomulti) endif if (double_rendering) then print "(a)",' Second render prompt is '//trim(print_logical(iplotcont_nomulti)) else print "(a)",' Contour plotting prompt is '//trim(print_logical(iplotcont_nomulti)) endif if ((iplotcont_nomulti .or. icolours.eq.0) .and. .not.double_rendering) then call prompt('enter number of contours between min,max',ncontours,0,500) call prompt('plot contour labels?',ilabelcont) endif !------------------------------------------------------------------------ case(4) print "(5(/,a),/)",& ' To set contour levels and level labels manually, create a file called', & ' '''//trim(fileprefix)//'.contours'' in the working directory, with the following format:',& ' 1.0 label1 ', & ' 2.0 label2 ', & ' ...' call prompt('otherwise, enter number of contours between min,max',ncontours,0,500) call prompt('plot contour labels?',ilabelcont) !------------------------------------------------------------------------ case(5) do i=0,maxcolourbarstyles print "(i2,')',1x,a)",i,trim(labelcolourbarstyles(i)) enddo call prompt('enter colour bar style to use ',iColourBarStyle,0,maxcolourbarstyles) print "(a,/)",'colour bar style = '//trim(labelcolourbarstyles(iColourBarStyle)) if (iColourBarStyle.gt.0) then if (isfloating(iColourBarStyle)) then print "(5(a,/),a)",' Positioning of floating colour bar: ', & ' 1) Top left ', & ' 2) Top right ', & ' 3) Bottom left ', & ' 4) Bottom right ', & ' 5) Custom ' call prompt('enter option',iColourBarPos,1,5) if (iColourBarPos >= 1 .and. iColourBarPos < 5) ColourBarLen = 0.25 select case(iColourBarPos) case(1) if (barisvertical(iColourBarStyle)) then ColourBarPosx = 0.01 ColourBarPosy = 0.74 else ColourBarPosx = 0.01 ColourBarPosy = 0.95 endif case(2) if (barisvertical(iColourBarStyle)) then ColourBarPosx = 0.82 ! minus width in ch ColourBarPosy = 0.74 else ColourBarPosx = 0.73 ColourBarPosy = 0.95 endif case(3) if (barisvertical(iColourBarStyle)) then ColourBarPosx = 0.01 ColourBarPosy = 0.01 else ColourBarPosx = 0.015 ColourBarPosy = 0.075 endif case(4) if (barisvertical(iColourBarStyle)) then ColourBarPosx = 0.82 ! minus width in ch ColourBarPosy = 0.01 else ColourBarPosx = 0.73 ColourBarPosy = 0.075 endif case default call prompt('enter x position of colour bar as fraction of viewport',ColourBarPosx,-1.,1.5) call prompt('enter y position of colour bar as fraction of viewport',ColourBarPosy,-1.,1.5) call prompt('enter length of colour bar as fraction of viewport',ColourBarLen,0.,1.) end select endif call prompt('plot colour bar label?',iplotcolourbarlabel) if (barisvertical(iColourBarStyle) .and. iplotcolourbarlabel) then call prompt('enter displacement of text from edge (character heights) ', & ColourBarDisp) endif if (iscustombar(iColourBarStyle)) then call prompt('enter width of colour bar in character heights',ColourBarWidth,0.,20.) if (barisvertical(iColourBarstyle)) then print "(a)",' A=axis,B=bottom,C=top,T=major ticks,S=minor ticks,N=labels,V=vertical,L=log,M=labels above' else print "(a)",' B=left,C=right,T=major ticks,S=minor ticks,N=labels,L=log,M=labels to left' if (ColourBarFmtStr.eq.'BCMSTV') then ColourBarFmtStr='BCNST' ! use default string for horizontal bars instead endif endif call prompt('enter format code string for colour bar ticks/numbering',ColourBarFmtStr) endif endif !------------------------------------------------------------------------ case(6) icolour_particles = .not.icolour_particles print "(a)",' Use particle colours instead of pixels is ' & //trim(print_logical(icolour_particles)) !------------------------------------------------------------------------ case(7) inormalise_interpolations = .not.inormalise_interpolations print "(a)",' Normalisation of interpolations is ' & //trim(print_logical(inormalise_interpolations)) !------------------------------------------------------------------------ case(8) ifastrender = .not.ifastrender print "(a)",' Accelerated rendering is '//trim(print_logical(ifastrender)) if (ifastrender) then print*,' Warning: this is slightly approximate (particle position' print*,' assumed to be at centre of pixel)' endif !------------------------------------------------------------------------ case(9) idensityweightedinterpolation = .not.idensityweightedinterpolation print "(a)",' Density weighted interpolation is '// & print_logical(idensityweightedinterpolation) !------------------------------------------------------------------------ case(10) print "(5(/,a),/,4(/,a),/)", & ' Example format strings: ', & ' \(2268) %l d%z %uz : this is the default format "\int rho [g/cm^3] dz [cm]"', & ' column %l : would print "column density" for density', & ' surface %l : would print "surface density"', & ' %l integrated through %z : would print "density integrated through z"', & ' Format codes: ', & ' %l : label for rendered quantity ', & ' %z : label for ''z'' ', & ' %uz : units label for z (only if physical units applied)' call prompt(' enter label format for projection plots: ',projlabelformat) call prompt(' enter which column to apply format to (0=all) ',iapplyprojformat,0,maxplot) !------------------------------------------------------------------------ case(11) do i=0,nkernels print "(1x,i1,')',1x,a)",i,trim(kernelname(i)) enddo call prompt(' enter kernel to use for interpolations (0=default)',ikernel,0,nkernels) call select_kernel(ikernel) call setup_integratedkernel ! need to redo the kernel table if kernel has changed end select return end subroutine submenu_render end module settings_render splash/src/options_vecplot.f90000644 000770 000000 00000016645 12156075751 017333 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing settings and options relating to vector plots ! includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module settings_vecplot implicit none integer :: npixvec,minpartforarrow,iVecLegendOnPanel logical :: UseBackgndColorVecplot, iplotpartvec logical :: iVecplotLegend,iplotstreamlines,iplotarrowheads logical :: iplotsynchrotron,ihidearrowswherenoparts,iallarrowssamelength real :: hposlegendvec,vposlegendvec real :: rcrit,zcrit,synchrotronspecindex,uthermcutoff namelist /vectoropts/ npixvec, UseBackgndColorVecplot,iplotpartvec,& iVecplotLegend,hposlegendvec,vposlegendvec,iplotstreamlines, & iplotarrowheads,iplotsynchrotron,rcrit,zcrit,synchrotronspecindex, & uthermcutoff,ihidearrowswherenoparts,minpartforarrow,iallarrowssamelength,& iVecLegendOnPanel contains !--------------------------------------------- ! set default values for these options !--------------------------------------------- subroutine defaults_set_vecplot implicit none npixvec = 40 ! pixels in x direction on vector plots UseBackgndColorVecplot = .false. ! plot vector plot using black/white iplotpartvec = .true. ! whether to plot particles on vector plot iVecplotLegend = .true. iVecLegendOnPanel = 0 ! all panels hposlegendvec = 0.02 vposlegendvec = -1.5 iplotstreamlines = .false. ! plot stream lines instead of arrows iplotarrowheads = .true. iplotsynchrotron = .false. zcrit = 2.5 ! kpc rcrit = 13. ! kpc synchrotronspecindex = 0.8 uthermcutoff = -1. ! flags this as uninitialised ihidearrowswherenoparts = .false. minpartforarrow = 1 iallarrowssamelength = .false. return end subroutine defaults_set_vecplot !---------------------------------------------------------------------- ! sets options relating to vector plots !---------------------------------------------------------------------- subroutine submenu_vecplot(ichoose) use prompting, only:prompt,print_logical use settings_data, only:ndim,numplot use labels, only:iutherm use limits, only:lim use legends, only:prompt_panelselect implicit none integer, intent(in) :: ichoose integer :: ians ians = ichoose print "(a)",'--------------- vector plot options -------------------' if (ians.le.0 .or. ians.gt.7) then print 10,npixvec,print_logical(UseBackgndColorVecplot), & print_logical(iVecplotLegend),print_logical(iplotstreamlines), & print_logical(iplotarrowheads), & print_logical(ihidearrowswherenoparts), & print_logical(iallarrowssamelength) 10 format( & ' 0) exit ',/, & ' 1) change number of pixels (',i4,' )',/, & ' 2) use background colour for arrows ( ',a,' )',/, & ' 3) vector plot legend settings ( ',a,' )',/, & ' 4) plot stream/field lines instead of arrows ( ',a,' )',/, & ' 5) turn arrow heads on/off ( ',a,' )',/, & ' 6) hide arrows where there are no particles ( ',a,' )',/, & ' 7) all arrows same length - ie. direction only ( ',a,' )') call prompt('enter option',ians,0,7) endif ! !--options ! select case(ians) !------------------------------------------------------------------------ case(1) call prompt('enter number of pixels',npixvec,1,1000) !------------------------------------------------------------------------ case(2) UseBackgndColorVecplot = .not.UseBackgndColorVecplot print*,'use background colour on vector plots = ', & print_logical(UseBackgndColorVecplot) !------------------------------------------------------------------------ case(3) call prompt('plot vector legend?',iVecplotLegend) if (iVecplotLegend) then print*,'note: H key in interactive mode can also be used to set positions' call prompt('Enter horizontal position as fraction of viewport', & hposlegendvec,0.0,1.0) call prompt('Enter vertical position in character heights from top', & vposlegendvec) call prompt_panelselect('vector legend',iVecLegendOnPanel) endif !------------------------------------------------------------------------ case(4) iplotstreamlines = .not.iplotstreamlines print "(2(a,/))",' Note: the number of stream lines plotted is determined by', & ' the "change number of contours" option in the r)ender menu' call prompt('use stream lines instead of arrows? ',iplotstreamlines) !------------------------------------------------------------------------ case(5) iplotarrowheads = .not.iplotarrowheads call prompt('plot arrow heads? ',iplotarrowheads) if (ndim.eq.3 .and. .not.iplotarrowheads) then call prompt(' plot synchrotron map? ',iplotsynchrotron) if (iplotsynchrotron) then if (iutherm.lt.0 .or. iutherm.gt.numplot) then print "(a)",' Warning: cannot use thermal energy cutoff in synchrotron plots' print "(a)",' (could not locate thermal energy in data columns)' endif call prompt(' enter rcrit for cosmic ray electron distribution exp(-r/rcrit -z/zcrit)',rcrit,0.) call prompt(' enter zcrit for cosmic ray electron distribution exp(-r/rcrit -z/zcrit)',zcrit,0.) call prompt(' enter synchrotron spectral index I_nu = nu^-alpha ',synchrotronspecindex,0.) if (iutherm.gt.0 .and. iutherm.le.numplot) then !--set sensible default value for uthermcutoff if (uthermcutoff.lt.-tiny(uthermcutoff)) then uthermcutoff = 0.5*(lim(iutherm,1) + lim(iutherm,2)) endif call prompt(' enter threshold thermal energy in current units (u < utherm not used) ',uthermcutoff,0.) endif endif endif !------------------------------------------------------------------------ case(6) call prompt('hide vector arrows where there are no particles ? ',ihidearrowswherenoparts) if (ihidearrowswherenoparts) then call prompt(' enter minimum number of particles in pixel cell for arrow to be plotted ',minpartforarrow,1) endif !------------------------------------------------------------------------ case(7) iallarrowssamelength = .not.iallarrowssamelength call prompt('make all arrows same length (ie. only show direction, not magnitude) ?',iallarrowssamelength) end select return end subroutine submenu_vecplot end module settings_vecplot splash/src/options_xsecrotate.f90000644 000770 000000 00000071213 12344012562 020016 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module containing settings and options relating to cross sections, ! rotations and 3D plotting. ! Includes default values of these options and submenu for changing them !------------------------------------------------------------------------- module settings_xsecrot implicit none !--public variables integer, public :: nframes,nseq integer, public :: nxsec,irotateaxes logical, public :: xsec_nomulti, irotate, flythru, use3Dperspective, use3Dopacityrendering logical, public :: writeppm, rendersinks real, public :: anglex, angley, anglez, zobserver, dzscreenfromobserver real, public :: taupartdepth,xsecwidth real, public :: xsecpos_nomulti,xseclineX1,xseclineX2,xseclineY1,xseclineY2 real, public, dimension(3) :: xorigin,xminrotaxes,xmaxrotaxes !--private variables related to animation sequences integer, parameter, private :: maxseq = 6 integer, dimension(maxseq), public :: iseqstart,iseqend,iseqtype integer, public :: icolchange real, public :: xminseqend,xmaxseqend,yminseqend,ymaxseqend real, public :: anglezend,angleyend,anglexend,zobserverend,taupartdepthend real, public :: xmincolend,xmaxcolend,xsecpos_nomulti_end logical, private :: ihavesetsequence character(len=*), dimension(maxseq), parameter, private :: labelseqtype = & (/'steady zoom on x and y axes ', & 'steady rotation ', & 'steady change of limits (e.g. for colour bar) ', & 'steady movement of 3D observer ', & 'sequence of cross section slices through a 3D box ', & 'steady change of opacity for 3D surface plots '/) !--namelists for writing to defaults file and .anim file public :: xsecrotopts namelist /xsecrotopts/ xsec_nomulti,xsecpos_nomulti,flythru, & xseclineX1,xseclineX2,xseclineY1,xseclineY2, & irotate,irotateaxes,anglex, angley, anglez, & xminrotaxes,xmaxrotaxes,use3Dperspective, & use3Dopacityrendering,zobserver,dzscreenfromobserver, & taupartdepth,writeppm,xsecwidth,rendersinks public :: animopts namelist /animopts/ nseq,nframes,iseqstart,iseqend,iseqtype, & xminseqend,xmaxseqend,yminseqend,ymaxseqend, & anglezend,angleyend,anglexend,zobserverend,taupartdepthend, & icolchange,xmincolend,xmaxcolend,xsecpos_nomulti_end !--public procedure names public :: defaults_set_xsecrotate,submenu_xsecrotate,getsequencepos,insidesequence public :: setsequenceend procedure(add_sequence), pointer :: addseq => null() procedure(delete_sequence), pointer :: delseq => null() procedure(check_sequences), pointer :: checkseq => null() private contains !--------------------------------------------- ! set default values for these options !--------------------------------------------- subroutine defaults_set_xsecrotate implicit none xsec_nomulti = .false. ! take cross section of data / particles xsecpos_nomulti = 0. ! position of cross section flythru = .false. ! take series of cross sections through data xseclineX1 = 0.0 xseclineX2 = 0.0 xseclineY1 = 0.0 xseclineY2 = 0.0 xsecwidth = 0.0 ! width of xsec slices - zero means suggest better value to user irotate = .false. irotateaxes = 0 anglex = 0. angley = 0. anglez = 0. xminrotaxes = 0. xmaxrotaxes = 0. use3Dperspective = .false. use3Dopacityrendering = .false. zobserver = 0. dzscreenfromobserver = 0. taupartdepth = 2. writeppm = .true. !--defaults for animation sequences nseq = 0 nframes = 0 iseqstart(:) = 0 iseqend(:) = 0 iseqtype(:) = 0 xminseqend = 0. xmaxseqend = 0. yminseqend = 0. ymaxseqend = 0. anglezend = 360. angleyend = 0. anglexend = 0. icolchange = 0 xmincolend = 0. xmaxcolend = 0. zobserverend = 0. taupartdepthend = 2000.0 xsecpos_nomulti_end = 0. ihavesetsequence = .false. rendersinks = .false. return end subroutine defaults_set_xsecrotate !---------------------------------------------------------------------- ! sets options relating to cross sectioning / rotation !---------------------------------------------------------------------- subroutine submenu_xsecrotate(ichoose) use filenames, only:nsteps,nstepsinfile,ifileopen use labels, only:label,ix,irad,get_sink_type use limits, only:lim use prompting, only:prompt,print_logical use promptlist, only:prompt_list use settings_data, only:ndim,xorigin,iCalcQuantities,DataIsBuffered,ntypes use calcquantities, only:calc_quantities use plotlib, only:plotlib_supports_alpha implicit none integer, intent(in) :: ichoose integer :: ians,i logical :: ichangedorigin character(len=4) :: text real, dimension(3) :: xorigintemp print "(a)",'---------- cross section / 3D plotting options --------' if (ndim.eq.1) print*,' WARNING: none of these options have any effect in 1D' ians = ichoose if (xsec_nomulti) then text = 'xsec' else text = 'proj' endif if (ians.le.0 .or. ians.gt.6) then print 10,text,print_logical(irotate),anglex,angley,anglez, & print_logical(use3Dperspective),print_logical(use3Dopacityrendering), & irotateaxes,nseq 10 format( & ' 0) exit ',/, & ' 1) switch between cross section/projection ( ',a4,' )',/, & ' 2) rotation on/off/settings (incl. origin pos) ( ',a,3(1x,f5.1),' )',/, & ' 3) 3D perspective on/off ( ',a,' )',/, & ' 4) 3D surface rendering on/off ( ',a,' )',/, & ' 5) set axes for rotated/3D plots ( ',i2,' )',/, & ' 6) set animation sequence (rotate,flythru etc.) ( ',i2,' )') call prompt('enter option',ians,0,6) endif ! !--options ! select case(ians) !------------------------------------------------------------------------ case(1) xsec_nomulti = .not.xsec_nomulti print *,' Cross section = ',xsec_nomulti !------------------------------------------------------------------------ case(2) call prompt('use rotation?',irotate) print "(a)",' rotation is '//trim(print_logical(irotate)) if (irotate) then print*,'note that rotations are done in the order z-y-x ' print*,'this means the y and x rotations are done about the *new* y and x axes' print*,'if in doubt, set the angles interactively in this order' call prompt('enter rotation angle about z axis (deg)',anglez,0.,360.) if (ndim.eq.3) then call prompt('enter rotation angle about y axis (deg)',angley,0.,360.) call prompt('enter rotation angle about x axis (deg)',anglex,0.,360.) endif endif !xorigin(1:ndim) = 0.5*(lim(1:ndim,1) + lim(1:ndim,2)) xorigintemp(1:ndim) = xorigin(1:ndim) ichangedorigin = .false. print "(a)",' Note that origin settings affect both rotation and radius calculations' do i=1,ndim call prompt('enter location of origin '//trim(label(ix(i))),xorigin(i)) if (abs(xorigin(i)-xorigintemp(i)).gt.tiny(0.)) then ichangedorigin = .true. endif enddo !--recalculate radius if origin settings have changed if (ichangedorigin .and. iCalcQuantities .and. irad.gt.0) then if (DataIsBuffered) then call calc_quantities(1,nsteps) else call calc_quantities(1,nstepsinfile(ifileopen)) endif endif !------------------------------------------------------------------------ case(3) call prompt(' Use 3D perspective? ',use3Dperspective) if (use3Dperspective) then if (.not.irotate) irotate = .true. if (abs(anglez).lt.tiny(anglez) .and. & abs(angley).lt.tiny(angley) .and. & abs(anglex).lt.tiny(anglex)) then anglez = 30. anglex = 60. print "(a)",' setting default rotation angles to 30,0,60' endif else ! turn off opacity rendering if 3D perspective has been turned off use3Dopacityrendering = .false. endif !------------------------------------------------------------------------ case(4) call prompt(' Use 3D opacity rendering? ',use3Dopacityrendering) if (use3Dopacityrendering .and..not.use3Dperspective) then print "(a)",' also turning on 3D perspective (which must be set for this to work)' use3Dperspective = .true. endif if (use3Dopacityrendering) then if (.not.plotlib_supports_alpha) then print "(/,a)",' Warning: 3D opacity rendering sends only an approximate version ' print "(a,/)",' to the PGPLOT device (not corrected for brightness) ' call prompt(' Do you want to write a ppm file in addition to PGPLOT output?',writeppm) else writeppm = .false. !call prompt(' Do you want to apply the brightness correction?',writeppm) endif endif if (use3Dopacityrendering .and. get_sink_type(ntypes) > 0) then call prompt('Include sinks in opacity rendering (no=plot on top)?',rendersinks) endif !------------------------------------------------------------------------ case(5) print*,'0 : do not plot rotated axes' print*,'1 : plot rotated axes' print*,'2 : plot rotated box' print*,'3 : plot gridded x-y plane' call prompt('enter type of axes to plot',irotateaxes,0,3) if (irotateaxes.gt.0) then !--if not previously set, use current plot limits if (all(abs(xminrotaxes).le.tiny(xminrotaxes))) then xminrotaxes(:) = lim(ix(:),1) xmaxrotaxes(:) = lim(ix(:),2) endif do i=1,ndim call prompt('enter '//trim(label(ix(i)))//'min:',xminrotaxes(i)) call prompt('enter '//trim(label(ix(i)))//'max:',xmaxrotaxes(i)) enddo endif !------------------------------------------------------------------------ case(6) call submenu_animseq() end select return end subroutine submenu_xsecrotate !---------------------------------------------------------------------- ! sets up animation sequences !---------------------------------------------------------------------- subroutine submenu_animseq() use promptlist, only:prompt_list use prompting, only:prompt addseq => add_sequence checkseq => check_sequences delseq => delete_sequence call prompt_list(nseq,maxseq,'sequence',checkseq,addseq,delseq) end subroutine submenu_animseq !----------------------------------- ! print the current list of shapes !----------------------------------- subroutine check_sequences(n) implicit none integer, intent(in) :: n integer :: iseq print "(/,a)", ' Current list of animation sequences:' if (n.gt.0) then do iseq=1,n print "(i2,') ',a)",iseq,labelseqtype(iseqtype(iseq)) enddo else print "(a)",' (none)' endif end subroutine check_sequences subroutine delete_sequence(iseq,n) implicit none integer, intent(in) :: iseq integer, intent(inout) :: n integer :: i if (iseq.gt.0 .and. n.gt.0 .and. iseq.le.maxseq) then if (iseqtype(iseq).gt.0 .and. iseqtype(iseq).le.maxseq) then print "(a,i1,': ',a)",' deleting sequence ',iseq,trim(labelseqtype(iseqtype(iseq))) endif iseqtype(iseq) = 0 do i=iseq+1,n iseqtype(i-1) = iseqtype(i) enddo n = n - 1 endif end subroutine delete_sequence subroutine add_sequence(istart,iend,n) use prompting, only:prompt use limits, only:lim use labels, only:ix,irho use settings_data, only:ndim,istartatstep,iendatstep,numplot use filenames, only:nsteps implicit none integer, intent(in) :: istart,iend integer, intent(inout) :: n integer :: i,j,ierr i = istart + 1 over_sequences: do while (i.le.iend .and. i.le.maxseq) if (i.gt.n) n = i if (n.gt.0) then !--set sensible default value for number of frames if (nframes.eq.0) then if (nsteps.gt.1) then nframes = 1 else nframes = 10 endif endif call prompt('Enter number of frames generated between dumps (applies to all sequences)',nframes,1,500) !call prompt('Use same sequence position for all plots on the page?',imultiframeseq) endif print "(a,i2,a)",'----------------- sequence ',i,' ----------------------' if (iseqstart(i).eq.0) iseqstart(i) = max(istartatstep,1) if (iseqend(i).eq.0) iseqend(i) = max(1,iendatstep,istartatstep) if (nsteps.gt.1) then call prompt('Enter starting dump for sequence ',iseqstart(i),1,nsteps) call prompt('Enter finishing dump for sequence ',iseqend(i),1,nsteps) endif ierr = 1 do while (ierr /= 0) print "(7(/,1x,i1,1x,':',1x,a))",0,'none (remove sequence) ', & (j,labelseqtype(j),j=1,maxseq) call prompt('Enter type of sequence ',iseqtype(i),0,maxseq) !--allow only one sequence of each type ierr = 0 if (i.gt.0) then do j=1,n if (i.ne.j .and. (iseqtype(j).eq.iseqtype(i)) .and. (iseqtype(i).gt.0)) ierr = 2 enddo if (ierr.eq.2) print "(/,a)",' Error: can only have one sequence of each type ' endif end do select case(iseqtype(i)) case(1) print "(a)",'Note: zoom sequence starts using current fixed x,y plot limits' if (abs(xminseqend).lt.tiny(xminseqend) .and. abs(xmaxseqend).lt.tiny(xmaxseqend)) then xminseqend = lim(1,1) xmaxseqend = lim(1,2) endif call prompt(' Enter finishing xmin ',xminseqend) call prompt(' Enter finishing xmax ',xmaxseqend) if (abs(yminseqend).lt.tiny(yminseqend) .and. abs(ymaxseqend).lt.tiny(ymaxseqend)) then yminseqend = lim(2,1) ymaxseqend = lim(2,2) endif call prompt(' Enter finishing ymin ',yminseqend) call prompt(' Enter finishing ymax ',ymaxseqend) case(2) if (ndim.lt.2) then print "(a)",' ERROR: cannot use this sequence in 1D' iseqtype(i) = 0 endif if (.not.irotate) then print "(a)",' Turning rotation on...' irotate = .true. endif print "(a)",'Note: rotation sequence starts using current rotation settings' call prompt(' Enter finishing rotation angle (z axis) ',anglezend) call prompt(' Enter finishing rotation angle (y axis) ',angleyend) call prompt(' Enter finishing rotation angle (x axis) ',anglexend) case(3) if (icolchange.le.0 .or. icolchange.gt.numplot) then if (irho.gt.0 .and. irho.le.numplot) then icolchange = irho else icolchange = 1 endif endif call prompt(' Enter column to change limits ',icolchange,1,numplot) print "(a)",'Note: limits start from current fixed plot limits for this column' if (abs(xmincolend).lt.tiny(xmincolend) .and. abs(xmaxcolend).lt.tiny(xmaxcolend)) then xmincolend = lim(icolchange,1) xmaxcolend = lim(icolchange,2) endif call prompt(' Enter finishing minimum value ',xmincolend) call prompt(' Enter finishing maximum value ',xmaxcolend) case(4) if (ndim.ne.3) then print "(a)",' ERROR: cannot use this sequence in < 3D' iseqtype(i) = 0 endif if (.not.use3Dperspective) then print "(a)",'Turning 3D perspective on...' use3Dperspective = .true. endif print "(a)",'Note: observer starts at current observer settings ' print "(a)",' (screen height does not change)' !--try to give sensible default values if (abs(zobserverend).lt.tiny(zobserverend)) then if (abs(zobserver).gt.tiny(zobserver)) then zobserverend = 5.*zobserver elseif (ix(3).gt.0 .and. ix(3).le.numplot) then zobserverend = 10.*lim(ix(3),2) endif endif call prompt(' Enter finishing 3D observer height ',zobserverend) case(5) if (ndim.ne.3) then print "(a)",' ERROR: cannot use this sequence in < 3D' iseqtype(i) = 0 endif if (.not.xsec_nomulti) then print "(a)",'Changing from projection to cross-section' xsec_nomulti = .true. if (use3Dperspective .and. .not.use3Dopacityrendering) then print "(a)",'Turning 3D perspecitve off' use3Dperspective = .false. endif endif print "(a)",'Note: slice position starts from value set at initial prompt' call prompt(' Enter finishing slice position ',xsecpos_nomulti_end) case(6) if (ndim.ne.3) then print "(a)",' ERROR: cannot use this sequence in < 3D' iseqtype(i) = 0 endif if (.not.use3Dperspective .or. .not.use3Dopacityrendering) then print "(a)",'Turning 3D opacity rendering and 3D perspective on...' use3Dopacityrendering = .true. use3Dperspective = .true. endif print "(3(a,/))",'Note: opacity sequence starts from current opacity value ', & ' and that logarithmic steps are used if finishing value is', & ' set to more than 1000 times the starting value (or vice-versa) ' call prompt('Enter finishing opacity in units of average smoothing length ',taupartdepthend) case default call delete_sequence(i,n) exit over_sequences end select i = i + 1 enddo over_sequences if (all(iseqtype(1:n).eq.0)) then n = 0 else ihavesetsequence = .true. endif return end subroutine add_sequence !---------------------------------------------------------------------- ! ! subroutine called from interactive mode which sets the current ! plot settings as the end point to an animation sequence ! !---------------------------------------------------------------------- subroutine setsequenceend(ipos,iplotx,iploty,irender,rotation, & anglexi,angleyi,anglezi,zobserveri,use3Dopacity,taupartdepthi, & x_sec,xsecposi,xmin,xmax,ymin,ymax,rendermin,rendermax) use limits, only:lim use multiplot, only:itrans use settings_data, only:ndim,numplot use transforms, only:transform_limits,transform_limits_inverse,transform_label implicit none integer, intent(in) :: ipos,iplotx,iploty,irender real, intent(in) :: anglexi,angleyi,anglezi,zobserveri,taupartdepthi,xsecposi real, intent(in) :: xmin,xmax,ymin,ymax,rendermin,rendermax logical, intent(in) :: rotation, use3Dopacity,x_sec integer :: i real :: xminfixed,xmaxfixed,yminfixed,ymaxfixed,renderminfixed,rendermaxfixed nseq = 0 iseqtype(:) = 0 ! !--compare transformed limits ! xminfixed = lim(iplotx,1) xmaxfixed = lim(iplotx,2) call transform_limits(xminfixed,xmaxfixed,itrans(iplotx)) yminfixed = lim(iploty,1) ymaxfixed = lim(iploty,2) call transform_limits(yminfixed,ymaxfixed,itrans(iploty)) if (irender.gt.0 .and. irender.le.numplot) then renderminfixed = lim(irender,1) rendermaxfixed = lim(irender,2) call transform_limits(renderminfixed,rendermaxfixed,itrans(irender)) endif !--set however many sequences are required to capture the change in parameters ! !--change of x-y limits if ( notequal(xmin,xminfixed) .or. notequal(xmax,xmaxfixed) & .or.notequal(ymin,yminfixed) .or. notequal(ymax,ymaxfixed)) then nseq = nseq + 1 iseqtype(nseq) = 1 xminseqend = xmin xmaxseqend = xmax yminseqend = ymin ymaxseqend = ymax print*,trim(transform_label('xmin,max',itrans(iplotx)))//' start = ',xminfixed,xmaxfixed, & ' end = ',xminseqend,xmaxseqend print*,trim(transform_label('ymin,max',itrans(iploty)))//' start = ',yminfixed,ymaxfixed, & ' end = ',yminseqend,ymaxseqend !--always store untransformed limits call transform_limits_inverse(xminseqend,xmaxseqend,itrans(iplotx)) call transform_limits_inverse(yminseqend,ymaxseqend,itrans(iploty)) endif !--change of rotation angles if (ndim.ge.2 .and. rotation .and. & (notequal(anglexi,anglex).or.notequal(angleyi,angley).or.notequal(anglezi,anglez))) then nseq = nseq + 1 iseqtype(nseq) = 2 anglexend = anglexi angleyend = angleyi anglezend = anglezi print*,'angle x start = ',anglex,' end = ',anglexend print*,'angle y start = ',angley,' end = ',angleyend print*,'angle z start = ',anglez,' end = ',anglezend endif !--change of render limits if (ndim.gt.1 .and. irender.gt.0 .and. irender.le.numplot) then if (notequal(rendermin,renderminfixed) .or. notequal(rendermax,rendermaxfixed)) then nseq = nseq + 1 iseqtype(nseq) = 3 icolchange = irender xmincolend = rendermin xmaxcolend = rendermax print*,trim(transform_label('rendermin,max',itrans(irender)))//' start = ',renderminfixed,rendermaxfixed, & ' end = ',xmincolend,xmaxcolend !--always store untransformed limits call transform_limits_inverse(xmincolend,xmaxcolend,itrans(irender)) endif endif !--change of observer position if (ndim.eq.3 .and. notequal(zobserveri,zobserver)) then nseq = nseq + 1 iseqtype(nseq) = 4 zobserverend = zobserveri endif !--change of cross section position if (ndim.eq.3 .and. x_sec .and. notequal(xsecpos_nomulti,xsecposi)) then nseq = nseq + 1 iseqtype(nseq) = 5 xsecpos_nomulti_end = xsecposi endif !--change of opacity if (use3Dopacity .and. notequal(taupartdepthi,taupartdepth)) then nseq = nseq + 1 iseqtype(nseq) = 6 taupartdepthend = taupartdepthi endif !--all sequences start from 1 and end at current dump position iseqstart(1:nseq) = 1 iseqend(1:nseq) = ipos if (nseq.gt.0) then print "(1x,a,i1,a)",'total of ',nseq,' sequences set:' do i=1,nseq print "(1x,i1,': ',a)",i,trim(labelseqtype(iseqtype(i))) enddo print "(a,i5)",' sequences start at dump 1 and end at dump ',ipos if (nframes.le.0) then if (ipos.eq.1) then nframes = 10 else nframes = 1 endif print "(a,i3)",' setting number of frames = ',nframes endif else print "(a)",' no sequences set (no change in parameters)' endif return end subroutine setsequenceend !---------------------------------------------------------------------- ! utility function for comparing real numbers !---------------------------------------------------------------------- logical function notequal(r1,r2) implicit none real, intent(in) :: r1,r2 if (abs(r1-r2).gt.epsilon(r1)) then notequal = .true. else notequal = .false. endif end function notequal !---------------------------------------------------------------------- ! query function determining whether or not a given timestep ! is inside an animation sequence or not ! (and thus whether or not to generate extra frames) !---------------------------------------------------------------------- logical function insidesequence(ipos) implicit none integer, intent(in) :: ipos integer :: i insidesequence = .false. do i=1,nseq if (iseqtype(i).gt.0 .and. iseqstart(i).le.ipos .and. iseqend(i).ge.ipos) then insidesequence = .true. endif enddo return end function insidesequence !---------------------------------------------------------------------- ! query function which returns the current plot parameters ! based on the position in each sequence ! (given the current frame & dump position) !---------------------------------------------------------------------- subroutine getsequencepos(ipos,iframe,iplotx,iploty,irender, & anglexi,angleyi,anglezi,zobserveri,dzscreen,taupartdepthi, & xsecposi,xmin,xmax,ymin,ymax,rendermin,rendermax,isetrenderlimits) use limits, only:lim use multiplot, only:itrans use transforms, only:transform_limits implicit none integer, intent(in) :: ipos,iframe,iplotx,iploty,irender real, intent(out) :: anglexi,angleyi,anglezi,zobserveri,dzscreen,taupartdepthi,xsecposi real, intent(out) :: xmin,xmax,ymin,ymax,rendermin,rendermax logical, intent(out) :: isetrenderlimits logical :: logtaudepth integer :: i,iposinseq,iposend real :: xfrac,xminstart,xmaxstart,xminend,xmaxend,yminstart,ymaxstart,yminend,ymaxend isetrenderlimits = .false. do i=1,nseq !--set starting values based on first position if (ipos.ge.iseqstart(i)) then iposinseq = (ipos-iseqstart(i))*nframes + iframe iposend = (iseqend(i)-iseqstart(i))*nframes + nframes xfrac = (iposinseq-1)/real(iposend-1) xfrac = min(xfrac,1.0) if (iposinseq.gt.iposend) then print "(1x,a)",'--> '//trim(labelseqtype(iseqtype(i)))//' finished : frac = 1.0' else print "(1x,a,i3,a,i3,a,f5.2)",'--> frame ', & iposinseq,' / ',iposend,' of '//trim(labelseqtype(iseqtype(i)))//': frac = ',xfrac endif select case(iseqtype(i)) case(1) xminstart = lim(iplotx,1) xmaxstart = lim(iplotx,2) yminstart = lim(iploty,1) ymaxstart = lim(iploty,2) call transform_limits(xminstart,xmaxstart,itrans(iplotx)) call transform_limits(yminstart,ymaxstart,itrans(iploty)) xminend = xminseqend xmaxend = xmaxseqend yminend = yminseqend ymaxend = ymaxseqend call transform_limits(xminend,xmaxend,itrans(iplotx)) call transform_limits(yminend,ymaxend,itrans(iploty)) !--steps are linear in the transformed space ! and limits returned are *already transformed* xmin = xminstart + xfrac*(xminend - xminstart) xmax = xmaxstart + xfrac*(xmaxend - xmaxstart) ymin = yminstart + xfrac*(yminend - yminstart) ymax = ymaxstart + xfrac*(ymaxend - ymaxstart) case(2) anglexi = anglex + xfrac*(anglexend - anglex) angleyi = angley + xfrac*(angleyend - angley) anglezi = anglez + xfrac*(anglezend - anglez) case(3) !--steps are linear in the transformed space ! and limits returned are *already transformed* if (iplotx.eq.icolchange) then xminstart = lim(iplotx,1) xmaxstart = lim(iplotx,2) call transform_limits(xminstart,xmaxstart,itrans(iplotx)) xminend = xmincolend xmaxend = xmaxcolend call transform_limits(xminend,xmaxend,itrans(iplotx)) xmin = xminstart + xfrac*(xminend - xminstart) xmax = xmaxstart + xfrac*(xmaxend - xmaxstart) elseif (iploty.eq.icolchange) then yminstart = lim(iploty,1) ymaxstart = lim(iploty,2) call transform_limits(yminstart,ymaxstart,itrans(iploty)) yminend = xmincolend ymaxend = xmaxcolend call transform_limits(yminend,ymaxend,itrans(iploty)) ymin = yminstart + xfrac*(yminend - yminstart) ymax = ymaxstart + xfrac*(ymaxend - ymaxstart) elseif (irender.eq.icolchange) then xminstart = lim(irender,1) xmaxstart = lim(irender,2) call transform_limits(xminstart,xmaxstart,itrans(irender)) xminend = xmincolend xmaxend = xmaxcolend call transform_limits(xminend,xmaxend,itrans(irender)) rendermin = xminstart + xfrac*(xminend - xminstart) rendermax = xmaxstart + xfrac*(xmaxend - xmaxstart) isetrenderlimits = .true. endif case(4) zobserveri = zobserver + xfrac*(zobserverend - zobserver) dzscreen = zobserveri case(5) xsecposi = xsecpos_nomulti + xfrac*(xsecpos_nomulti_end - xsecpos_nomulti) case(6) logtaudepth = (taupartdepthend .gt. 1.001e3*taupartdepth) & .or.(taupartdepthend .lt. 1.001e-3*taupartdepth) if (logtaudepth) then print "(a)",' (incrementing optical depth logarithmically)' taupartdepthi = taupartdepth*(taupartdepthend/taupartdepth)**xfrac else taupartdepthi = taupartdepth + xfrac*(taupartdepthend - taupartdepth) endif end select endif enddo return end subroutine getsequencepos end module settings_xsecrot splash/src/pagecolours.f90000644 000770 000000 00000006643 11622211702 016405 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2010 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !---------------------------------------------------------- ! module handling page colour schemes, for generic ! plotting library !---------------------------------------------------------- module pagecolours implicit none integer, parameter :: maxpagecolours = 2 contains !---------------------------------------------------------- ! query function for the colour scheme !---------------------------------------------------------- function pagecolourscheme(ischeme,short) implicit none integer, intent(in) :: ischeme character(len=21) :: pagecolourscheme logical, intent(in), optional :: short logical :: use_short use_short = .false. if (present(short)) use_short = short select case(ischeme) case(2) pagecolourscheme = 'white-on-black' case(1) pagecolourscheme = 'black-on-white' case default if (use_short) then pagecolourscheme = 'default' else pagecolourscheme = 'plot library default' endif end select end function pagecolourscheme !---------------------------------------------------------- ! set the colour index 1 and 0 of the plotting library ! corresponding to the foreground and background colours ! (must be called after the plot library is initialised) !---------------------------------------------------------- subroutine set_pagecolours(ischeme) use plotlib, only:plot_scr implicit none integer, intent(in) :: ischeme select case(ischeme) case(2) !--white-on-black call plot_scr(0,0.,0.,0.) call plot_scr(1,1.,1.,1.) case(1) !--black-on-white call plot_scr(0,1.,1.,1.) call plot_scr(1,0.,0.,0.) end select end subroutine set_pagecolours !---------------------------------------------------------- ! query function for the name of the foreground colour !---------------------------------------------------------- function colour_fore(ischeme) implicit none integer, intent(in) :: ischeme character(len=5) :: colour_fore select case(ischeme) case(2) colour_fore = 'white' case(1) colour_fore = 'black' case default colour_fore = ' ' end select end function colour_fore !---------------------------------------------------------- ! query function for the name of the background colour !---------------------------------------------------------- function colour_back(ischeme) implicit none integer, intent(in) :: ischeme character(len=5) :: colour_back select case(ischeme) case(2) colour_back = 'black' case(1) colour_back = 'white' case default colour_back = ' ' end select end function colour_back end module pagecolours splash/src/parsetext.f90000644 000770 000000 00000015006 12332263315 016100 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! module containing routines to parse text strings containing ! variables. ! ! For example: ! %(t + 10) ! %(t*2) ! t = %t ! time = %t.5 ! specifying formatting to 5 sig-figs ! ! Uses the function parser module to evaluate the functions ! once extracted from the text. Functions that cannot be ! correctly evaluated are left intact in the text ! ! Dependencies: ! fparser module ! plot_numb from the plotting library !----------------------------------------------------------------- module parsetext use fparser, only:rn implicit none contains subroutine parse_text(string,vars,vals) use asciiutils, only:string_replace,string_sub,lcase character(len=*), intent(inout) :: string real(kind=rn), dimension(:), intent(in) :: vals character(len=*), dimension(:), intent(in) :: vars character(len=1) :: ch character(len=len(string)+128) :: newstring integer :: ia,iz,i0,i9,lenstr,npar,i,istart,iend,ndecimal,ierr,i1,i2 logical :: in_variable,parse real :: r integer, parameter :: ndecimal_default = 3 character(len=32) :: varstring ! !--look for strings of the form: ! ! %var ! %(var) ! %var.n ! %(var + 10).n ! %(var1*var2 + 10) ! %(var1*var2) ! ia = iachar('a') iz = iachar('z') i0 = iachar('0') i9 = iachar('9') lenstr = len(newstring) parse = .false. in_variable = .false. ! print*,'parsing ',trim(string) newstring = string npar = 0 ndecimal = ndecimal_default i1 = 0 i2 = 0 ! ! In the following we extract two substrings: ! ! string(istart:iend) is the string to replace, i.e. %(blah).5 ! string(i1:i2) is the variable/function to evaluate, i.e. blah ! i = 0 do while (i < lenstr) i = i + 1 ch = lcase(newstring(i:i)) select case(ch) case('%') in_variable = .true. if (i.gt.1) then if (newstring(i-1:i-1).eq.'\') in_variable = .false. endif if (in_variable) then istart = i iend = 0 i1 = i + 1 i2 = 0 endif case('(') if (in_variable) then npar = npar + 1 endif case(')') if (in_variable) then npar = max(npar - 1,0) if (i.ge.lenstr) then iend = i if (i2 < i1) i2 = iend parse = .true. elseif (npar.eq.0) then if (newstring(i+1:i+1).ne.'.') then iend = i if (i2 <= i1) i2 = iend parse = .true. endif endif endif case('.') if (in_variable .and. npar <= 0 .and. i < lenstr) then read(newstring(i+1:i+1),"(i1)",iostat=ierr) ndecimal if (ierr.ne.0) ndecimal = 3 iend = i+1 if (i2 < i1) i2 = i - 1 parse = .true. endif case default if ((.not.((iachar(ch) >= ia .and. iachar(ch) <= iz) & .or.(iachar(ch) >= i0 .and. iachar(ch) <= i9)) & .or. i.eq.lenstr) .and. npar <= 0) then if (in_variable) then if (i.eq.lenstr) then iend = i else iend = i - 1 endif if (i2 < i1) i2 = iend parse = .true. endif endif end select if (parse) then in_variable = .false. !print*,'variable = ',newstring(istart:iend), ', ndecimal = ',ndecimal !print*,'formula = ',newstring(i1:i2),i1,i2 r = parse_formula(newstring(i1:i2),vars,vals,ierr) if (ierr.eq.0) then !print*,' r = ',r,' ierr = ',ierr call get_varstring(r,ndecimal,varstring) !print*,'varstring: "',varstring,'"' call string_sub(newstring,istart,iend,trim(varstring)) endif i = i + (len_trim(varstring) - (iend - istart)) - 1 !print*,'newstring = ',newstring !(1:i),len_trim(varstring),iend-istart parse = .false. ndecimal = ndecimal_default endif enddo ! ! get rid of escape sequence on % ! call string_replace(newstring,'\%','%') ! ! replace original string (possibly truncated) ! string = trim(newstring) ! print*,' string: "',trim(newstring),'"' end subroutine parse_text !--------------------------------------------------------------------------- ! ! write the real number r to a string ! with ndec decimal places ! ! uses plot_numb to do the formatting ! !--------------------------------------------------------------------------- subroutine get_varstring(r,ndec,string) use plotlib, only:plot_numb real, intent(in) :: r integer, intent(in) :: ndec character(len=*), intent(out) :: string real :: rtmp integer :: mm,pp,nc if (abs(r) < tiny(r)) then string = '0' nc = 1 else rtmp = abs(r) mm = nint(r/10.**(int(log10(rtmp)-ndec))) pp = int(log10(rtmp) - ndec) call plot_numb(mm,pp,1,string,nc) endif end subroutine get_varstring !--------------------------------------------------------------------------- ! ! evaluate the variable or function via the function parser ! ! i.e. (t + 10) or (t*10) etc. ! ! OUTPUT: a real number ! ! unknown variables or un-parsable syntax return an error and a zero value ! !--------------------------------------------------------------------------- real function parse_formula(string,vars,vals,ierr) use fparser, only:initf,evalf,endf,checkf,parsef character(len=*), intent(in) :: string character(len=*), dimension(:), intent(in) :: vars real(kind=rn), dimension(:), intent(in) :: vals integer, intent(out) :: ierr call initf(1) ierr = checkf(string,vars,verbose=.false.) if (ierr.eq.0) then call parsef(1,string,vars) parse_formula = real(evalf(1,vals)) else parse_formula = 0. endif call endf end function parse_formula end module parsetext splash/src/particleplot.f90000644 000770 000000 00000061341 12376737667 016616 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module particleplots implicit none public :: particleplot,plot_errorbarsx,plot_errorbarsy public :: plot_kernel_gr contains ! ! Drives raw particle plots ! Handles different particle types, particle cross-sections, particle labelling ! fast-plotting added 12.10.06 (excludes particles in crowded fields) ! ! Arguments: ! ! subroutine particleplot(x,y,z,h,ntot,iplotx,iploty,icolourpart,iamtype,noftype,iplot_type, & use_zrange,zmin,zmax,labelz,xmin,xmax,ymin,ymax, & fast,datpix,nx,ny,dval,brightness) use params, only:int1 use labels, only:labeltype, maxparttypes,is_coord use settings_data, only:ndim,icoords,ntypes use settings_part, only:imarktype,ncircpart,icoordsnew,icircpart,itypeorder, & ilabelpart,iplotline,linestylethisstep,linecolourthisstep use interpolations2D, only:interpolate_part,interpolate_part1 use transforms, only:transform use part_utils, only:igettype use sort, only:indexx use plotlib, only:plot_qci,plot_bbuf,plot_ebuf,plot_sci,plot_sfs,plot_circ, & plot_pt,plot_numb,plot_text,plot_pt1,plot_qls,plot_sls, & plot_line,plot_qlw,plot_slw,plot_errb,plotlib_maxlinestyle implicit none integer, intent(in) :: ntot,iplotx, iploty integer(kind=int1), intent(in) :: iamtype(:) integer, intent(in) :: icolourpart(:) integer, intent(in) :: noftype(maxparttypes) real, intent(in) :: x(:), y(:), z(:), h(:) real, intent(in) :: zmin,zmax,xmin,xmax,ymin,ymax logical, intent(in) :: use_zrange,fast logical, intent(in) :: iplot_type(maxparttypes) character(len=*), intent(in) :: labelz integer, intent(in), optional :: nx,ny real, intent(inout), optional :: datpix(:,:),brightness(:,:) real, intent(in), optional :: dval integer :: j,n,itype,linewidth,icolourindex,nplotted,oldlinestyle,ierr integer :: lenstring,index1,index2,ntotplot,icolourstart,nlooptypes,ilooptype integer :: nplottedtype(maxparttypes) character(len=20) :: string integer, parameter :: ncellx = 500, ncelly = 500 ! for crowded field reduction integer(kind=int1) :: nincell(ncellx,ncelly,maxparttypes) integer :: icellx,icelly,maxz real :: dx1,dy1,dxpix logical :: mixedtypes real, allocatable :: xerrb(:), yerrb(:), herr(:) !--query current character height and colour call plot_qci(icolourstart) ! !--check for errors in input ! ntotplot = sum(noftype(1:ntypes)) if (ntot.lt.ntotplot) then print "(a)",' ERROR: number of particles input < number of each type ' print*,ntot,noftype(1:ntypes) return elseif (ntot.ne.ntotplot) then print "(a)",' WARNING: particleplot: total not equal to sum of types on input' print*,' ntotal = ',ntot,' sum of types = ',ntotplot endif maxz = size(z) if (maxz > ntot) maxz = ntot if (use_zrange .and. maxz.lt.ntot) then print "(a)",' WARNING: particleplot: slice plot but z array too small - excluding particles > z array size' endif dxpix = 0. if (present(datpix)) then if (.not.(present(nx).and.present(ny).and.present(dval))) then print "(a)",' INTERNAL ERROR in call to particleplot: optional args not present' return else dxpix = (xmax - xmin)/real(nx) endif endif ! !--loop over all particle types ! index1 = 1 nplottedtype = 0 nlooptypes = ntypes mixedtypes = size(iamtype).gt.1 if (mixedtypes .or. use_zrange) nlooptypes = 1 dx1 = (ncellx - 1)/(xmax-xmin + tiny(xmin)) dy1 = (ncelly - 1)/(ymax-ymin + tiny(ymin)) nincell = 0 over_types: do ilooptype=1,nlooptypes call plot_bbuf !--buffer plot output until each particle type finished if (mixedtypes .or. use_zrange) then index1 = 1 index2 = ntot itype = 0 else itype = itypeorder(ilooptype) if (itype.eq.1) then index1 = 1 else index1 = sum(noftype(1:itype-1))+1 endif index2 = index1 + noftype(itype) - 1 if (.not.iplot_type(itype)) then call plot_ebuf cycle over_types endif endif if (index2.gt.ntot) then index2 = ntot print "(a)",' WARNING: incomplete data' endif if (index2.lt.index1) then call plot_ebuf cycle over_types endif if (use_zrange) then ! !--if particle cross section, plot particles only in a defined (z) coordinate range ! nplotted = 0 overj: do j=1,ntot if (mixedtypes) then itype = min(max(int(iamtype(j)),1),maxparttypes) else itype = igettype(j,noftype) endif if (.not. iplot_type(itype)) cycle overj if (j.le.maxz) then if (z(j) > zmin .and. z(j) < zmax) then if (icolourpart(j).ge.0) then nplotted = nplotted + 1 nplottedtype(itype) = nplottedtype(itype) + 1 if (fast .and. noftype(itype) > 100) then if (in_cell(icellx,icelly,x(j),y(j),xmin,ymin,dx1,dy1,ncellx,ncelly)) then if (nincell(icellx,icelly,itype).eq.0) then nincell(icellx,icelly,itype) = nincell(icellx,icelly,itype) + 1_int1 ! this +1 of type int*1 call plot_sci(icolourpart(j)) call plot_particle(imarktype(itype),x(j),y(j),h(j)) endif endif else call plot_sci(icolourpart(j)) call plot_particle(imarktype(itype),x(j),y(j),h(j)) endif if (present(datpix)) then if (present(brightness)) then call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval,brightness) else call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval) endif endif endif !--plot circle of interaction if gas particle if (itype.eq.1 .and. ncircpart.gt.0 .and. ANY(icircpart(1:ncircpart).eq.j)) then call plot_circ(x(j),y(j),2*h(j)) endif !!--plot particle label if (ilabelpart) then call plot_numb(j,0,1,string,lenstring) call plot_text(x(j),y(j),string(1:lenstring)) endif endif endif enddo overj do itype=1,ntypes if (iplot_type(itype) .and. nplottedtype(itype).gt.0) then if (zmin < -0.1*huge(zmin)) then print*,'plotted ',nplottedtype(itype),' of ',noftype(itype), & trim(labeltype(itype))//' particles with ', trim(labelz),' < ',zmax else print*,'plotted ',nplottedtype(itype),' of ',noftype(itype), & trim(labeltype(itype))//' particles in range ', trim(labelz),' = ',zmin,' -> ',zmax endif endif enddo else ! !--otherwise plot all particles of this type using appropriate marker and colour ! call plot_qci(icolourindex) ! !--all particles in range have same colour and type ! if (.not.mixedtypes .and. all(icolourpart(index1:index2).eq.icolourpart(index1)) & .and. icolourpart(index1).ge.0) then call plot_sci(icolourpart(index1)) if (fast .and. (index2-index1).gt.100) then !--fast-plotting only allows one particle per "grid cell" - avoids crowded fields write(*,"(a,i8,1x,a)") ' fast-plotting ',index2-index1+1,trim(labeltype(itype))//' particles' nincell = 0 do j=index1,index2 if (in_cell(icellx,icelly,x(j),y(j),xmin,ymin,dx1,dy1,ncellx,ncelly)) then if (nincell(icellx,icelly,itype).eq.0) then nincell(icellx,icelly,itype) = nincell(icellx,icelly,itype) + 1_int1 ! this +1 of type int*1 call plot_particle(imarktype(itype),x(j),y(j),h(j)) if (present(datpix)) then if (present(brightness)) then call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval,brightness) else call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval) endif endif endif endif enddo else !--plot all particles of this type print "(a,i8,1x,a)",' plotting ',index2-index1+1,trim(labeltype(itype))//' particles' select case(imarktype(itype)) case(32:35) do j=1,noftype(itype) call plot_particle(imarktype(itype),x(j),y(j),h(j)) enddo call plot_sfs(1) case default call plot_pt(noftype(itype),x(index1:index2),y(index1:index2),imarktype(itype)) end select if (present(datpix)) then if (present(brightness)) then call interpolate_part(x(index1:index2),y(index1:index2),h(index1:index2), & noftype(itype),xmin,ymin,datpix,nx,ny,dxpix,dval,brightness) else call interpolate_part(x(index1:index2),y(index1:index2),h(index1:index2), & noftype(itype),xmin,ymin,datpix,nx,ny,dxpix,dval) endif endif endif else ! !--mixed colours and/or mixed types ! nplotted = 0 nplottedtype = 0 overj2: do j=index1,index2 if (icolourpart(j).ge.0) then if (mixedtypes) then itype = int(iamtype(j)) if (.not.iplot_type(itype)) cycle overj2 nplottedtype(itype) = nplottedtype(itype) + 1 endif nplotted = nplotted + 1 if (fast .and. noftype(itype) > 100) then if (in_cell(icellx,icelly,x(j),y(j),xmin,ymin,dx1,dy1,ncellx,ncelly)) then !--exclude particles if there are more than 2 particles per cell ! (two here because particles can have different colours) if (nincell(icellx,icelly,itype).le.0) then nincell(icellx,icelly,itype) = nincell(icellx,icelly,itype) + 1_int1 ! this +1 of type int*1 call plot_sci(icolourpart(j)) call plot_particle(imarktype(itype),x(j),y(j),h(j)) if (present(datpix)) then if (present(brightness)) then call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval,brightness) else call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval) endif endif endif endif else call plot_sci(icolourpart(j)) call plot_particle(imarktype(itype),x(j),y(j),h(j)) if (present(datpix)) then if (present(brightness)) then call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval,brightness) else call interpolate_part1(x(j),y(j),h(j),xmin,ymin,datpix,nx,ny,dxpix,dval) endif endif endif endif enddo overj2 if (mixedtypes) then do itype=1,ntypes if (iplot_type(itype)) then if (fast .and. noftype(itype).gt.100) then print*,' fast-plotted ',nplottedtype(itype),' of ',noftype(itype),trim(labeltype(itype))//' particles' elseif (noftype(itype).gt.0) then print*,' plotted ',nplottedtype(itype),' of ',noftype(itype),trim(labeltype(itype))//' particles' endif endif enddo else if (fast .and. noftype(itype).gt.100) then print*,' fast-plotted ',nplotted,' of ',index2-index1+1,trim(labeltype(itype))//' particles' else print*,' plotted ',nplotted,' of ',index2-index1+1,trim(labeltype(itype))//' particles' endif endif endif call plot_sci(icolourindex) if (ilabelpart) then !!--plot particle labels print*,'plotting particle labels ',index1,':',index2 do j=index1,index2 call plot_numb(j,0,1,string,lenstring) call plot_text(x(j),y(j),string(1:lenstring)) enddo endif endif index1 = index2 + 1 call plot_ebuf !--flush PGPLOT buffer at end of each type enddo over_types ! !--plot lines joining particles if relevant ! call plot_qci(icolourindex) call plot_sci(linecolourthisstep) ! i.e., don't plot a line for cross section plots (would plot all particles) ! but do if there is 3D perspective --> in which case zmin = -huge(x) if (iplotline .and. .not.(use_zrange .and. abs(zmax-zmin).lt.0.5*huge(0.))) then call plot_qls(oldlinestyle) call plot_sls(linestylethisstep) call plot_line(noftype(1),x(1:noftype(1)),y(1:noftype(1))) if (noftype(2).gt.0 .and. iplot_type(2)) then call plot_sls(mod(linestylethisstep+1,plotlib_maxlinestyle) + 1) call plot_line(noftype(2),x(noftype(1)+1:sum(noftype(1:2))),y(noftype(1)+1:sum(noftype(1:2)))) endif call plot_sls(oldlinestyle)! reset endif call plot_sci(icolourindex) ! !--plot circles of interaction (ie a circle of radius 2h) ! around all or selected particles. For plots with only one coordinate axis, ! these are plotted as error bars in the coordinate direction. ! !--this bit is also used for error bar plotting on x or y axis. ! if (ncircpart.gt.0) then ! !--set fill area style and line width ! call plot_qlw(linewidth) call plot_slw(2) call plot_qci(icolourindex) call plot_sci(2) call plot_sfs(2) if (ncircpart.gt.0) then if (is_coord(iplotx,ndim) .and. is_coord(iploty,ndim) .and. ncircpart.gt.0) then print*,'plotting ',ncircpart,' circles of interaction' do n = 1,ncircpart if (icircpart(n).gt.ntot) then print*,'error: particle index > number of particles' else if (icoordsnew.ne.icoords) then call plot_kernel_gr(icoordsnew,icoords,x(icircpart(n)),y(icircpart(n)),2*h(icircpart(n))) else call plot_circ(x(icircpart(n)),y(icircpart(n)),2*h(icircpart(n))) endif endif enddo else if (.not.allocated(herr)) then allocate(xerrb(ncircpart),yerrb(ncircpart),herr(ncircpart),stat=ierr) if (ierr /= 0) & stop ' Error allocating memory in particleplot for circles of interaction' endif !!--only on specified particles do n=1,ncircpart if (icircpart(n).gt.ntot) then print*,'error: particle index > number of particles' xerrb(n) = 0. yerrb(n) = 0. herr(n) = 0. else xerrb(n) = x(icircpart(n)) yerrb(n) = y(icircpart(n)) herr(n) = 2.*h(icircpart(n)) endif enddo if (is_coord(iplotx,ndim)) then print*,'plotting ',ncircpart,' error bars x axis ' call plot_errb(5,ncircpart,xerrb(1:ncircpart),yerrb(1:ncircpart),herr(1:ncircpart),1.0) elseif (is_coord(iploty,ndim)) then print*,'plotting ',ncircpart,' error bars y axis' call plot_errb(6,ncircpart,xerrb(1:ncircpart),yerrb(1:ncircpart),herr(1:ncircpart),1.0) endif if (allocated(herr)) deallocate(herr) if (allocated(xerrb)) deallocate(xerrb) if (allocated(yerrb)) deallocate(yerrb) endif endif call plot_slw(linewidth) call plot_sci(icolourindex) endif ! !--reset colour ! call plot_sci(icolourstart) return end subroutine particleplot !-------------------------------------------------------------------------------- ! ! subroutine implementing scalable markers ! default case is just an interface to usual particle plotting routine ! !-------------------------------------------------------------------------------- subroutine plot_particle(imarktype,x,y,h) use plotlib, only:plot_circ,plot_sfs,plot_sci,plot_pt1 use settings_part, only:hfacmarkers implicit none integer, intent(in) :: imarktype real, intent(in) :: x,y,h integer :: imarker real :: size select case(imarktype) case(32:35) imarker = imarktype - 31 size = hfacmarkers*h if (imarker.le.2) then call plot_sfs(imarker) call plot_circ(x,y,size) call plot_sfs(1) elseif (imarker.eq.3) then call plot_sfs(1) call plot_circ(x,y,size) call plot_sfs(2) call plot_sci(0) call plot_circ(x,y,size) call plot_sfs(1) elseif (imarker.eq.4) then call plot_sfs(1) call plot_circ(x,y,size) call plot_sfs(2) call plot_sci(1) call plot_circ(x,y,size) call plot_sfs(1) else call plot_circ(x,y,size) endif case default call plot_pt1(x,y,imarktype) end select end subroutine plot_particle !------------------------------------------------------------ ! ! function used to determine which cell a particle lies in ! returns TRUE if within allowed limits, FALSE if not ! !------------------------------------------------------------ logical function in_cell(ix,iy,x,y,xmin,ymin,dx1,dy1,nx,ny) integer, intent(out) :: ix,iy real, intent(in) :: x,y,xmin,ymin,dx1,dy1 integer, intent(in) :: nx,ny ix = int((x - xmin)*dx1) + 1 iy = int((y - ymin)*dy1) + 1 !--exclude particles if there are more than 2 particles per cell ! (two here because particles can have different colours) in_cell = (ix.gt.0 .and. ix.le.nx .and. iy.gt.0 .and. iy.le.ny) end function in_cell !-------------------------------------------------------------------------------- ! ! subroutine to plot the circle of interaction for a given particle ! in general coordinate systems (e.g. cylindrical coordinates) ! ! input: igeom : coordinate system (0,1=cartesian, 2=cylindrical, 3=spherical) ! x,y : particle location in cartesian space ! h : size of smoothing sphere ! (assumed isotropic in coordinate space) ! ! PGPLOT page must already be set up - this just draws the "circle" ! !-------------------------------------------------------------------------------- subroutine plot_kernel_gr(igeom,igeomold,x,y,h) use geometry, only:coord_transform,maxcoordsys,labelcoordsys use plotlib, only:plot_line implicit none integer, intent(in) :: igeom, igeomold real, intent(in) :: x,y,h integer, parameter :: npts = 100 ! big enough to give a smooth circle real, parameter :: pi = 3.1415926536 integer :: i real, dimension(2) :: xtemp real, dimension(2,npts) :: xpts real :: angle, dangle, xi, yi if (igeom.gt.1 .and. igeom.le.maxcoordsys) then print 10,labelcoordsys(igeom) else print 10,labelcoordsys(1) endif 10 format('coordinate system = ',a) xtemp(1) = x xtemp(2) = y !--e.g. from cylindricals TO cartesians call coord_transform(xtemp,2,igeom,xpts(:,1),2,igeomold) xi = xpts(1,1) yi = xpts(2,1) ! !--step around a circle in co-ordinate space of radius h and store the ! location of the points in cartesian space in the 2D array xpts ! dangle = 2.*pi/REAL(npts-1) do i=1,npts angle = (i-1)*dangle xtemp(1) = xi + h*COS(angle) xtemp(2) = yi + h*SIN(angle) ! !--translate back to actual coordinate system plotted ! call coord_transform(xtemp,2,igeomold,xpts(:,i),2,igeom) enddo ! !--now plot the circle using pgline ! call plot_line(npts,xpts(1,:),xpts(2,:)) return end subroutine plot_kernel_gr !-------------------------------------------------------------------------------- ! ! Plot y-axis error bars, handling the case where the axes are transformed ! ! input x,y are in transformed space (i.e., already logged) ! input err is not transformed, (i.e., not logged) ! !-------------------------------------------------------------------------------- subroutine plot_errorbarsy(npts,x,y,err,itrans) use plotlib, only:plot_bbuf,plot_ebuf,plot_err1,plot_errb use transforms, only:transform,transform_inverse,islogged use settings_part, only:ErrorBarType use settings_data, only:iverbose implicit none integer, intent(in) :: npts,itrans real, intent(in), dimension(:) :: x,y,err real :: yval,errval real, dimension(2) :: val real, dimension(npts) :: errp,errm integer :: i if (iverbose >= 1) then if (npts < 10000) then print "(a,i4,a)",' plotting ',npts,' error bars y axis' else print "(a,i10,a)",' plotting ',npts,' error bars y axis' endif endif if (itrans.ne.0) then if (islogged(itrans)) then errval = 0. !-300. else errval = 0. endif !call plot_bbuf do i=1,npts yval = y(i) call transform_inverse(yval,itrans) val(1) = yval + err(i) val(2) = yval - err(i) call transform(val,itrans,errval=errval) errp(i) = val(1) - y(i) errm(i) = y(i) - val(2) val(1) = val(1) - y(i) val(2) = y(i) - val(2) if (ErrorBarType /= 1) then call plot_err1(2,x(i),y(i),val(1),1.0) call plot_err1(4,x(i),y(i),val(2),1.0) endif enddo if (ErrorBarType==1) then call plot_errb(7,npts,x,y,errp,1.0) call plot_errb(8,npts,x,y,errm,1.0) endif !call plot_ebuf else if (ErrorBarType==1) then call plot_errb(9,npts,x,y,err,1.0) else call plot_errb(6,npts,x,y,err,1.0) endif endif end subroutine plot_errorbarsy !-------------------------------------------------------------------------------- ! ! Plot x-axis error bars, handling the case where the axes are transformed ! ! input x,y are in transformed space (i.e., already logged) ! input err is not transformed, (i.e., not logged) ! !-------------------------------------------------------------------------------- subroutine plot_errorbarsx(npts,x,y,err,itrans) use transforms, only:transform,transform_inverse,islogged use plotlib, only:plot_bbuf,plot_ebuf,plot_err1,plot_errb implicit none integer, intent(in) :: npts,itrans real, intent(in), dimension(:) :: x,y,err real :: xval,errval real, dimension(2) :: val integer :: i print*,'plotting ',npts,' error bars x axis ' if (itrans.ne.0) then if (islogged(itrans)) then errval = -300. else errval = 0. endif call plot_bbuf do i=1,npts xval = x(i) call transform_inverse(xval,itrans) val(1) = xval + err(i) val(2) = xval - err(i) call transform(val,itrans,errval=errval) val(1) = val(1) - x(i) val(2) = x(i) - val(2) call plot_err1(1,x(i),y(i),val(1),1.0) call plot_err1(3,x(i),y(i),val(2),1.0) enddo call plot_ebuf else call plot_errb(5,npts,x,y,err,1.0) endif end subroutine plot_errorbarsx end module particleplots splash/src/partutils.f90000644 000770 000000 00000015131 12307565255 016121 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------- ! ! utility routines to do with particle identification ! !----------------------------------------------------------- module part_utils use params, only:int1 implicit none public :: igettype,get_tracked_particle public :: locate_nth_particle_of_type public :: locate_first_two_of_type public :: get_binary private contains !--------------------------------------------- ! utility returning the type of particle i ! when particles are ordered by type !--------------------------------------------- pure integer function igettype(i,noftype) use params, only:maxparttypes integer, intent(in) :: i integer, dimension(maxparttypes), intent(in) :: noftype integer :: ntot,ntot1,jtype ntot = 0 igettype = 1 ! so even if in error, will not lead to seg fault over_types: do jtype=1,maxparttypes ntot1 = ntot + noftype(jtype) if (i.gt.ntot .and. i.le.ntot1) then igettype = jtype exit over_types endif ntot = ntot1 enddo over_types end function igettype !------------------------------------------------------------------- ! routine to find which particle is being tracked, when it is ! given in the form of type:offset !------------------------------------------------------------------- integer function get_tracked_particle(itype,ioffset,noftype,iamtype) integer, intent(in) :: itype,ioffset integer, dimension(:), intent(in) :: noftype integer(kind=int1), dimension(:), intent(in) :: iamtype integer :: ntot if (itype.le.0 .or. itype.gt.size(noftype)) then !--type not set, itrackpart = itrackoffset get_tracked_particle = ioffset else !--want to select nth particle of a particular type call locate_nth_particle_of_type(ioffset,get_tracked_particle, & itype,iamtype,noftype,ntot) endif end function get_tracked_particle !------------------------------------------------------------------- ! routine to locate first two particles of a given type in the data !------------------------------------------------------------------- subroutine locate_first_two_of_type(i1,i2,itype,iamtype,noftype,ntot) integer, intent(out) :: i1,i2,ntot integer, intent(in) :: itype integer(kind=int1), dimension(:), intent(in) :: iamtype integer, dimension(:), intent(in) :: noftype integer :: i,nfound !--locate first two sink particles in the data ntot = sum(noftype) if (size(iamtype(:)).eq.1) then i1 = sum(noftype(1:itype-1)) + 1 i2 = i1 + 1 else i1 = 0 i2 = 0 i = 0 nfound = 0 do while ((i1.eq.0 .or. i2.eq.0) .and. i.le.ntot) i = i + 1 if (iamtype(i).eq.itype) nfound = nfound + 1 if (nfound.eq.1) i1 = i if (nfound.eq.2) i2 = i enddo endif end subroutine locate_first_two_of_type !------------------------------------------------------------- ! routine to locate nth particle of a given type in the data !------------------------------------------------------------- pure subroutine locate_nth_particle_of_type(n,ipos,itype,iamtype,noftype,ntot) integer, intent(out) :: ipos,ntot integer, intent(in) :: n,itype integer(kind=int1), dimension(:), intent(in) :: iamtype integer, dimension(:), intent(in) :: noftype integer :: i,nfound ntot = sum(noftype) if (size(iamtype(:)).eq.1) then ipos = sum(noftype(1:itype-1)) + n else ipos = 0 i = 0 nfound = 0 do while (ipos.eq.0 .and. i.le.ntot) i = i + 1 if (iamtype(i).eq.itype) nfound = nfound + 1 if (nfound.eq.n) ipos = i enddo endif end subroutine locate_nth_particle_of_type !---------------------------------------------------------- ! routine to get properties of particle binary system ! INPUT: ! i1, i2 : indexes of two particles to use ! dat(npart,ncolumns) : particle data ! ix(ndim) : columns containing positions ! ivx : column of first velocity component ! ipmass : column containing mass ! OUTPUT: ! x0 : centre of mass position ! v0 : velocity of centre of mass ! angle : angle of binary about centre of mass (radians) !---------------------------------------------------------- subroutine get_binary(i1,i2,dat,x0,v0,angle,ndim,ndimV,ncolumns,ix,ivx,ipmass,iverbose,ierr) integer, intent(in) :: i1,i2,ndim,ndimV,ncolumns,ivx,ipmass,iverbose integer, dimension(ndim), intent(in) :: ix real, dimension(:,:), intent(in) :: dat real, dimension(ndim), intent(out) :: x0,v0 real, intent(out) :: angle integer, intent(out) :: ierr integer :: max real, dimension(ndim) :: x1,x2,v1,v2,dx real :: m1,m2,dmtot ierr = 0 max = size(dat(:,1)) if (i1 <= 0 .or. i2 <= 0 .or. i1 > max .or. i2 > max) then if (iverbose >= 2) print*,' star 1 = ',i1,' star 2 = ',i2 print "(a)",' ERROR locating sink particles in the data' ierr = 1 return endif x1 = 0. x2 = 0. x1(1:ndim) = dat(i1,ix(1:ndim)) x2(1:ndim) = dat(i2,ix(1:ndim)) !--get centre of mass if (ipmass > 0 .and. ipmass <= ncolumns) then m1 = dat(i1,ipmass) m2 = dat(i2,ipmass) else m1 = 1. m2 = 1. endif dmtot = 1./(m1 + m2) x0 = (m1*x1 + m2*x2)*dmtot if (iverbose >= 1) then print "(a,3(1x,es10.3),a,es10.3)",' :: star 1 pos =',x1(1:ndim),' m = ',m1 print "(a,3(1x,es10.3),a,es10.3)",' :: star 2 pos =',x2(1:ndim),' m = ',m2 print "(a,3(1x,es10.3))",' :: c. of mass =',x0(1:ndim) endif !--work out angle needed to rotate into corotating frame dx = x0 - x1 angle = -atan2(dx(2),dx(1)) !--get velocities if (ivx > 0 .and. ivx + ndimV <= ncolumns) then v1 = dat(i1,ivx:ivx+ndimV-1) v2 = dat(i2,ivx:ivx+ndimV-1) v0 = (m1*v1 + m2*v2)*dmtot if (iverbose >= 1) print "(a,3(1x,es10.3))",' :: vel c of m =',v0(1:ndimV) else v0 = 0. endif end subroutine get_binary end module part_utils splash/src/pdfs.f90000644 000770 000000 00000021037 11622211702 015010 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !---------------------------------------------------------------- ! ! module for probability density function calculation ! and/or plotting on the particles ! !---------------------------------------------------------------- module pdfs implicit none public :: pdf_calc,pdf_write,mean_variance contains !----------------------------------------------------------------- ! ! subroutine bins particles into x, works out number in each bin, ! calculates normalisation for PDF. ! !----------------------------------------------------------------- subroutine pdf_calc(npart,xpart,xminplot,xmaxplot,nbins,xbin,pdf,pdfmin,pdfmax,& usefixedbins,volweighted,ierr,icolours,rhopart,pmass) !use transforms, only:transform,transform_inverse,transform_limits,convert_to_ln_fac implicit none integer, intent(in) :: npart,nbins real, dimension(:), intent(in) :: xpart real, intent(in) :: xminplot,xmaxplot real, intent(out), dimension(nbins) :: xbin,pdf real, intent(out) :: pdfmin,pdfmax ! integer, intent(in) :: itransx logical, intent(in) :: usefixedbins logical, intent(out) :: volweighted integer, intent(out) :: ierr integer, intent(in), dimension(:), optional :: icolours real, intent(in), dimension(:), optional :: rhopart,pmass integer :: ibin,i real :: dx,totprob,fi!,xbinprev !xbini,dxprev real :: xmin,xmax,xminpart,xmaxpart,weighti,totvol logical :: use_part ierr = 0 volweighted = .false. if (present(rhopart) .and. present(pmass)) then print "(a,i3,a)",' calculating (volume weighted) PDF using ',nbins,' bins' volweighted = .true. else print "(a,i3,a)",' calculating (mass weighted) PDF using ',nbins,' bins' endif ! !--set bins in PDF: must always use all the particles ! note that xpart will already have been transformed ! so these are min and max in transformed space ! xminpart = minval(xpart(1:npart)) xmaxpart = maxval(xpart(1:npart)) if (usefixedbins) then xmin = xminplot xmax = xmaxplot print "(a,1pe10.3,a,1pe10.3)",' PDF bins are fixed between the current x limits, min = ',xminplot,' max = ',xmaxplot if (xminpart.lt.xmin) print "(a)",' WARNING: particles fall outside of (fixed) bin range, will pile up on first bin' if (xmaxpart.gt.xmax) print "(a)",' WARNING: particles fall outside of (fixed) bin range, will pile up on last bin' dx = (xmax - xmin)/real(nbins) print "(a,1pe10.3)",' bin width = ',dx do ibin=1,nbins xbin(ibin) = xmin + (ibin-1)*dx enddo else xmin = xminpart xmax = xmaxpart dx = (xmax - xmin)/real(nbins-1) print "(a,1pe10.3)",' bin width = ',dx do ibin=1,nbins xbin(ibin) = xmin + (ibin-0.5)*dx enddo endif ! !--now calculate probability of finding a particle at each x ! pdf(:) = 0. totvol = 0. do i=1,npart if (present(icolours)) then use_part = (icolours(i).ge.0) else use_part = .true. endif !--do not use hidden particles if (use_part) then ibin = int((xpart(i) - xmin)/dx) + 1 if (ibin.lt.1) ibin = 1 if (ibin.gt.nbins) ibin = nbins if (volweighted) then if (rhopart(i).gt.0.) then weighti = pmass(i)/rhopart(i) else weighti = 0. endif else weighti = 1. endif totvol = totvol + weighti !!--take the PDF of ln(x) if quantity is logged !if (itransx.gt.0) then ! weighti = weighti*convert_to_ln_fac(itransx) !endif pdf(ibin) = pdf(ibin) + weighti endif enddo print*,' sum of weights = ',totvol ! !--get total area under pdf by trapezoidal rule ! totprob = 0. do ibin=1,nbins fi = pdf(ibin) totprob = totprob + dx*fi !!0.5*dx*(fi + fprev) enddo ! !--normalise pdf so total area is unity ! print*,'normalisation factor = ',totprob,totvol*dx ! =npart*dx for mass-weighted, totvol*dx for volume weighted !totprob = totvol*dx !totprob = dx if (totprob.le.0.) then ierr = 1 print "(a)",' error in normalisation factor: returning non-normalised PDF' else pdf(1:nbins) = pdf(1:nbins)/totprob !call pdf_write(nbins,xbin,pdf,labelx,itransx,volweighted) ! !--return min and max for adaptive plot limit setting ! (exclude zero as min) ! pdfmin = minval(pdf(1:nbins),mask=(pdf(1:nbins).gt.0.)) pdfmax = maxval(pdf(1:nbins)) endif end subroutine pdf_calc !----------------------------------------------------------------- ! interface which controls plotting of PDF ! (so can easily change properties of PDF plotting, ! e.g. histogram vs. line) !----------------------------------------------------------------- !subroutine pdf_plot(nbins,xbin,pb) ! use plotutils, only:plotline !,plotbins ! implicit none ! integer, intent(in) :: nbins ! real, dimension(:), intent(in) :: xbin,pb ! !--plot as line segment, with blanking at zero ! ! call plotline(nbins,xbin,pb,blank=0.) ! !--plot as histogram, with blanking of zero ! ! call plotbins(nbins,xbin,pb,blank=0.) !end subroutine pdf_plot !----------------------------------------------------------------- ! routine to write pdf to file !----------------------------------------------------------------- subroutine pdf_write(nbins,xbin,pb,labelx,volweighted,rootname,tagline) use asciiutils, only:safename implicit none character(len=*), intent(in) :: labelx,rootname,tagline integer, intent(in) :: nbins !,itransx real, intent(in), dimension(nbins) :: xbin,pb logical, intent(in) :: volweighted integer :: i,ierr integer, parameter :: iunit = 86 logical :: warned print "(a)",' writing to '//trim(rootname)//'_pdf_'//trim(safename(labelx))//'.dat' open(unit=iunit,file=trim(rootname)//'_pdf_'//trim(safename(labelx))//'.dat', & form='formatted',status='replace',iostat=ierr) if (ierr /= 0) then print "(a)",'ERROR: could not open file: no output' return endif if (volweighted) then write(iunit,"(a)",iostat=ierr) '# volume weighted PDF, calculated using '//trim(tagline) else write(iunit,"(a)",iostat=ierr) '# density weighted PDF, calculated using '//trim(tagline) endif if (ierr /= 0) print "(a)",' ERROR writing header line' write(iunit,"(a,i5,a)",iostat=ierr) '# ',nbins,' bins evenly spaced in '//trim(labelx) warned = .false. !--dump bins to file do i=1,nbins write(iunit,*,iostat=ierr) xbin(i),pb(i) if (ierr /= 0 .and. .not.warned) then print "(a)",' ERRORS during write' warned = .true. endif enddo close(iunit) return end subroutine pdf_write !------------------------------------------------- ! Subroutine to calculate the mean and variance ! of a set of data points ! Mean is trivial but variance uses a special ! formula to reduce round-off error ! see Press et al Numerical Recipes, section 14.2 ! this is similar to their subroutine avevar !------------------------------------------------- subroutine mean_variance(x,npts,xmean,xvariance) implicit none integer, intent(in) :: npts real, intent(in), dimension(npts) :: x real, intent(out) :: xmean, xvariance real :: roundoff, delta integer :: i ! !--calculate average ! xmean = 0. do i=1,npts xmean = xmean + x(i) enddo xmean = xmean/real(npts) ! !--calculate variance using the corrected two-pass formula ! ! var = 1/(n-1)*( sum (x-\bar{x}) - 1/n * (sum(x-\bar{x}) )^2 ) ! ! where the last term corrects for the roundoff error ! in the first term ! xvariance = 0. roundoff = 0. do i=1,npts delta = x(i) - xmean roundoff = roundoff + delta xvariance = xvariance + delta*delta enddo xvariance = (xvariance - roundoff**2/npts)/real(npts-1) return end subroutine mean_variance end module pdfs splash/src/plotlib_giza.f90000644 000770 000000 00000037755 12430517362 016562 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !--------------------------------------------------------------------------- ! The plotlib module in SPLASH provides a consistent API so that SPLASH ! can be compiled against different graphics libraries as the backend ! ! This version provides an interface to giza, a plotting ! library written by Daniel Price & James Wetter. ! ! Giza implements basic 2D plotting functionality ! on top of the cairo graphics library ! ! Interface written by James Wetter and Daniel Price (2010) !--------------------------------------------------------------------------- module plotlib use giza, only: & plot_arro=>giza_arrow, & plot_annotate=>giza_annotate, & plot_band=>giza_band, & plot_bbuf=>giza_begin_buffer,& plot_box=>giza_box, & plot_circ=>giza_circle, & plot_close=>giza_close_device, & plot_curs=>giza_get_key_press, & plot_ebuf=>giza_end_buffer, & plot_end=>giza_close_device, & plot_env=>giza_set_environment, & plot_errb=>giza_error_bars, & plot_funx=>giza_function_x, & plot_label=>giza_label, & plot_line=>giza_line, & plot_lcur=>giza_mark_line, & plot_olin=>giza_mark_points, & plot_ncur=>giza_mark_points_ordered, & plot_page=>giza_change_page, & plot_poly=>giza_polygon, & plot_pt1=>giza_single_point, & plot_pt=>giza_points, & plot_ptxt=>giza_ptext, & plot_qch=>giza_get_character_height, & plot_qci=>giza_get_colour_index, & plot_qcir=>giza_get_colour_index_range, & plot_qcr=>giza_get_colour_representation, & plot_qfs=>giza_get_fill, & plot_qlw=>giza_get_line_width,& plot_qls=>giza_get_line_style,& plot_qlc=>giza_get_line_cap, & plot_qtxt=>giza_qtext, & plot_qwin=>giza_get_window, & plot_rect=>giza_rectangle, & plot_sah=>giza_set_arrow_style, & plot_scf=>giza_set_font, & plot_sch=>giza_set_character_height, & plot_sci=>giza_set_colour_index, & plot_scir=>giza_set_colour_index_range, & plot_scr=>giza_set_colour_representation, & plot_sfs=>giza_set_fill, & plot_slc=>giza_set_line_cap, & plot_sls=>giza_set_line_style,& plot_slw=>giza_set_line_width, & plot_stbg=>giza_set_text_background, & plot_svp=>giza_set_viewport, & plot_swin=>giza_set_window, & plot_text=>giza_text, & plot_wnad=>giza_set_window_equal_scale, & plot_qcur=>giza_device_has_cursor, & plot_rgb_from_table=>giza_rgb_from_table, & giza_contour, & giza_get_character_size, & giza_get_surface_size, & giza_get_viewport, & giza_open_device, & giza_open_device_size, & giza_render, & giza_render_gray, & giza_render_transparent, & giza_set_colour_table, & giza_stop_prompting, & giza_start_prompting, & plot_left_click=>giza_left_click_f, & plot_right_click=>giza_right_click_f, & plot_middle_click=>giza_middle_click_f, & plot_shift_click=>giza_shift_click_f, & plot_scroll_up=>giza_scroll_up_f, & plot_scroll_down=>giza_scroll_down_f, & plot_scroll_left=>giza_scroll_left_f, & plot_scroll_right=>giza_scroll_right_f, & giza_vector, & giza_format_number, & giza_query_device, & giza_draw_pixels, & giza_colour_index_min,& giza_colour_index_max,& giza_extend_pad,& giza_extend_repeat, & giza_extend_reflect, & giza_extend_none implicit none logical, parameter :: plotlib_is_pgplot = .false. logical, parameter :: plotlib_supports_alpha = .true. integer, parameter :: plotlib_maxlinestyle = 6 integer, parameter :: plotlib_maxfillstyle = 5 integer, parameter :: plotlib_maxlinecolour = 16 integer, parameter :: plotlib_extend_pad = giza_extend_pad integer, parameter :: plotlib_extend_repeat = giza_extend_repeat integer, parameter :: plotlib_extend_reflect = giza_extend_reflect integer, parameter :: plotlib_extend_none = giza_extend_none public contains !--------------------------------------------- ! initialise the plotting library !--------------------------------------------- subroutine plot_init(devicein, ierr, papersizex, aspectratio, paperunits) use giza, only:giza_units_inches,giza_units_pixels,giza_units_mm implicit none character(len=*),intent(in) :: devicein integer,intent(out) :: ierr real, intent(in), optional :: papersizex,aspectratio integer, intent(in), optional :: paperunits real :: width,height integer :: units, id if (present(papersizex)) then width = papersizex if (present(aspectratio)) then height = width*aspectratio else height = width/sqrt(2.) endif if (present(paperunits)) then select case(paperunits) case(0) units = giza_units_pixels case(1) units = giza_units_inches case(2) units = giza_units_mm width = 0.1*width height = 0.1*height end select else units = giza_units_inches endif id = giza_open_device_size(devicein, 'splash', width, height, units) else id = giza_open_device(devicein,'splash') endif ! id<0 should return an error, but +ve id is OK select case(id) case(:-1) ierr = id case default ierr = 0 end select if(ierr.eq.0) then call giza_stop_prompting endif end subroutine plot_init subroutine plot_gray(a, idim, jdim, i1, i2, j1, j2, a1, a2, tr, iextend) integer,intent(in) :: IDIM, JDIM, I1, I2, J1, J2 real,intent(in) :: A(IDIM,JDIM), A1, A2, TR(6) real :: affine(6) integer, intent(in), optional :: iextend call convert_tr_to_affine(tr,affine) if (present(iextend)) then call giza_render_gray(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,a1,a2,iextend,affine) else call giza_render_gray(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,a1,a2,0,affine) endif end subroutine plot_gray subroutine plot_imag(a, idim, jdim, i1, i2, j1, j2, a1, a2, tr, iextend) integer,intent(in) :: IDIM, JDIM, I1, I2, J1, J2 real,intent(in) :: A(IDIM,JDIM), A1, A2, TR(6) real :: affine(6) integer, intent(in), optional :: iextend call convert_tr_to_affine(tr,affine) if (present(iextend)) then call giza_render(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,a1,a2,iextend,affine) else call giza_render(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,a1,a2,0,affine) endif end subroutine plot_imag subroutine plot_imag_alpha(dat, alpha, idim, jdim, i1, i2, j1, j2, a1, a2, tr, iextend) integer,intent(in) :: IDIM, JDIM, I1, I2, J1, J2 real,intent(in) :: dat(IDIM,JDIM), alpha(IDIM,JDIM), A1, A2, TR(6) real :: affine(6) integer, intent(in), optional :: iextend call convert_tr_to_affine(tr,affine) if (present(iextend)) then call giza_render(idim,jdim,dat,alpha,i1-1,i2-1,j1-1,j2-1,a1,a2,iextend,affine) else call giza_render(idim,jdim,dat,alpha,i1-1,i2-1,j1-1,j2-1,a1,a2,0,affine) endif end subroutine plot_imag_alpha subroutine plot_imag_transparent(a, idim, jdim, i1, i2, j1, j2, a1, a2, tr) integer,intent(in) :: IDIM, JDIM, I1, I2, J1, J2 real,intent(in) :: A(IDIM,JDIM), A1, A2, TR(6) real :: affine(6) call convert_tr_to_affine(tr,affine) call giza_render_transparent(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,a1,a2,0,affine) end subroutine plot_imag_transparent subroutine plot_ctab(l,r,g,b,nc,contra,bright) implicit none integer,intent(in) :: nc real,intent(in) :: l(nc),r(nc),g(nc),b(nc),contra,bright call giza_set_colour_table(l,r,g,b,nc,contra,bright) end subroutine plot_ctab subroutine plot_qvsz(units,x1,x2,y1,y2) use giza, only:giza_get_paper_size,giza_units_device implicit none real, intent(out) :: x1,x2,y1,y2 integer, intent(in) :: units x1 = 0. y1 = 0. call giza_get_paper_size(units,x2,y2) end subroutine plot_qvsz subroutine plot_bins(nbin,x,data,centre) integer, intent(in) :: nbin real, dimension(nbin), intent(in) :: x, data logical, intent(in) :: centre print*,' WARNING: plot_bins not implemented in giza' end subroutine plot_bins subroutine plot_qvp(units, x1, x2, y1, y2) implicit none integer,intent(in) :: units real,intent(out) :: x1, x2, y1, y2 call giza_get_viewport(units_giza(units),x1,x2,y1,y2) end subroutine plot_qvp subroutine plot_qcs(units,xch,ych) implicit none integer,intent(in) :: units real,intent(out) :: xch,ych call giza_get_character_size(units_giza(units),xch,ych) end subroutine plot_qcs subroutine plot_qcol(icolmin,icolmax) integer,intent(out) :: icolmin,icolmax icolmin = giza_colour_index_min icolmax = giza_colour_index_max end subroutine plot_qcol subroutine plot_scrn(ci,name,ier) implicit none integer,intent(in) :: ci character(len=*),intent(in) :: name integer,intent(out) :: ier print*,' WARNING: plot_scrn not implemented in giza' ier = 1 end subroutine plot_scrn subroutine plot_qinf(item,value,length) implicit none character(len=*),intent(in) :: item character(len=*),intent(out) :: value integer,intent(out) :: length character(len=10) :: datestring,timestring select case(item) case('VERSION','version') value = 'giza-0.1' case('STATE','state') print*,' WARNING: query for STATE not yet implemented in giza' case('USER','user') print*,' WARNING: query for USER not yet implemented in giza' case('NOW','now') call date_and_time(datestring,timestring) value = datestring(7:8)//'-'//datestring(5:6)//'-'//datestring(1:4)// & ' '//timestring(1:2)//':'//timestring(3:4) case('DEVICE','device') print*,' WARNING: query for DEVICE not yet implemented in giza' case('FILE','file') print*,' WARNING: query for FILE not yet implemented in giza' case('TYPE','type') call giza_query_device('type',value) case('DEV/TYPE','dev/type') print*,' WARNING: query for DEV/TYPE not yet implemented in giza' case('HARDCOPY','hardcopy') call giza_query_device('hardcopy',value) case('TERMINAL','terminal') !--in giza the current device is never the terminal value = 'NO' case('CURSOR','cursor') call giza_query_device('cursor',value) case('SCROLL','scroll') !--no scroll capability in any current giza devices value = 'NO' case default value = ' ' end select length = len_trim(value) end subroutine plot_qinf subroutine plot_numb(m,pp,form,string,nc) implicit none integer,intent(in) :: m,pp,form character(len=*),intent(out) :: string integer,intent(out) :: nc call giza_format_number(m,pp,form,string) nc = len_trim(string) end subroutine plot_numb subroutine plot_set_opacity(alpha) implicit none real, intent(in) :: alpha integer :: ci real :: red,green,blue call plot_qci(ci) call plot_qcr(ci,red,green,blue) call plot_scr(ci,red,green,blue,alpha) end subroutine plot_set_opacity subroutine plot_err1(dir,x,y,e,t) implicit none integer,intent(in) :: dir real,intent(in) :: x,y,e real,intent(in) :: t real, dimension(1) :: xi,yi,ei xi(1) = x yi(1) = y ei(1) = e call plot_errb(dir,1,xi,yi,ei,t) end subroutine plot_err1 subroutine plot_conb(a,idim,jdim,i1,i2,j1,j2,c,nc,tr,blank) implicit none integer,intent(in) :: idim,jdim,i1,i2,j1,j2,nc real,intent(in) :: a(idim,jdim),c(*),tr(6),blank real :: affine(6) print*,' WARNING: blanking in contouring not implemented in giza' call convert_tr_to_affine(tr,affine) call giza_contour(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,nc,c,affine) end subroutine plot_conb subroutine plot_cons(a,idim,jdim,i1,i2,j1,j2,c,nc,tr) implicit none integer,intent(in) :: idim,jdim,i1,i2,j1,j2,nc real,intent(in) :: a(idim,jdim),c(*),tr(6) real :: affine(6) call convert_tr_to_affine(tr,affine) call giza_contour(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,nc,c,affine) end subroutine plot_cons subroutine plot_conl(a,idim,jdim,i1,i2,j1,j2,c,tr,label,intval,mininit) implicit none integer,intent(in) :: idim,jdim,i1,i2,j1,j2,intval,mininit real,intent(in) :: a(idim,jdim),c,tr(6) character(len=*),intent(in) :: label real :: affine(6) integer, parameter :: nc = 1 real, dimension(nc) :: clevel clevel(1) = c print*,' WARNING: labelled coutouring not implemented in giza' call convert_tr_to_affine(tr,affine) call giza_contour(idim,jdim,a,i1-1,i2-1,j1-1,j2-1,nc,clevel,affine) print*,'nc = ',nc end subroutine plot_conl subroutine plot_vect(a,b,idim,jdim,i1,i2,j1,j2,c,nc,tr,blank) implicit none integer,intent(in) :: idim,jdim,i1,i2,j1,j2,nc real,intent(in) :: a(idim,jdim),b(idim,jdim),tr(6),blank,c real :: affine(6) call convert_tr_to_affine(tr,affine) call giza_vector(idim,jdim,a,b,i1-1,i2-1,j1-1,j2-1,c,nc,affine,blank) end subroutine plot_vect subroutine plot_pixl(ia,idim,jdim,i1,i2,j1,j2,x1,x2,y1,y2) use giza, only:giza_draw_pixels implicit none integer,intent(in) :: idim,jdim,i1,i2,j1,j2 integer,intent(in) :: ia(idim,jdim) real,intent(in) :: x1,x2,y1,y2 call giza_draw_pixels(IDIM, JDIM, IA, I1-1, I2-1, J1-1, J2-1, X1, X2, Y1, Y2, 0) end subroutine plot_pixl subroutine plot_pap(widthin,aspect,paperunits) use giza, only:giza_set_paper_size use giza, only:giza_units_inches,giza_units_pixels,giza_units_mm implicit none real,intent(in) :: widthin,aspect integer, intent(in), optional :: paperunits integer :: units real :: width width = widthin units = giza_units_inches if (present(paperunits)) then select case(paperunits) case(0) units = giza_units_pixels case(1) units = giza_units_inches case(2) units = giza_units_mm width = 0.1*width end select endif call giza_set_paper_size(units,width,width*aspect) end subroutine plot_pap ! !--this subroutine can be called to ! make sure that the viewport lies exactly on ! pixel boundaries. ! ! unnecessary for giza ! subroutine plot_set_exactpixelboundaries() implicit none end subroutine plot_set_exactpixelboundaries !------------------------------------------------------------ ! Function to convert PGPLOT units value to giza units value !------------------------------------------------------------ integer function units_giza(pgplotunits) use giza, only:giza_units_normalized,giza_units_inches, & giza_units_mm,giza_units_pixels,giza_units_world implicit none integer, intent(in) :: pgplotunits select case(pgplotunits) case(0) units_giza = giza_units_normalized case(1) units_giza = giza_units_inches case(2) units_giza = giza_units_mm case(3) units_giza = giza_units_pixels case(4) units_giza = giza_units_world case default ! giza will give an error units_giza = pgplotunits end select end function units_giza subroutine convert_tr_to_affine(tr,affine) implicit none real, dimension(6), intent(in) :: tr real, dimension(6), intent(out) :: affine affine(1) = TR(2) affine(2) = TR(3) affine(3) = TR(5) affine(4) = TR(6) affine(5) = TR(1) + 0.5 * TR(2) affine(6) = TR(4) + 0.5 * TR(6) end subroutine convert_tr_to_affine end module plotlib splash/src/plotlib_pgplot.f90000644 000770 000000 00000046510 12115750344 017121 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !--------------------------------------------------------------------------- ! The plotlib module in SPLASH provides a consistent API so that SPLASH ! can be compiled against different graphics libraries as the backend ! ! This version provides an interface to Tim Pearson's PGPLOT, ! which was the original backend used in SPLASH v1.x. Thus, ! the functions mostly translate directly to PGPLOT equivalents, ! and basically this is a Fortran 90 interface for PGPLOT. ! ! Interface written by James Wetter and Daniel Price (2010) !--------------------------------------------------------------------------- module plotlib implicit none logical, parameter :: plotlib_is_pgplot = .true. logical, parameter :: plotlib_supports_alpha = .false. integer, parameter :: plotlib_maxlinestyle = 5 integer, parameter :: plotlib_maxfillstyle = 5 integer, parameter :: plotlib_maxlinecolour = 16 integer, parameter :: plotlib_extend_pad = 1 ! not implemented in PGPLOT integer, parameter :: plotlib_extend_repeat = 2 ! not implemented in PGPLOT integer, parameter :: plotlib_extend_reflect = 3 ! not implemented in PGPLOT integer, parameter :: plotlib_extend_none = 0 ! not implemented in PGPLOT public character(len=1),parameter :: plot_left_click = 'A' character(len=1),parameter :: plot_right_click = 'X' character(len=1),parameter :: plot_middle_click = 'D' character(len=1),parameter :: plot_shift_click = achar(15) character(len=1),parameter :: plot_scroll_up = achar(21) character(len=1),parameter :: plot_scroll_down = achar(4) character(len=1),parameter :: plot_scroll_left = achar(12) character(len=1),parameter :: plot_scroll_right = achar(18) interface plot_qci subroutine PGQCI (CI) integer,intent(out) :: CI end subroutine PGQCI end interface interface plot_qlw subroutine PGQLW (LW) integer,intent(out) :: LW end subroutine PGQLW end interface interface plot_qcr subroutine PGQCR (CI, CR, CG, CB) integer,intent(in) :: CI real,intent(out) :: CR, CG, CB end subroutine PGQCR end interface interface plot_qvp subroutine PGQVP (UNITS, X1, X2, Y1, Y2) integer,intent(in) :: UNITS real,intent(out) :: X1, X2, Y1, Y2 end subroutine PGQVP end interface interface plot_qwin subroutine PGQWIN (X1, X2, Y1, Y2) real,intent(out) :: X1, X2, Y1, Y2 end subroutine PGQWIN end interface interface plot_ebuf subroutine PGEBUF end subroutine PGEBUF end interface interface plot_bbuf subroutine PGBBUF end subroutine PGBBUF end interface interface plot_qcs subroutine PGQCS(UNITS, XCH, YCH) integer,intent(in) :: UNITS real,intent(out) :: XCH, YCH end subroutine PGQCS end interface interface plot_annotate subroutine PGMTXT (SIDE, DISP, COORD, FJUST, TEXT) character(len=*),intent(in) :: SIDE, TEXT real,intent(in) :: DISP, COORD, FJUST end subroutine PGMTXT end interface interface plot_sch subroutine PGSCH (SIZE) real,intent(in) :: SIZE end subroutine PGSCH end interface interface plot_sci subroutine PGSCI (CI) integer,intent(in) :: CI end subroutine PGSCI end interface interface plot_slw subroutine PGSLW (LW) integer,intent(in) :: lw end subroutine PGSLW module procedure plot_slw_float end interface interface plot_page subroutine pgpage end subroutine pgpage end interface interface plot_close subroutine PGEND end subroutine PGEND end interface interface plot_svp subroutine pgsvp(XLEFT, XRIGHT, YBOT, YTOP) real,intent(in) :: XLEFT, XRIGHT, YBOT, YTOP end subroutine pgsvp end interface interface plot_swin subroutine pgswin(X1, X2, Y1, Y2) real,intent(in) :: X1, X2, Y1, Y2 end subroutine pgswin end interface interface plot_wnad subroutine pgwnad(X1, X2, Y1, Y2) real,intent(in) :: X1, X2, Y1, Y2 end subroutine pgwnad end interface interface plot_qvsz subroutine PGQVSZ (UNITS, X1, X2, Y1, Y2) integer,intent(in) :: UNITS real,intent(out) :: X1, X2, Y1, Y2 end subroutine PGQVSZ end interface interface plot_line subroutine pgline(npts,xline,yline) integer, intent(in) :: npts real, intent(in), dimension(npts) :: xline,yline end subroutine pgline end interface interface plot_box subroutine pgbox(XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB) character*(*),intent(in) :: XOPT, YOPT real,intent(in) :: XTICK, YTICK integer,intent(in) :: NXSUB, NYSUB end subroutine pgbox end interface interface plot_scr subroutine PGSCR (CI, CR, CG, CB) integer, intent(in) :: CI real, intent(in) :: CR, CG, CB end subroutine pgscr module procedure pgscra end interface interface plot_bins subroutine PGBIN (NBIN, X, DATA, CENTER) integer,intent(in) :: NBIN real,intent(in) :: X(*), DATA(*) LOGICAL,intent(in) :: CENTER end subroutine PGBIN end interface interface plot_imag module procedure plot_imag_transparent end interface interface plot_qcol subroutine pgqcol(icolmin,icolmax) integer,intent(out) :: icolmin,icolmax end subroutine pgqcol end interface interface plot_qcir subroutine pgqcir(icolmin,icolmax) integer,intent(out) :: icolmin,icolmax end subroutine pgqcir end interface interface plot_scir subroutine pgscir(icilo, icihi) integer,intent(in) :: icilo,icihi end subroutine pgscir end interface interface plot_ctab subroutine pgctab(l,r,g,b,nc,contra,bright) integer,intent(in) :: nc real,intent(in) :: l(nc),r(nc),g(nc),b(nc),contra,bright end subroutine pgctab end interface interface plot_qls subroutine pgqls(ls) integer,intent(out) :: ls end subroutine pgqls end interface interface plot_qfs subroutine pgqfs(fs) integer,intent(out) :: fs end subroutine pgqfs end interface interface plot_sls subroutine pgsls(ls) integer,intent(in) :: ls end subroutine pgsls end interface interface plot_sfs subroutine pgsfs(fs) integer,intent(in) :: fs end subroutine pgsfs end interface interface plot_rect subroutine pgrect(x1,x2,y1,y2) real,intent(in) :: x1,x2,y1,y2 end subroutine pgrect module procedure plot_rect_rounded end interface interface plot_arro subroutine pgarro(x1,y1,x2,y2) real,intent(in) :: x1,y1,x2,y2 end subroutine pgarro end interface interface plot_circ subroutine pgcirc(xcent,ycent,radius) real,intent(in) :: xcent,ycent,radius end subroutine pgcirc end interface interface plot_lcur subroutine pglcur (maxpt, npt, x, y) implicit none integer, intent(in) :: maxpt integer, intent(inout) :: npt real, intent(inout) :: x(*), y(*) end subroutine pglcur module procedure plot_clcur end interface plot_lcur interface plot_olin subroutine pgolin (maxpt, npt, x, y, symbol) implicit none integer, intent(in) :: maxpt integer, intent(inout) :: npt real, intent(inout) :: x(*), y(*) integer, intent(in) :: symbol end subroutine pgolin end interface plot_olin interface plot_ncur subroutine pgncur(maxpt, npt, x, y, symbol) implicit none integer, intent(in) :: maxpt integer, intent(inout) :: npt real, intent(inout) :: x(*), y(*) integer, intent(in) :: symbol end subroutine pgncur end interface plot_ncur interface plot_qtxt subroutine pgqtxt(x,y,angle,fjust,text,xbox,ybox) real,intent(in) :: x, y, angle, fjust character(len=*),intent(in) :: text real,intent(out),dimension(4) :: xbox,ybox end subroutine pgqtxt end interface interface plot_ptxt subroutine pgptxt(x,y,angle,fjust,text) real,intent(in) :: x,y,angle,fjust character(len=*),intent(in) :: TEXT end subroutine pgptxt end interface interface plot_stbg subroutine pgstbg(bg) integer,intent(in) :: bg end subroutine pgstbg end interface interface plot_curs ! integer function pgcurs(x,y,ch) ! real,intent(inout) :: x,y ! character*(*),intent(out) :: ch ! end function pgcurs module procedure pgcurs_sub end interface interface plot_pt subroutine pgpt(n,xpts,ypts,symbol) integer,intent(in) :: n real,intent(in) :: xpts(*),ypts(*) integer,intent(in) :: symbol end subroutine pgpt end interface interface plot_funx subroutine pgfunx(fx,n,ymin,ymax,pgflags) real,external :: fx integer,intent(in) :: n,pgflags real,intent(in) :: ymin,ymax end subroutine pgfunx end interface interface plot_label subroutine pglabel(xlbl,ylbl,toplbl) character(len=*),intent(in) :: xlbl,ylbl,toplbl end subroutine pglabel end interface interface plot_scrn subroutine pgscrn(ci,name,ier) integer,intent(in) :: ci character(len=*),intent(in) :: name integer,intent(out) :: ier end subroutine pgscrn end interface interface plot_poly subroutine pgpoly(n,xpts,ypts) integer,intent(in) :: n real,intent(in) :: xpts(*),ypts(*) end subroutine pgpoly end interface interface plot_qinf subroutine pgqinf(item,value,length) character(len=*),intent(in) :: item character(len=*),intent(out) :: value integer,intent(out) :: length end subroutine pgqinf end interface interface plot_band module procedure pgband_sub end interface interface plot_pt1 subroutine pgpt1(xpt,ypt,symbol) real,intent(in) :: xpt,ypt integer,intent(in) :: symbol end subroutine pgpt1 end interface interface plot_numb subroutine pgnumb(m,pp,form,string,nc) integer,intent(in) :: m,pp,form character(len=*),intent(out) :: string integer,intent(out) :: nc end subroutine pgnumb end interface interface plot_qch subroutine pgqch(ch) real,intent(out) :: ch end subroutine pgqch end interface interface plot_text subroutine pgtext(x,y,text) real,intent(in) :: x,y character(len=*),intent(in) :: text end subroutine pgtext end interface interface plot_err1 subroutine pgerr1(dir,x,y,e,t) integer,intent(in) :: dir real,intent(in) :: x,y,e real,intent(in) :: t end subroutine pgerr1 end interface interface plot_errb subroutine pgerrb(dir,n,x,y,e,t) integer,intent(in) :: dir,n real,intent(in) :: x(n),y(n),e(n) real,intent(in) :: t end subroutine pgerrb end interface interface plot_conb subroutine pgconb(a,idim,jdim,i1,i2,j1,j2,c,nc,tr,blank) integer,intent(in) :: idim,jdim,i1,i2,j1,j2,nc real,intent(in) :: a(idim,jdim),c(*),tr(6),blank end subroutine pgconb end interface interface plot_cons subroutine pgcons(a,idim,jdim,i1,i2,j1,j2,c,nc,tr) integer,intent(in) :: idim,jdim,i1,i2,j1,j2,nc real,intent(in) :: a(idim,jdim),c(*),tr(6) end subroutine pgcons end interface interface plot_conl subroutine pgconl(a,idim,jdim,i1,i2,j1,j2,c,tr,label,intval,mininit) integer,intent(in) :: idim,jdim,i1,i2,j1,j2,intval,mininit real,intent(in) :: a(idim,jdim),c,tr(6) character(len=*),intent(in) :: label end subroutine pgconl end interface interface plot_sah subroutine pgsah(fs, angle, cutback) integer, intent(in) :: fs real, intent(in) :: angle, cutback end subroutine pgsah end interface interface plot_vect subroutine pgvect(a,b,idim,jdim,i1,i2,j1,j2,c,nc,tr,blank) integer,intent(in) :: idim,jdim,i1,i2,j1,j2,nc real,intent(in) :: a(idim,jdim),b(idim,jdim),tr(6),blank,c end subroutine pgvect end interface interface plot_pixl subroutine pgpixl(ia,idim,jdim,i1,i2,j1,j2,x1,x2,y1,y2) integer,intent(in) :: idim,jdim,i1,i2,j1,j2 integer,intent(in) :: ia(idim,jdim) real,intent(in) :: x1,x2,y1,y2 end subroutine pgpixl end interface interface plot_env subroutine pgenv(xmin,xmax,ymin,ymax,just,axis) real,intent(in) :: xmin,xmax,ymin,ymax integer,intent(in) :: just,axis end subroutine pgenv end interface contains !--------------------------------------------- ! initialise the plotting library !--------------------------------------------- subroutine plot_init(devicein, ierr, papersizex, aspectratio, paperunits) implicit none character*(*), intent(in) :: devicein integer, intent(out) :: ierr real, intent(in), optional :: papersizex,aspectratio integer, intent(in), optional :: paperunits integer :: pgopen real :: aspect if (devicein(1:1).eq.'?') then call pgbegin(0,'?',1,1) ierr = 1 else ierr = pgopen(devicein) endif !--check if there is an error ! (be careful here: from PGPLOT zero or -ve indicates an error) if (ierr.le.0) then if (ierr.eq.0) ierr = -1 !--make sure we return an error return else ierr = 0 endif !-- Turn off promting call pgask(.false.) !-- set paper size if given if (present(papersizex)) then if (present(aspectratio)) then aspect = aspectratio else aspect = sqrt(2.) endif if (present(paperunits)) then !--make sure that the units are in inches for PGPLOT if (paperunits.ne.1) return endif call plot_pap(papersizex,aspect) endif end subroutine plot_init subroutine plot_slc(lc) implicit none integer,intent(in) :: lc !--line cap has no effect in PGPLOT end subroutine plot_slc subroutine plot_pap(width,aspect,paperunits) real,intent(in) :: width,aspect integer, intent(in), optional :: paperunits if (present(paperunits)) then if (paperunits.ne.1) print "(a)",' WARNING: units not valid for PGPLOT' endif call pgpap(papersizex,aspect) end subroutine plot_pap subroutine plot_qlc(lc) implicit none integer,intent(out) :: lc lc = 0 end subroutine plot_qlc subroutine plot_set_opacity(alpha) implicit none real, intent(in) :: alpha !--opacity has no effect in PGPLOT end subroutine plot_set_opacity !--interface to set transparent colour ! (not implemented in PGPLOT) subroutine pgscra (CI, CR, CG, CB, CA) integer, intent(in) :: CI real, intent(in) :: CR, CG, CB, CA !--just throw away the alpha value call PGSCR(CI,CR,CG,CB) end subroutine pgscra !--floating point line widths ! (not implemented in PGPLOT) subroutine plot_slw_float (LW) real,intent(in) :: lw call PGSLW(nint(lw)) end subroutine plot_slw_float subroutine plot_rgb_from_table(frac,r,g,b) implicit none real, intent(in) :: frac real, intent(out) :: r,g,b !--rgb from table not implemented in PGPLOT end subroutine plot_rgb_from_table logical function plot_qcur() implicit none character(len=10) :: string integer :: nc call pgqinf('CURSOR',string,nc) if(string(1:nc).eq.'YES') then plot_qcur = .true. else plot_qcur = .false. end if end function plot_qcur ! !--inverts the return value of pgcurs ! function pgcurs_sub(x,y,ch) real,intent(inout) :: x,y character*(*),intent(out) :: ch integer :: pgcurs_sub,ierr integer, external :: pgcurs ierr = pgcurs(x,y,ch) if (ierr.eq.0) then pgcurs_sub = 1 else pgcurs_sub = 0 endif end function pgcurs_sub !--transparent rendering does not work in PGPLOT, but ! we give it an interface anyway subroutine plot_imag_transparent(a, idim, jdim, i1, i2, j1, j2, a1, a2, tr, iextend) implicit none integer,intent(in) :: IDIM, JDIM, I1, I2, J1, J2 real,intent(in) :: A(IDIM,JDIM), A1, A2, TR(6) integer, intent(in), optional :: iextend call pgimag(a, idim, jdim, i1, i2, j1, j2, a1, a2, tr) end subroutine plot_imag_transparent subroutine plot_imag_alpha(dat, alpha, idim, jdim, i1, i2, j1, j2, a1, a2, tr, iextend) integer,intent(in) :: IDIM, JDIM, I1, I2, J1, J2 real,intent(in) :: dat(IDIM,JDIM), alpha(IDIM,JDIM), A1, A2, TR(6) real :: affine(6) integer, intent(in), optional :: iextend call pgimag(dat, idim, jdim, i1, i2, j1, j2, a1, a2, tr) end subroutine plot_imag_alpha !--giza version of plot_gray takes additional arguments subroutine plot_gray(a, idim, jdim, i1, i2, j1, j2, a1, a2, tr, iextend) implicit none integer,intent(in) :: IDIM, JDIM, I1, I2, J1, J2 real,intent(in) :: A(IDIM,JDIM), A1, A2, TR(6) integer, intent(in), optional :: iextend call pggray(a, idim, jdim, i1, i2, j1, j2, a1, a2, tr) end subroutine plot_gray !--version of lcur that returns last character pressed subroutine plot_clcur(maxpt, npt, x, y, ch) implicit none integer, intent(in) :: maxpt integer, intent(inout) :: npt real, intent(inout) :: x(*), y(*) character*(*),intent(out) :: ch call pglcur (maxpt, npt, x, y) ch = 'A' end subroutine plot_clcur !--rounded rectangle plotting ! (not implemented -- just calls pgrect) subroutine plot_rect_rounded(x1,x2,y1,y2,r) implicit none real,intent(in) :: x1,x2,y1,y2,r call pgrect(x1,x2,y1,y2) end subroutine plot_rect_rounded ! !--inverts the return value of pgband ! function pgband_sub(mode, posn, xref, yref, x, y, ch) integer,intent(in) :: mode, posn real,intent(in) :: xref, yref real,intent(inout) :: x, y character*(*),intent(out) :: ch integer :: ierr,pgband_sub integer,external :: pgband ierr = pgband(mode,posn,xref,yref,x,y,ch) if(ierr.eq.1) then pgband_sub = 0 else pgband_sub = 1 endif end function pgband_sub ! !--this subroutine can be called after PGSVP to ! make sure that the viewport lies exactly on ! pixel boundaries. ! ! Queries PGPLOT routines directly so no need ! for input/output ! subroutine plot_set_exactpixelboundaries() implicit none real :: xminpix,xmaxpix,yminpix,ymaxpix real :: vptxmin,vptxmax,vptymin,vptymax real :: dv real, parameter :: tol = 1.e-6 ! ! setting axes adjusts the viewport, so query to get adjusted settings ! call pgqvp(0,vptxmin,vptxmax,vptymin,vptymax) !print*,'got ',vptxmin,vptxmax,vptymin,vptymax ! ! adjust viewport on pixel devices so that ! boundaries lie exactly on pixel boundaries ! ! query viewport size in pixels call pgqvp(3,xminpix,xmaxpix,yminpix,ymaxpix) !print*,' in pixels = ',xminpix,xmaxpix,yminpix,ymaxpix ! work out how many viewport coords/pixel dv = (vptymax - vptymin)/(ymaxpix-yminpix) ! adjust viewport min/max to lie on pixel boundaries vptymin = max((nint(yminpix)-tol)*dv,0.) vptymax = min((nint(ymaxpix)-tol)*dv,1.0-epsilon(1.0)) ! be careful of round-off errors ! same for x dv = (vptxmax - vptxmin)/(xmaxpix-xminpix) vptxmin = max((nint(xminpix)-tol)*dv,0.) vptxmax = min((nint(xmaxpix)-tol)*dv,1.0-epsilon(1.0)) ! be careful of round-off errors ! adjust viewport !print*,'adjusting ',vptxmin,vptxmax,vptymin,vptymax call pgsvp(vptxmin,vptxmax,vptymin,vptymax) !call pgqvp(3,xminpix,xmaxpix,yminpix,ymaxpix) !print*,' in pixels = ',xminpix,xmaxpix,yminpix,ymaxpix return end subroutine plot_set_exactpixelboundaries end module plotlib splash/src/plotstep.f90000644 000770 000000 00000533046 12611360562 015746 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------ ! ! This is the core routine for the whole code. ! Drives the plotting pipeline, ie. calls all the routines which ! do the work. ! ! I am gradually trying to make this routine more modular... ! !------------------------------------------------------------------------ module timestep_plotting use params, only:maxplot implicit none integer, private :: ninterp integer, private :: iplotx,iploty,iplotz,irender,irenderplot,icontourplot integer, private :: ivectorplot,ivecx,ivecy integer, private :: nyplots,npartdim,nyplotfirstonpage,ifirststeponpage integer, private :: ngrid,nframefirstonpage integer, private :: just,ntitles,nsteplegendlines integer, private :: iplots,ipanel integer, private :: iframesave integer, private :: npixx,npixy,npixz real, dimension(:), allocatable, private :: datpix1D, xgrid real, dimension(:,:), allocatable, private :: datpix,datpixcont,brightness real, dimension(:,:,:), allocatable, private :: datpix3D,datpixcont3D real, private :: xmin,xmax,ymin,ymax,zmin real, private :: rendermin,rendermax,vecmax,contmin,contmax real, private :: dz,zslicepos,zobservertemp,dzscreentemp,taupartdepthtemp,rkappafac real, private :: dxgrid,xmingrid,xmaxgrid real, private :: angletempx, angletempy, angletempz !--buffer for interactive mode on multiplots integer, dimension(maxplot) :: iplotxtemp,iplotytemp,irendertemp,icontourtemp,ivecplottemp real, dimension(maxplot) :: xminmulti,xmaxmulti,xminadapt,xmaxadapt real, dimension(maxplot) :: vptxmin,vptxmax,vptymin,vptymax,barwmulti real, private :: xminadapti,xmaxadapti,yminadapti,ymaxadapti,renderminadapt,rendermaxadapt real, private :: contminadapt,contmaxadapt real, private :: xminpagemargin,xmaxpagemargin,yminpagemargin,ymaxpagemargin real, parameter, private :: pi = 3.1415926536 logical, private :: iplotpart,iplotcont,x_sec,isamexaxis,isameyaxis,iamrendering,idoingvecplot logical, private :: inewpage, tile_plots, lastplot logical, private :: imulti,irerender,iAllowspaceforcolourbar,ihavesetweights logical, private :: interactivereplot,ihavesetcolours,vectordevice,gotcontours logical, private :: OneColourBarPerRow public :: initialise_plotting, plotstep private contains ! ! initialise plotting options ! called once for all steps ! subroutine initialise_plotting(ipicky,ipickx,irender_nomulti,icontour_nomulti,ivecplot) use params use colours, only:colour_set use labels, only:label,ipowerspec,ih,ipmass,irho,iamvec,isurfdens,& is_coord,itoomre,iutherm,ipdf,ix,icolpixmap use limits, only:lim,rangeset use multiplot, only:multiplotx,multiploty,irendermulti,icontourmulti, & nyplotmulti,x_secmulti,ivecplotmulti use prompting, only:prompt use titles, only:read_titles,read_steplegend use settings_data, only:ndim,ndimV,numplot,ncolumns,ncalc,ndataplots,required, & icoords,icoordsnew,debugmode,ntypes,usetypeinrenderings use settings_page, only:nacross,ndown,ipapersize,tile,papersizex,aspectratio,& iPageColours,iadapt,iadaptcoords,linewidth,device,nomenu,& interactive,ipapersizeunits,usecolumnorder use pagecolours, only:set_pagecolours use settings_part, only:linecolourthisstep,linecolour,linestylethisstep,linestyle,iexact,iplotpartoftype use settings_render, only:icolours,iplotcont_nomulti,iColourBarStyle,icolour_particles use settings_xsecrot, only:xsec_nomulti,xsecpos_nomulti,flythru,nxsec,irotate, & xseclineX1,xseclineX2,xseclineY1,xseclineY2,xsecwidth, & use3Dperspective,use3Dopacityrendering,zobserver,dzscreenfromobserver,taupartdepth use settings_powerspec, only:options_powerspec,options_pdf use particle_data, only:npartoftype,masstype use projections3D, only:coltable use plotlib, only:plot_init,plot_qcur,plot_slw,plot_env,plot_curs,plot_band, & plot_close,plot_qinf use system_utils, only:renvironment use calcquantities, only:get_calc_data_dependencies implicit none real, parameter :: pi=3.1415926536 integer, intent(in) :: ipicky,ipickx,irender_nomulti,icontour_nomulti,ivecplot integer :: i,j,ifirst,iplotzprev,ilen,ierr,irow,ntries logical :: iadapting,icoordplot,iallrendered,ians real :: hav,pmassav,dzsuggest integer, dimension(:), allocatable :: ifirstinrow character(len=1) :: char character(len=20) :: devstring !------------------------------------------------------------------------ ! initialisations ! should initialise all saved variables here !------------------------------------------------------------------------ isamexaxis = .true. ! same x axis on all plots? (only relevant for >1 plots per page) isameyaxis = .true. ! same y axis on all plots? tile_plots = .false. iplots = 0 ! counter for how many plots have been plotted in total ipanel = 0 ! counter for which panel we are in on plotting page irender = 0 irenderplot = 0 ivectorplot = 0 x_sec = xsec_nomulti iplotcont = iplotcont_nomulti lastplot = .false. iplotpart = .true. irerender = .false. interactivereplot = .false. nyplotfirstonpage = 1 ! should be unnecessary, but to be on the safe side ifirststeponpage = 1 ! again, should be unnecessary nframefirstonpage = 1 iplotxtemp(:) = 1 ! this is just to be safe, so any spurious array access iplotytemp(:) = 2 ! does not give an out-of-bounds error irendertemp(:) = 0 ivecplottemp(:) = 0 xmin = 0. xmax = 0. ymin = 0. ymax = 0. rendermin = 0. rendermax = 0. contmin = 0. contmax = 0. vecmax = 0. xminadapt = huge(xminadapt) xmaxadapt = -huge(xmaxadapt) renderminadapt = huge(renderminadapt) rendermaxadapt = -huge(rendermaxadapt) contminadapt = huge(contminadapt) contmaxadapt = -huge(contmaxadapt) xminpagemargin = renvironment('SPLASH_MARGIN_XMIN') xmaxpagemargin = renvironment('SPLASH_MARGIN_XMAX') yminpagemargin = renvironment('SPLASH_MARGIN_YMIN') ymaxpagemargin = renvironment('SPLASH_MARGIN_YMAX') if (ndim.eq.1) x_sec = .false. ! can't have xsec in 1D nxsec = 1 iamrendering = .false. idoingvecplot = .false. if (ipicky.eq.numplot+1) then ! multiplot imulti = .true. nyplots = nyplotmulti iplotx = 0 ! set these to zero by default for multiplots iploty = 0 ! (they should not be used in that case) ! !--if doing multiplot can only take a single cross section slice ! flythru = .false. nxsec = 1 ! !--work out whether to tile plots and make labelling decisions ! if (any(multiplotx(1:nyplotmulti).ne.multiplotx(1))) isamexaxis = .false. if (any(multiploty(1:nyplotmulti).ne.multiploty(1))) then isameyaxis = .false. if (any(multiploty(1:nyplotmulti).eq.icolpixmap)) then isameyaxis = .true. do i=1,nyplotmulti if (.not.(multiploty(i).eq.icolpixmap .or. multiploty(i).eq.multiploty(1))) isameyaxis = .false. enddo endif endif if (any(irendermulti(1:nyplotmulti).gt.0)) iamrendering = .true. if (any(x_secmulti(1:nyplotmulti))) x_sec = .true. if (any(ivecplotmulti(1:nyplotmulti).gt.0)) idoingvecplot = .true. else ! !--or else set number of plots = 1 and use ipicky and ipickx ! imulti = .false. nyplots = 1 iploty = ipicky iplotx = ipickx if (irender_nomulti.gt.0) iamrendering = .true. if (ivecplot.gt.0) idoingvecplot = .true. endif !------------------------------------------------------------------------ ! initialise options to be set before plotting ! !--determine z coordinate for 3D plots ! icoordplot = is_coord(iploty,ndim) .and. is_coord(iplotx,ndim) iallrendered = iamrendering iplotz = 0 if (imulti) then do i=1,nyplotmulti if (is_coord(multiplotx(i),ndim) .and. is_coord(multiploty(i),ndim)) then icoordplot = .true. !--this check is to see if any co-ordinate plots involve just particles ! (if so need to initialise the cross section slice width) if (irendermulti(i).le.0) iallrendered = .false. iplotzprev = iplotz !!--work out coordinate that is not being plotted on cross-section/ 3D plots iplotz = 0 if (ndim.ge.3 .and. (x_sec .or. use3Dperspective .or. irotate)) then do j=1,ndim if ((multiplotx(i).ne.multiploty(i)).and. & (ix(j).ne.multiplotx(i)).and.(ix(j).ne.multiploty(i))) iplotz = ix(j) enddo !--use only first iplotz in the case of multiple slices ! (only effect is on default values for slice thickness etc below) if (iplotzprev.gt.0) iplotz = iplotzprev endif endif enddo elseif (icoordplot) then !!--work out coordinate that is not being plotted if (ndim.ge.3) then do j=1,ndim if ((iplotx.ne.iploty).and. & (ix(j).ne.iplotx).and.(ix(j).ne.iploty)) iplotz = ix(j) enddo endif endif if (debugmode) print*,'DEBUG: iplotz = ',iplotz ! !--work out whether or not to tile plots on the page ! if plots are coord plots, make tiling decisions based on iadaptcoords ! otherwise use iadapt ! if (icoordplot) then iadapting = iadaptcoords else iadapting = iadapt endif tile_plots = tile .and. (isamexaxis.and.isameyaxis .or. isameyaxis.and.ndown.eq.1 & .or. isamexaxis.and.nacross.eq.1) .and. (nacross*ndown.gt.1) !--do not tile if limits are adaptive if (tile_plots .and. (iadapting .or. (iamrendering .and. iadapt .and. iColourbarStyle.gt.0))) then print "(a)",'WARNING: cannot tile plots because limits are set to adaptive' tile_plots = .false. endif !--( a further constraint on plot tiling is required in the case of ! multiple renderings which would involve different colour bars ) OneColourBarPerRow = .false. if (iamrendering .and. icolours.ne.0 .and. iColourbarStyle.gt.0) then !--this option means that a margin is set aside for a colour bar on tiled plots iAllowspaceforcolourbar = .true. !--do not allow tiled plots if multiple (different) colour bars are plotted if (tile_plots) then ifirst = 0 do i=1,nyplots if (irendermulti(i).gt.0 .and. ifirst.eq.0) ifirst = i if (ifirst.gt.0) then if (irendermulti(i).gt.0 .and. irendermulti(i).ne.irendermulti(ifirst)) then tile_plots = .false. endif endif enddo !--this means colour bars are not the same, but we can still tile if ! all the colour bars in each row are the same if (.not.tile_plots .and. mod(nacross*ndown,nyplots).eq.0) then OneColourBarPerRow = .true. allocate(ifirstinrow(ndown)) ifirstinrow(:) = 0 do i=1,nyplots if (usecolumnorder) then irow = (i-1)/nacross + 1 else irow = i - ((i-1)/ndown)*ndown endif if (ifirstinrow(irow).eq.0) ifirstinrow(irow) = i if (irendermulti(i).ne.irendermulti(ifirstinrow(irow))) then OneColourBarPerRow = .false. endif enddo deallocate(ifirstinrow) if (OneColourBarPerRow) tile_plots = .true. endif if (.not.tile_plots) print "(a)",'WARNING: cannot tile plots because of multiple colour bars' endif else iAllowspaceforcolourbar = .false. endif if (icoordplot) then if (x_sec .and. iplotz.gt.0) then ! !--if series of cross sections (flythru), set position of first one ! if (flythru) then print 32,label(iplotz) 32 format('enter number of ',a1,' cross-section slices') read*,nxsec !!--dz is the distance between slices dz = (lim(iplotz,2)-lim(iplotz,1))/float(nxsec) zslicepos = lim(iplotz,1) - 0.5*dz xsecpos_nomulti = zslicepos else ! !--if single cross-section, read position of cross-section slice ! if (.not.imulti) then !--make sure position falls within the limits if (xsecpos_nomulti.lt.lim(iplotz,1) & .or.xsecpos_nomulti.gt.lim(iplotz,2)) then xsecpos_nomulti = (lim(iplotz,2)+lim(iplotz,1))/2. endif call prompt(' enter '//trim(label(iplotz))// & ' position for cross-section slice:', & xsecpos_nomulti,lim(iplotz,1),lim(iplotz,2)) endif ! !--set thickness if plotting particles ! (default thickness is half of the average particle spacing) ! if (.not.iallrendered .or. icolour_particles) then if (xsecwidth.gt.0. .and. xsecwidth.lt.(lim(iplotz,2)-lim(iplotz,1))) then !--already set dzsuggest = xsecwidth else !--xsecwidth not set; suggest a good value npartdim = int(maxval(npartoftype(:,1))**(1./real(ndim))) print*,'average # of particles in each dimension = ',npartdim if (npartdim.gt.0) then dzsuggest = (lim(iplotz,2)-lim(iplotz,1))/float(npartdim) else dzsuggest = 0.01*(lim(iplotz,2)-lim(iplotz,1)) endif endif dz = dzsuggest if (imulti) then call prompt(' enter thickness for cross section slice(s):', & dz,0.0,lim(iplotz,2)-lim(iplotz,1)) else call prompt(' enter thickness of cross section slice:', & dz,0.0,lim(iplotz,2)-lim(iplotz,1)) endif !--if dz has been set from the prompt, save the setting, ! otherwise suggest (possibly different) value again next time if (abs(dz-dzsuggest).gt.tiny(dz)) xsecwidth = dz elseif (ndim.eq.3) then ! !--for rendered cross sections in 3D, set thickness to 10% ! this is the distance slices are moved up and down in interactive mode ! dz = 0.1*(lim(iplotz,2)-lim(iplotz,1)) endif endif ! flythru or single ! !--set up for 1D cross sections through 2D data ! elseif (ndim.eq.2 .and. x_sec) then ians = .false. call prompt('set cross section position interactively?',ians) if (ians) then ! !--set cross section position interactively ! call plot_init('/xw',ierr) call plot_env(lim(1,1),lim(1,2),lim(2,1),lim(2,2),1,0) ierr = plot_curs(xseclineX1,xseclineY1,char) print*,'please select cross section line' ierr = plot_band(1,1,xseclineX1,xseclineY1,xseclineX2,xseclineY2,char) print*,'cross section line: xmin = ',xseclineX1,' xmax = ',xseclineX2 print*,' ymin = ',xseclineY1,' ymax = ',xseclineY2 call plot_close else ! !--set position manually ! if (abs(xseclineX2-xseclineX1).lt.1.e-5 .and. & abs(xseclineY2-xseclineY1).lt.1.e-5) then !--if not already set (ie. if all = 0.0) ! then set default line to diagonal across the domain xseclineX1 = lim(1,1) xseclineX2 = lim(1,2) xseclineY1 = lim(2,1) xseclineY2 = lim(2,2) endif print*,'enter position of cross section through 2D data:' call prompt('enter xmin of cross section line',xseclineX1) call prompt('enter xmax of cross section line',xseclineX2) call prompt('enter ymin of cross section line',xseclineY1) call prompt('enter ymax of cross section line',xseclineY2) endif endif if (iplotz.gt.0 .and. use3Dperspective) then ! !--initialise 3D perspective ! !--set default values if none set if (abs(zobserver).lt.tiny(zobserver)) zobserver = 10.*lim(iplotz,2) if (abs(dzscreenfromobserver).lt.tiny(dzscreenfromobserver)) dzscreenfromobserver = zobserver call prompt('enter z coordinate of observer ',zobserver) dzscreenfromobserver = zobserver ! call prompt('enter distance for unit magnification ',dzscreenfromobserver,0.) ! !--initialise opacity for 3D opacity rendering ! if (use3Dopacityrendering .and. (iamrendering .or. idoingvecplot)) then hav = lim(ih,1) !! 0.5*(lim(ih,2) + lim(ih,1)) if (hav.le.epsilon(hav)) hav = 0.5*lim(ih,2) ! take 0.5*max if min is zero if (ipmass.gt.0) then pmassav = lim(ipmass,1) if (pmassav.le.epsilon(hav)) pmassav = 0.5*lim(ipmass,2) ! take 0.5*max if min is zero else ! handle case where mass is not a data column pmassav = maxval(masstype) do i=1,ntypes if (iplotpartoftype(i) .and. usetypeinrenderings(i) & .and. any(masstype(i,:).gt.0.)) pmassav = min(pmassav,maxval(masstype(i,:))) enddo endif print*,'using current h and pmass limits to calculate kappa (cross section/unit mass)' print*,'min h = ',hav,' min particle mass = ',pmassav print*,'[ kappa = pi*h_min**2/(particle_mass*n_smoothing_lengths) ]' call prompt('enter approximate surface depth (number of smoothing lengths):',taupartdepth,0.) rkappafac = pi*hav*hav/(pmassav*coltable(0)) print*,'kappa (particle cross section per unit mass) = ',rkappafac/taupartdepth endif endif endif !!--prompt for options if plotting power spectrum if (iploty.eq.ipowerspec .and. .not. imulti & .or. (imulti.and.any(multiploty(1:nyplotmulti).eq.ipowerspec))) then call options_powerspec endif !!--prompt for options if plotting PDFs if (iploty.eq.ipdf .and. .not. imulti & .or. (imulti.and.any(multiploty(1:nyplotmulti).eq.ipdf))) then call options_pdf endif !!--for fast data read, set which columns are required from the file ! (note that required(0)= whatever is a valid statement, just has no effect) required = .false. ! by default, no columns required if (debugmode) print*,'DEBUG: imulti = ',imulti,' iamrendering = ',iamrendering ! if (fastdataread) then if (imulti) then required(multiplotx(1:nyplotmulti)) = .true. required(multiploty(1:nyplotmulti)) = .true. required(irendermulti(1:nyplotmulti)) = .true. required(icontourmulti(1:nyplotmulti)) = .true. else if (iploty.ne.icolpixmap) required(iplotx) = .true. required(iploty) = .true. endif required(iplotz) = .true. if ((iamrendering .or. idoingvecplot) .and. & (iploty.ne.icolpixmap .or. imulti .or. iploty.eq.0)) then required(ipmass) = .true. required(irho) = .true. required(ih) = .true. required(irender_nomulti) = .true. required(icontour_nomulti) = .true. endif !!--need to read columns used for range restrictions do i=1,ndataplots if (rangeset(i)) required(i) = .true. enddo !!--need mass for some exact solutions if (iexact.eq.7 .or. iploty.eq.isurfdens) required(ipmass) = .true. if (iploty.eq.itoomre .and. iploty.gt.0) required(iutherm) = .true. !!--only require actual dependencies of calculated quantities if (any(required(ncolumns+1:ncolumns+ncalc))) call get_calc_data_dependencies(required) !if (any(required(ncolumns+1:ncolumns+ncalc))) required = .true. !!--vectors if (imulti) then do i=1,nyplotmulti if (ivecplotmulti(i).gt.0) then required(ivecplotmulti(i):ivecplotmulti(i)+ndimV-1) = .true. endif enddo elseif (ivecplot.gt.0) then required(ivecplot:ivecplot+ndimV-1) = .true. endif !!--if geometry is not default must read all coords !! and if we are plotting a vector component, all components if (icoordsnew.ne.icoords) then required(ix(1:ndim)) = .true. if (iplotx.gt.0 .and. iplotx.le.numplot) then if (iamvec(iplotx).gt.0) required(iamvec(iplotx):iamvec(iplotx)+ndimV-1) = .true. endif if (iploty.gt.0 .and. iploty.le.numplot) then if (iamvec(iploty).gt.0) required(iamvec(iploty):iamvec(iploty)+ndimV-1) = .true. endif endif ! endif if (debugmode) print*,'DEBUG: required(1:ncolumns) = ',required(1:ncolumns+ncalc) !!--read step titles (don't need to store ntitles for this) nsteplegendlines = 0 call read_steplegend(nsteplegendlines) !!--read plot titles ntitles = 0 call read_titles(ntitles) !!------------------------------------------------------------------------ !! initialise the plotting library if (len_trim(device).le.0) then devstring = '?' ! prompt for device else devstring = trim(device) ! device specified on command line endif ierr = 1 ntries = 0 do while(ierr.ne.0) ntries = ntries + 1 if (ipapersize.gt.0 .and. papersizex.gt.0.0 .and. aspectratio.gt.0.0 ) then call plot_init(trim(devstring),ierr,papersizex,aspectratio,ipapersizeunits) else call plot_init(trim(devstring),ierr) ! use default paper size endif !--abort if device specified on command line returns an error if (len_trim(device).gt.0 .and. ierr.ne.0) then ! -ve indicates an error print "(a)",' ERROR: unknown device "'//trim(device)//'"' stop endif if (ierr.ne.0) print "(a)",' ERROR opening plotting device' if (ntries.gt.10) stop enddo !--query whether or not device is interactive if (plot_qcur()) then !--turn menu and interactive mode on if ! interactive device invoked from the command line if (nomenu) then interactive = .true. nomenu = .false. endif !--smoothing length is required if interactive device and coordinate plot if (icoordplot) required(ih) = .true. endif !!--set background/foreground colours call set_pagecolours(iPageColours) !!--set colour table ! do this regardless of whether rendering or not if (iamrendering .and. icolours.ne.0) then call colour_set(icolours) ihavesetcolours = .true. else ihavesetcolours = .false. endif !!--determine whether or not the device is vector or not ! this affects the choice of line with (if auto line width is used -- see below) ! and also the automatic resolution determination (should not apply to vector devices) ! call plot_qinf('TYPE',devstring,ilen) select case(devstring(1:ilen)) case('PS','CPS','VPS','VCPS','NULL','LATEX') vectordevice = .true. case default vectordevice = .false. end select !!--set line width (0=auto based on whether device is vector or not) if (linewidth.le.0) then if (vectordevice) then print "(a)",' setting line width = 2 for '//devstring(1:ilen)//' device' call plot_slw(2) else call plot_slw(1) endif else call plot_slw(linewidth) endif linecolourthisstep = linecolour linestylethisstep = linestyle end subroutine initialise_plotting !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Internal subroutines !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine plotstep(ipos,istep,istepsonpage,irender_nomulti,icontour_nomulti,ivecplot, & iamtype,npartoftype,masstype,dat,timei,gammai,ipagechange,iadvance) use params, only:int1,maxparttypes,doub_prec use colours, only:colour_set use filenames, only:nsteps,rootname,ifileopen,tagline use exact, only:exact_solution,atstar,ctstar,sigma,iPlotExactOnlyOnPanel use toystar1D, only:exact_toystar_ACplane use toystar2D, only:exact_toystar_ACplane2D use labels, only:label,shortlabel,labelvec,iamvec,lenlabel,lenunitslabel,ih,irho,ipmass,ix,iacplane, & ipowerspec,isurfdens,itoomre,ispsound,iutherm,ipdf,icolpixmap,is_coord,labeltype,& labelzintegration,unitslabel,integrate_label,get_sink_type use limits, only:lim,get_particle_subset,lim2,lim2set use multiplot, only:multiplotx,multiploty,irendermulti,ivecplotmulti,itrans, & icontourmulti,x_secmulti,xsecposmulti,iusealltypesmulti,iplotpartoftypemulti use particle_data, only:maxpart,maxcol,icolourme use settings_data, only:numplot,ndataplots,icoords,icoordsnew,ndim,ndimV,nfreq,iRescale, & iendatstep,ntypes,UseTypeInRenderings,itracktype,itrackoffset,& required,ipartialread,xorigin,lowmemorymode,debugmode,iverbose use settings_limits, only:iadapt use settings_part, only:iexact,iplotpartoftype,imarktype,PlotOnRenderings,UseTypeInContours, & iplotline,linecolourthisstep,linestylethisstep,ifastparticleplot, & iploterrbars,ilocerrbars use settings_page, only:nacross,ndown,interactive,iaxis,usesquarexy,yscalealt,labelyalt, & charheight,iPlotTitles,vpostitle,hpostitle,fjusttitle,nstepsperpage use settings_render, only:npix,ncontours,icolours,iColourBarStyle,icolour_particles,& inormalise_interpolations,ifastrender,ilabelcont,double_rendering,& projlabelformat,iapplyprojformat use settings_vecplot, only:npixvec,iplotpartvec use settings_xsecrot, only:nxsec,irotateaxes,xsec_nomulti,irotate,flythru,use3Dperspective, & use3Dopacityrendering,writeppm,anglex,angley,anglez,zobserver,& dzscreenfromobserver,taupartdepth,xsecpos_nomulti, & xseclineX1,xseclineX2,xseclineY1,xseclineY2, & nseq,nframes,getsequencepos,insidesequence,rendersinks use settings_powerspec, only:nfreqspec,freqmin,freqmax,ipowerspecx,ipowerspecy,& idisordered,npdfbins use settings_units, only:units,unitzintegration ! !--subroutines called from this routine ! use colourparts use transforms, only:transform,transform_limits,transform_label,transform_inverse,islogged use interactive_routines use part_utils, only:get_tracked_particle,locate_first_two_of_type,get_binary use particleplots, only:particleplot,plot_errorbarsx,plot_errorbarsy use powerspectrums, only:powerspectrum,powerspec3D_sph use interpolations1D, only:interpolate1D use interpolations2D, only:interpolate2D, interpolate2D_xsec use interpolations3D, only:interpolate3D use projections3D, only:interpolate3D_projection use projections3Dgeom, only:interpolate3D_proj_geom use interpolate3D_opacity, only:interp3D_proj_opacity !,interp3D_proj_opacity_writeppm use xsections3D, only:interpolate3D_fastxsec,interpolate3D_xsec_vec use render, only:render_pix use pagesetup, only:redraw_axes use disc, only:disccalc,discplot use exactfromfile, only:exact_fromfile use exact, only:iexact_rochelobe,use_sink_data,mprim,msec,xprim,xsec use write_pixmap, only:iwritepixmap,writepixmap,write_pixmap_ppm,readpixmap use pdfs, only:pdf_calc,pdf_write use plotutils, only:plotline use geometry, only:coord_is_length use geomutils, only:changecoords,changeveccoords use legends, only:ipanelselect use plotlib, only:plot_sci,plot_page,plot_sch,plot_qci,plot_qls,plot_sls, & plot_line,plot_pt1,plotlib_is_pgplot,plotlib_supports_alpha implicit none integer, intent(inout) :: ipos, istepsonpage integer, intent(in) :: istep,irender_nomulti,icontour_nomulti,ivecplot integer(kind=int1), dimension(:), intent(in) :: iamtype integer, dimension(maxparttypes), intent(in) :: npartoftype real, dimension(maxparttypes), intent(in) :: masstype real, dimension(:,:), intent(in) :: dat real, intent(in) :: timei,gammai logical, intent(in) :: ipagechange integer, intent(inout) :: iadvance logical, dimension(maxparttypes) :: iusetype integer :: ntoti,iz,iseqpos,itrackpart integer :: i,j,k,icolumn,irow integer :: nyplot,nframesloop integer :: irenderpart integer :: npixyvec,nfreqpts,ipixxsec integer :: icolourprev,linestyleprev integer :: ierr,ipt,nplots,nyplotstart,iaxisy,iaxistemp,icol integer :: ivectemp,iamvecx,iamvecy,itransx,itransy,itemp integer :: iframe,isize,isinktype,isink1,isink2 real, parameter :: tol = 1.e-10 ! used to compare real numbers real, parameter :: error_in_log = -666. ! magic number used to flag error with log(0.) real(doub_prec) :: unit_mass, unit_r, unit_u real, dimension(:), allocatable :: xplot,yplot,zplot real, dimension(:), allocatable :: hh,weight real, dimension(:), allocatable :: renderplot real, dimension(:,:), allocatable :: vecplot real :: rkappa real :: zslicemin,zslicemax,dummy,pmassmin,pmassmax,pmassav(1) real :: pixwidth,pixwidthy,pixwidthvec,pixwidthvecy,dxfreq character(len=lenlabel+lenunitslabel) :: labelx,labely,labelz,labelrender,labelvecplot,labelcont character(len=lenunitslabel) :: labeltimeunits character(len=12) :: string logical :: iPlotColourBar, rendering, inormalise, logged, loggedcont logical :: dumxsec, isetrenderlimits, iscoordplot logical :: ichangesize, initx, inity, isameweights, volweightedpdf, got_h logical, parameter :: isperiodicx = .false. ! feature not implemented logical, parameter :: isperiodicy = .false. ! feature not implemented logical, parameter :: isperiodicz = .false. ! feature not implemented logical, dimension(maxparttypes) :: PlotonRender_tmp 34 format (25(' -')) !--set labels to blank (just in case) labelx = ' ' labely = ' ' labelz = ' ' labelrender = ' ' labelvecplot = ' ' ! !--allocate temporary memory required for plotting ! isize = max(maxpart,2000) !--do not allocate the temporary arrays if the dat array has not been allocated if (lowmemorymode .and. maxcol.eq.0) then isize = 2000 endif if (debugmode) print*,'DEBUG: in plotstep, allocating local memory...' ierr = 0 allocate(xplot(isize),stat=ierr) if (ierr /= 0) stop 'out of memory in plotstep allocating temporary x array' allocate(yplot(isize),stat=ierr) if (ierr /= 0) stop 'out of memory in plotstep allocating temporary y array' allocate(zplot(isize),stat=ierr) if (ierr /= 0) stop 'out of memory in plotstep allocating temporary z array' if (allocated(xplot)) xplot = 0. if (allocated(yplot)) yplot = 0. if (allocated(zplot)) zplot = 0. allocate(hh(maxpart),weight(maxpart),stat=ierr) if (ierr /= 0) stop 'out of memory in plotstep allocating temporary h,weight arrays' hh = 0. if (debugmode) print*,'DEBUG: in plotstep, allocated local memory successfully' dummy = 0. labeltimeunits = ' ' dumxsec = .false. isetrenderlimits = .false. k = nxsec ! matters for lastplot in page_setup for non-coord plots if (iReScale) labeltimeunits = unitslabel(0) iaxistemp = iaxis !--set the arrays needed for rendering if they are present if (ih.gt.0 .and. ih.le.ndataplots .and. (required(ih) .or. .not.ipartialread)) then hh(:) = dat(:,ih) got_h = .true. else got_h = .false. endif if (ipmass.gt.0 .and. ipmass.le.ndataplots) then if (required(ipmass)) then pmassmin = minval(dat(:,ipmass)) pmassmax = maxval(dat(:,ipmass)) else pmassmin = 0. pmassmax = 0. endif else pmassmin = minval(masstype,mask=(masstype.gt.0.)) pmassmax = maxval(masstype) pmassav = masstype(1) if (pmassav(1).le.0.) then do i=ntypes,2,-1 if (UseTypeInRenderings(i) .and. iplotpartoftype(i) .and. masstype(i).gt.0.) then pmassav = masstype(i) endif enddo endif endif ! !--set number of particles to use in the interpolation routines ! (by default, only the gas particles) ! ntoti = sum(npartoftype) ninterp = npartoftype(1) if (any(UseTypeInRenderings(2:ntypes).and.iplotpartoftype(2:ntypes)) & .or. size(iamtype).gt.1 .or. (use3Dopacityrendering .and. rendersinks)) ninterp = ntoti !--work out the identity of a particle being tracked if (debugmode) print*,'DEBUG: itracktype = ',itracktype,' itrackoffset = ',itrackoffset itrackpart = get_tracked_particle(itracktype,itrackoffset,npartoftype,iamtype) if (itrackpart.eq.0) then write(string,"(i12)") itrackoffset string = adjustl(string) if (itracktype.gt.0 .and. itracktype.le.ntypes) then print "(/,a,/)",' WARNING: tracked '//trim(labeltype(itracktype))//' particle #'//trim(string)//' not found in data' elseif (itrackoffset.gt.0) then print "(/,a,/)",' WARNING: tracked particle #'//trim(string)//' not found in data' endif else write(string,"(i12)") itrackpart print "(/,a,/)",' Tracking particle #'//trim(adjustl(string)) endif !--non-SPH particle types cannot be used in contours where (.not.UseTypeInRenderings(:)) UseTypeInContours(:) = .false. end where !--check for consistency that if particles are not plotted, ! they are also not plotted on renderings do i=1,ntypes if (.not.iplotpartoftype(i)) PlotOnRenderings(i) = .false. enddo ! !--check whether or not the particle types used for contouring are ! the same as the particle types used for rendering ! isameweights = .true. do i=1,ntypes if (UseTypeInRenderings(i) .and. & .not.(iplotpartoftype(i).eqv.UseTypeInContours(i))) isameweights = .false. enddo ! !--set weight factor for interpolation routines ! ihavesetweights = .false. if (iamrendering .or. idoingvecplot) then if (debugmode) print*,'DEBUG: setting interpolation weights...' call set_weights(weight,dat,iamtype,(iplotpartoftype .and. UseTypeInRenderings)) else if (debugmode) print*,'DEBUG: interpolation weights not set because no rendering...' endif !--set the colour table if it has not been set and particles have been coloured previously if (any(icolourme(1:ntoti).gt.16) .and. .not.ihavesetcolours) call colour_set(icolours) ! !--exclude subset of particles if parameter range restrictions are set ! call get_particle_subset(icolourme,dat,ndataplots) ! !--add a loop over frames for animation sequences ! but only generate extra frames if we are inside a sequence ! iseqpos = (ipos-1)/(nacross*ndown) + 1 !print*,' iseqpos = ',iseqpos,ipos iframe = 0 if (nseq.gt.0 .and. insidesequence(iseqpos)) then if (nacross*ndown.eq.1) then nframesloop = nframes else nframesloop = max(iframesave+1,1) iframe = iframesave !print*,'iframe=',iframesave,'iseqpos = ',iseqpos,insidesequence(iseqpos) endif else nframesloop = 1 endif if (debugmode) print*,'DEBUG: starting frame loop...' !--loop over frames: flexible to allow forwards/backwards in interactive mode over_frames: do while (iframe.lt.nframesloop) if (interactivereplot .and. ipos.eq.ifirststeponpage .and. iframe.eq.0) then iframe = min(nframefirstonpage,nframesloop) else iframe = iframe + 1 endif !print*,'iframe = ',iframe, ipagechange,nstepsperpage !--sanity check on frame number, should never happen... if (iframe.eq.0) then print*,' Internal error in iframe, setting to 1 ' iframe = 1 endif !------------------------------------- ! loop over plots per timestep ! (jump to first on the page if replotting in interactivemode) !------------------------------------- if (interactivereplot .and. ipos.eq.ifirststeponpage .and. iframe.eq.nframefirstonpage) then nyplotstart = nyplotfirstonpage ipanel = 0 else nyplotstart = 1 endif over_plots: do nyplot=nyplotstart,nyplots if (nyplot.gt.1 .or. iframe.gt.1) print 34 !--make sure character height is set correctly call plot_sch(charheight) ! in PGPLOT scaled units iPlotColourBar = .false. ! should be false by default until set to true iaxistemp = iaxis !--set current x, y, render and vector plot from multiplot array if (imulti) then iploty = multiploty(nyplot) iplotx = multiplotx(nyplot) irender = irendermulti(nyplot) ivectorplot = ivecplotmulti(nyplot) icontourplot = icontourmulti(nyplot) iplotcont = .false. !iplotcontmulti(nyplot) x_sec = x_secmulti(nyplot) zslicepos = xsecposmulti(nyplot) if (iusealltypesmulti(nyplot)) then iusetype(:) = iplotpartoftype(:) else iusetype(:) = iplotpartoftypemulti(:,nyplot) endif if (irender.gt.0 .or. icontourplot.gt.0 .or. ivectorplot.gt.0) then if (debugmode) print*,'DEBUG: resetting interpolation weights for multiplot...' call set_weights(weight,dat,iamtype,(iusetype .and. UseTypeInRenderings)) endif else if (.not.interactivereplot) irender = irender_nomulti ivectorplot = ivecplot icontourplot = icontour_nomulti iplotcont = .false. !iplotcont_nomulti if (.not.interactivereplot) x_sec = xsec_nomulti if (.not.interactivereplot .and. x_sec) zslicepos = xsecpos_nomulti iusetype(:) = iplotpartoftype(:) endif !--if the contour plot is the same as the rendered plot, ! do not interpolate twice. Instead simply plot the contours ! of the rendered quantity when plotting the render plot. if (irender.gt.0 .and. irender.le.numplot) then if (icontourplot.eq.irender .and. isameweights) then icontourplot = 0 iplotcont = .true. !print "(a)",' contouring same as rendering' elseif (icolours.eq.0) then iplotcont = .true. endif else !--contours not allowed if not rendering ! (because this can be achieved by rendering with colour scheme 0) icontourplot = 0 endif !--flag to indicate that we have actually got the contoured quantity, ! set to true once interpolation has been done. if (.not.interactivereplot .or. irerender) gotcontours = .false. if (icolour_particles) then irenderpart = irender irenderplot = 0 else irenderpart = 0 irenderplot = irender endif if (ivectorplot.gt.0) iplotpart = iplotpartvec !--if replotting in interactive mode, use the temporarily stored plot limits ! (check iplot values are sensible though, otherwise will seg fault here) if (interactivereplot .and. (nacross*ndown.gt.1 .or. iploty.gt.ndataplots)) then if (iplotx.gt.0 .and. iplotx.le.numplot) then xmin = xminmulti(iplotx) xmax = xmaxmulti(iplotx) endif if (iploty.gt.0 .and. iploty.le.numplot) then ymin = xminmulti(iploty) ymax = xmaxmulti(iploty) endif if (irender.gt.0 .and. irender.le.numplot) then rendermin = xminmulti(irender) rendermax = xmaxmulti(irender) if (icontourplot.gt.0 .and. icontourplot.le.numplot) then contmin = xminmulti(icontourplot) contmax = xmaxmulti(icontourplot) endif endif endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! initialisation for plots of particle data ! copy from main dat array into xplot, yplot ! also set labels and plot limits !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! initx = (iplotx.gt.0 .and. iplotx.le.ndataplots) inity = (iploty.gt.0 .and. iploty.le.ndataplots) if (iplotx.gt.0 .and. iplotx.le.numplot) labelx = label(iplotx) if (iploty.gt.0 .and. iploty.le.numplot) labely = label(iploty) iscoordplot = (is_coord(iplotx,ndim) .and. is_coord(iploty,ndim)) initdataplots: if (initx .or. inity) then if (debugmode) print*,'DEBUG: initialising data plots...',initx,inity,iplotx,iploty,ntoti,size(xplot) if (initx) then !--check for errors if (iplotx.gt.size(dat(1,:)) .or. iplotx.lt.1) then print*,'ERROR: Internal error with out-of-bounds x column = ',iplotx exit over_plots endif xplot(1:ntoti) = dat(1:ntoti,iplotx) iamvecx = iamvec(iplotx) else iamvecx = 0 endif if (inity) then !--check for errors if (iploty.gt.size(dat(1,:)) .or. iploty.lt.1) then print*,'ERROR: Internal error with out-of-bounds y column = ',iploty exit over_plots endif yplot(1:ntoti) = dat(1:ntoti,iploty) iamvecy = iamvec(iploty) else iamvecy = 0 endif if (debugmode) print*,'DEBUG: setting itrans...' itransx = 0 itransy = 0 if (iplotx.gt.0 .and. iplotx.le.numplot) itransx = itrans(iplotx) if (iploty.gt.0 .and. iploty.le.numplot) itransy = itrans(iploty) zplot = 0. !--set later if x-sec zslicemin = -huge(zslicemax) !-- " " zslicemax = huge(zslicemax) if (.not.interactivereplot) then ! if (iplotx.gt.0 .and. iplotx.le.numplot .and. ipos.eq.ifirststeponpage) then if (iplotx.gt.0 .and. iplotx.le.numplot) then xmin = lim(iplotx,1) xmax = lim(iplotx,2) endif ! if (iploty.gt.0 .and. iploty.le.numplot .and. ipos.eq.ifirststeponpage) then if (iploty.gt.0 .and. iploty.le.numplot) then ymin = lim(iploty,1) ymax = lim(iploty,2) endif angletempx = anglex angletempy = angley angletempz = anglez if (ndim.eq.3 .and. use3Dperspective) then dzscreentemp = dzscreenfromobserver zobservertemp = zobserver taupartdepthtemp = taupartdepth else dzscreentemp = 0. zobservertemp = 0. taupartdepthtemp = 0. endif else if (ndim.eq.3 .and. use3Dperspective) dzscreentemp = zobservertemp endif ! !--flag for whether or not we have raw particle plot or not ! (not allowed to use transformations on coords otherwise) ! rendering = (iscoordplot .and.(irenderplot.gt.0 .or. ivectorplot.gt.0) & .and.(.not.icolour_particles)) ! !--change coordinate system if relevant ! if (icoordsnew.ne.icoords) then !--do this if one is a coord but not if rendering call changecoords(iplotx,iploty,xplot,yplot,ntoti,ndim,itrackpart,dat) if (iamvecx.gt.0) call changeveccoords(iplotx,xplot,ntoti,ndim,itrackpart,dat) if (iamvecy.gt.0) call changeveccoords(iploty,yplot,ntoti,ndim,itrackpart,dat) endif !--apply transformations (log, 1/x etc) if appropriate ! also change labels and limits appropriately if (.not.(rendering)) then if (itransx.ne.0) call applytrans(xplot,xmin,xmax,labelx,itransx,'x',iplotx,iaxis,interactivereplot) if (itransy.ne.0) call applytrans(yplot,ymin,ymax,labely,itransy,'y',iploty,iaxis,interactivereplot) endif !--write username, date on plot ! if (nacross.le.2.and.ndown.le.2) call pgiden ! !--adjust plot limits if adaptive plot limits set ! (find minimum/maximum only on particle types actually plotted) ! if (itrackpart.le.0 .and. .not.(iscoordplot .and. irotate)) then if (initx) call adapt_limits(iplotx,xplot,xmin,xmax,xminadapti,xmaxadapti,'x',& iamtype,ntoti,npartoftype,iusetype,ipagechange) if (inity) call adapt_limits(iploty,yplot,ymin,ymax,yminadapti,ymaxadapti,'y',& iamtype,ntoti,npartoftype,iusetype,ipagechange) endif !!-reset co-ordinate plot limits if particle tracking if (itrackpart.gt.0 .and. .not.interactivereplot) then if (initx) call settrackinglimits(itrackpart,iplotx,xplot,xmin,xmax) if (inity) call settrackinglimits(itrackpart,iploty,yplot,ymin,ymax) endif !--override settings based on positions in sequence if (nseq.gt.0) then call getsequencepos(iseqpos,iframe,iplotx,iploty,irender, & angletempx,angletempy,angletempz,zobservertemp,dzscreentemp,taupartdepthtemp,& zslicepos,xmin,xmax,ymin,ymax,rendermin,rendermax,isetrenderlimits) endif !--for 3D perspective, do not plot particles behind the observer if (ndim.eq.3.and.use3Dperspective) then dzscreenfromobserver = zobserver zslicemax = zobservertemp if (use3Dopacityrendering) rkappa = rkappafac/taupartdepthtemp endif endif initdataplots !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! plots with co-ordinates as x and y axis !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (iscoordplot) then if (debugmode) print*,'DEBUG: starting coord plot...' if (.not.interactivereplot .or. irerender) then npixx = npix if (npixx.le.0) npixx = 500 ! default for other uses of npixx if auto pixels are used endif !!--page setup preliminaries if (usesquarexy) then just = 1 ! x and y axis have same scale ! unless 1D xsec through 2D data or non-cartesian if ((irender.gt.ndim .and. ndim.eq.2 .and. x_sec) & .or.(icoordsnew.gt.1 .and. .not.(coord_is_length(iplotx,icoordsnew) & .and. coord_is_length(iploty,icoordsnew)))) then just = 0 endif else just = 0 endif !--work out if colour bar is going to be plotted ! (leave space in page setup if so) iPlotColourBar = .false. if (irender.gt.ndim .and..not.(ndim.eq.2.and.x_sec)) iPlotColourBar = (iColourBarStyle.gt.0) !!--work out coordinate that is not being plotted iz = 0 if (ndim.ge.3) then do j=1,ndim if ((iplotx.ne.iploty).and. & (ix(j).ne.iplotx).and.(ix(j).ne.iploty)) iz = ix(j) enddo endif iplotz = iz ! this is used as cross sectioned quantity if (iplotz.gt.0 .and. iplotz.le.ndataplots) then zplot(1:ntoti) = dat(1:ntoti,iplotz) labelz = label(iplotz) endif if (debugmode) print*,'DEBUG: iplotz = ',iplotz if (.not.interactivereplot) then irerender = .false. endif ! !--rotate the particles about the z (and y and x) axes ! only applies to particle plots at the moment ! if (ndim.ge.2 .and. (irotate .or. (ndim.eq.3 .and.use3Dperspective)) & .and. icoordsnew.eq.1) then if ((irotate .and. (angletempx.gt.tiny(0.) .or. angletempy.gt.tiny(0.))) & .or.(ndim.eq.3 .and.use3Dperspective .and. dzscreentemp.gt.tiny(0.))) then if (iaxis.ge.0) iaxistemp = -3 endif ivectemp = 0 !--for vector plots with rotation, need to allocate temporary ! arrays to hold the rotated vector components if (ivectorplot.gt.0) then ichangesize = .false. if (allocated(vecplot)) then if (size(vecplot(1,:)).lt.ninterp) ichangesize = .true. endif if (.not.allocated(vecplot) .or. ichangesize) then if (allocated(vecplot)) deallocate(vecplot) allocate(vecplot(ndim,ninterp),stat=ierr) if (ierr /= 0) then print "(a)",' ERROR allocating memory for vector plot + rotation ' stop endif endif ivectemp = ivectorplot endif call rotationandperspective(angletempx,angletempy,angletempz,dzscreentemp,zobservertemp, & xplot,yplot,zplot,ntoti,iplotx,iploty,iplotz,dat,ivectemp,vecplot,itrackpart) !--adapt plot limits after rotations have been done if (.not.interactivereplot) then call adapt_limits(iplotx,xplot,xmin,xmax,xminadapti,xmaxadapti,'x',& iamtype,ntoti,npartoftype,iusetype,ipagechange) call adapt_limits(iploty,yplot,ymin,ymax,yminadapti,ymaxadapti,'y',& iamtype,ntoti,npartoftype,iusetype,ipagechange) endif !!-reset co-ordinate plot limits if particle tracking if (itrackpart.gt.0 .and. .not.interactivereplot) then call settrackinglimits(itrackpart,iplotx,xplot,xmin,xmax) call settrackinglimits(itrackpart,iploty,yplot,ymin,ymax) endif endif !------------------------------------------------------------------ ! rendering setup and interpolation (this is the rendering done ! *before* the cross sections are taken, e.g. to 3D grid) !------------------------------------------------------------------ if ((irenderplot.gt.ndim).and. & ((ndim.eq.3).or.(ndim.eq.2.and..not.x_sec))) then !!--determine number of pixels in rendered image (npix = pixels in x direction) if (npix.gt.0) then npixx = npix call page_setup(dummy=.true.) ! do this here in case limits are auto-adjusted pixwidth = (xmax-xmin)/real(npix) if (just.eq.1) then pixwidthy = pixwidth else pixwidthy = pixwidth*(ymax-ymin)/(xmax - xmin) endif else !!--automatically reset the pixel number to match the device call page_setup(dummy=.true.) !--npixx and npixy are determined here pixwidth = (xmax-xmin)/real(npixx) if (just.eq.1) then pixwidthy = pixwidth else pixwidthy = (ymax-ymin)/real(npixy) endif endif npixx = max(int((1. - epsilon(0.))*(xmax-xmin)/pixwidth) + 1,1) npixy = max(int((1. - epsilon(0.))*(ymax-ymin)/pixwidthy) + 1,1) !!--only need z pixels if working with interpolation to 3D grid ! (then number of z pixels is equal to number of cross sections) if ((ndim.ge.3).and.(x_sec.and.nxsec.gt.2)) then zmin = lim(iplotz,1) npixz = nxsec endif if (.not.interactivereplot .or. irerender) then if (allocated(datpix)) then if (npixx.ne.size(datpix(:,1)) .or. npixy.ne.size(datpix(1,:))) then deallocate(datpix) allocate (datpix(npixx,npixy)) if (ndim.eq.3 .and. use3Dperspective .and. use3Dopacityrendering) then if (allocated(brightness)) deallocate(brightness) allocate(brightness(npixx,npixy)) endif if (icontourplot.gt.ndim) then if (allocated(datpixcont)) deallocate(datpixcont) allocate(datpixcont(npixx,npixy)) endif endif else allocate (datpix(npixx,npixy)) if (ndim.eq.3 .and. use3Dperspective .and. use3Dopacityrendering) then if (allocated(brightness)) deallocate(brightness) allocate(brightness(npixx,npixy)) endif if (icontourplot.gt.ndim) then if (allocated(datpixcont)) deallocate(datpixcont) allocate(datpixcont(npixx,npixy)) endif endif select case(ndim) case(2) !!--interpolate to 2D grid !! allocate memory for rendering array if (.not. x_sec) then call interpolate2D(xplot(1:ninterp),yplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,irenderplot), & icolourme(1:ninterp),ninterp,xmin,ymin,datpix,npixx,npixy, & pixwidth,pixwidthy,inormalise,isperiodicx,isperiodicy) !--also get contour plot data if (icontourplot.gt.0 .and. icontourplot.le.numplot) then if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) call interpolate2D(xplot(1:ninterp),yplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,icontourplot), & icolourme(1:ninterp),ninterp,xmin,ymin,datpixcont,npixx,npixy, & pixwidth,pixwidthy,inormalise,isperiodicx,isperiodicy) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif endif case(3) !!--interpolation to 3D grid - then take multiple cross sections/projections !! do this if taking more than 2 cross sections, otherwise use fast xsec if (x_sec.and.nxsec.gt.2) then !!--allocate memory for 3D rendering array if (allocated(datpix3D)) deallocate(datpix3D) allocate ( datpix3D(npixx,npixy,npixz) ) !!--interpolate from particles to 3D grid call interpolate3D(xplot(1:ninterp),yplot(1:ninterp), & zplot(1:ninterp),hh(1:ninterp),weight(1:ninterp), & dat(1:ninterp,irenderplot),icolourme(1:ninterp), & ninterp,xmin,ymin,zmin,datpix3D,npixx,npixy,npixz,pixwidth,dz, & inormalise,isperiodicx,isperiodicy,isperiodicz) if (icontourplot.gt.0 .and. icontourplot.le.numplot) then !!--allocate memory for 3D contouring array if (allocated(datpixcont3D)) deallocate(datpixcont3D) allocate ( datpixcont3D(npixx,npixy,npixz) ) if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) !!--interpolate from particles to 3D grid call interpolate3D(xplot(1:ninterp),yplot(1:ninterp), & zplot(1:ninterp),hh(1:ninterp),weight(1:ninterp), & dat(1:ninterp,icontourplot),icolourme(1:ninterp), & ninterp,xmin,ymin,zmin,datpixcont3D,npixx,npixy,npixz,pixwidth,dz, & inormalise,isperiodicx,isperiodicy,isperiodicz) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif endif end select endif endif ! !--if vector plot determine whether or not to plot the particles as well ! iplotpart = .true. if (ivectorplot.gt.0) iplotpart = iplotpartvec if (irenderplot.gt.0) iplotpart = .false. ! !%%%%%%%%%%%%%%% loop over cross-section slices %%%%%%%%%%%%%%%%%%%%%%% ! over_cross_sections: do k=1,nxsec if (k.gt.1) print 34 if (x_sec) then !!--for multislice cross section (flythru) !! increment the position of the current cross section slice if (flythru) zslicepos = zslicepos + dz !!--for cross sections of particle plots, need range of co-ordinates in which !! particles may lie zslicemin = zslicepos-0.5*dz zslicemax = zslicepos+0.5*dz endif !------------take projections/cross sections through 3D data-----------------! if (irenderplot.gt.0 .and. ndim.eq.3) then !!--allocate memory for 2D rendered array if (.not.interactivereplot) then if (allocated(datpix)) then if (npixx.ne.size(datpix(:,1)) .or. npixy.ne.size(datpix(1,:))) then deallocate(datpix) if (debugmode) print*,'reallocating datpix...' allocate ( datpix(npixx,npixy) ) endif else if (debugmode) print*,'allocating datpix...' allocate ( datpix(npixx,npixy) ) endif if (icontourplot.gt.ndim) then if (allocated(datpixcont)) then if (npixx.ne.size(datpixcont(:,1)) .or. npixy.ne.size(datpixcont(1,:))) then deallocate(datpixcont) if (debugmode) print*,'reallocating datpixcont...' allocate ( datpixcont(npixx,npixy) ) endif else if (debugmode) print*,'allocating datpixcont...' allocate ( datpixcont(npixx,npixy) ) endif endif endif !------------------------------------------------------------------------ ! if we have rendered to a 3D grid, take cross sections from this array !------------------------------------------------------------------------ if (x_sec .and. nxsec.gt.2) then ipixxsec = int(0.99999*(zslicepos-zmin)/dz) + 1 if (ipixxsec.gt.npixz) ipixxsec = npixz print*,TRIM(label(iplotz)),' = ',zslicepos, & ' cross section, pixel ',ipixxsec datpix = datpix3D(:,:,ipixxsec) ! slices are in 3rd dimension if (gotcontours) then datpixcont = datpixcont3D(:,:,ipixxsec) endif else !------------------------------------------------------------------- ! or do a fast projection/cross section of 3D data to 2D array !------------------------------------------------------------------- !--only rerender if absolutely necessary if (.not.interactivereplot .or. irerender) then if (x_sec) then if (use3Dperspective .and. use3Dopacityrendering) then !!--do surface-rendered cross-section with opacity if (iverbose > 0) print*,trim(label(ix(iplotz))),' = ',zslicepos, & ' : opacity-rendered cross section', xmin,ymin if (ipmass.gt.0) then if (icontourplot.gt.0 .and. icontourplot.le.numplot) then if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & dat(1:ninterp,ipmass),ninterp,hh(1:ninterp),weight(1:ninterp),& dat(1:ninterp,icontourplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpixcont,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,zslicepos) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & dat(1:ninterp,ipmass),ninterp,hh(1:ninterp),weight(1:ninterp), & dat(1:ninterp,irenderplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpix,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,zslicepos) else if (icontourplot.gt.0 .and. icontourplot.le.numplot) then if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & pmassav,1,hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,icontourplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpixcont,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,zslicepos) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & pmassav,1,hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,irenderplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpix,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,zslicepos) endif elseif (use3Dperspective) then print*,'ERROR: X_SEC WITH 3D PERSPECTIVE NOT IMPLEMENTED' datpix = 0. else !!--do fast cross-section if (iverbose > 0) print*,trim(label(ix(iplotz))),' = ',zslicepos, & ' : fast cross section', xmin,ymin call interpolate3D_fastxsec( & xplot(1:ninterp),yplot(1:ninterp), & zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,irenderplot),icolourme(1:ninterp), & ninterp,xmin,ymin,zslicepos,datpix,npixx,npixy,pixwidth, & pixwidthy,inormalise) !!--same but for contour plot if (icontourplot.gt.0 .and. icontourplot.le.numplot) then if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) call interpolate3D_fastxsec( & xplot(1:ninterp),yplot(1:ninterp), & zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,icontourplot),icolourme(1:ninterp), & ninterp,xmin,ymin,zslicepos,datpixcont,npixx,npixy,pixwidth, & pixwidthy,inormalise) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif endif else if (use3Dperspective .and. use3Dopacityrendering) then !!--do fast projection with opacity if (ipmass.gt.0) then !--contour plot first if (icontourplot.gt.0 .and. icontourplot.le.numplot) then if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & dat(1:ninterp,ipmass),ninterp,hh(1:ninterp),weight(1:ninterp),& dat(1:ninterp,icontourplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpixcont,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,huge(zslicepos)) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & dat(1:ninterp,ipmass),ninterp,hh(1:ninterp),& weight(1:ninterp),dat(1:ninterp,irenderplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpix,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,huge(zslicepos)) else !--do contour plot first so brightness corresponds to render plot if (icontourplot.gt.0 .and. icontourplot.le.numplot) then if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & pmassav,1,hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,irenderplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpixcont,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,huge(zslicepos)) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif call interp3D_proj_opacity( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & pmassav,1,hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,irenderplot), & dat(1:ninterp,iz),icolourme(1:ninterp), & ninterp,xmin,ymin,datpix,brightness,npixx,npixy,pixwidth,zobservertemp, & dzscreentemp,rkappa,huge(zslicepos)) endif else !!--do fast projection of z integrated data (e.g. column density) if (icoordsnew.ne.icoords) then call interpolate3D_proj_geom( & dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),dat(1:ninterp,ix(3)), & hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,irenderplot), & icolourme(1:ninterp),ninterp,xmin,ymin,datpix,npixx,npixy,pixwidth, & pixwidthy,inormalise,icoordsnew,iplotx,iploty,iplotz,ix) else call interpolate3D_projection( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,irenderplot), & icolourme(1:ninterp),ninterp,xmin,ymin,datpix,npixx,npixy,pixwidth, & pixwidthy,inormalise,zobservertemp,dzscreentemp,ifastrender) endif !!--same but for contour plot if (icontourplot.gt.0 .and. icontourplot.le.numplot) then if (.not.isameweights) & ! set contouring weights as necessary call set_weights(weight,dat,iamtype,UseTypeInContours) call interpolate3D_projection( & xplot(1:ninterp),yplot(1:ninterp),zplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,icontourplot), & icolourme(1:ninterp),ninterp,xmin,ymin,datpixcont,npixx,npixy,pixwidth, & pixwidthy,inormalise,zobservertemp,dzscreentemp,ifastrender) gotcontours = .true. if (.not.isameweights) & ! reset weights call set_weights(weight,dat,iamtype,UseTypeInRenderings) endif !!--adjust the units of the z-integrated quantity if (iRescale .and. units(ih).gt.0. .and. .not.inormalise) then datpix = datpix*(unitzintegration/units(ih)) if (gotcontours) then datpixcont = datpixcont*(unitzintegration/units(ih)) endif endif endif endif endif endif ! whether 3D grid or fast renderings !-------------take cross sections through 2D data------------------! elseif (irenderplot.gt.0 .and. ndim.eq.2 .and. x_sec) then !------------------------------------------------------------------- ! or do a fast cross section through 2D data to 1D array !------------------------------------------------------------------- !!--interpolate from 2D data to 1D line !! line is specified by giving two points, (x1,y1) and (x2,y2) !--set up 1D grid and allocate memory for datpix1D if (.not.interactivereplot) then xmin = 0. ! distance (r) along cross section xmax = SQRT((xseclineY2-xseclineY1)**2 + (xseclineX2-xseclineX1)**2) endif dxgrid = (xmax-xmin)/REAL(npixx) call set_grid1D(xmin,dxgrid,npixx) call interpolate2D_xsec( & dat(1:ninterp,iplotx),dat(1:ninterp,iploty),& hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,irenderplot), & icolourme(1:ninterp),ninterp,xseclineX1,xseclineY1,xseclineX2,xseclineY2, & datpix1D,npixx,inormalise) ! !--find limits of datpix1D for plotting ! do transformations on rendered array where appropriate ! set these as ymin,ymax and set labels of plot ! call transform(datpix1D,itrans(irenderplot)) labely = transform_label(label(irenderplot),itrans(irenderplot)) if (abs(xseclineY2-xseclineY1).gt.epsilon(0.)) then labelx = 'cross section' ! only if cross-section is oblique (otherwise keep x axis label) endif !!--if adaptive limits, find limits of datpix if (.not.interactivereplot) then ymin = minval(datpix1D) ymax = maxval(datpix1D) xminadapt(irenderplot) = min(ymin,xminadapt(irenderplot)) xmaxadapt(irenderplot) = max(ymax,xmaxadapt(irenderplot)) if (iadapt) then print*,' adapting y limits' else !!--or use fixed limits and apply transformations ymin = lim(irenderplot,1) ymax = lim(irenderplot,2) call transform_limits(ymin,ymax,itrans(irenderplot)) endif endif endif ! 2 or 3D and rendering !------------------------------------------------------------------ ! apply transformations to, and find limits for the 2D ! pixel array datpix resulting from the interpolation operations ! do this *before* the page setup so that rendermin,max ! can be stored in page_setup for interactive plots !------------------------------------------------------------------ if (irenderplot.gt.0 .and. irenderplot.le.numplot) then if (ndim.eq.3 .or. (ndim.eq.2 .and..not.x_sec)) then !!--determine whether rendered quantity is logged or not logged = islogged(itrans(irenderplot)) if (gotcontours) then loggedcont = islogged(itrans(icontourplot)) else loggedcont = .false. endif !!--do transformations on rendered array (but only the first time!) if (.not.interactivereplot .or. irerender) then if (logged) then !!--if log, then set zero values to some large negative number ! but exclude this value from adaptive limits determination call transform(datpix,itrans(irenderplot),errval=error_in_log) else call transform(datpix,itrans(irenderplot)) endif if (gotcontours) then if (loggedcont) then call transform(datpixcont,itrans(icontourplot),errval=error_in_log) else call transform(datpixcont,itrans(icontourplot)) endif endif endif !!--set label for rendered quantity labelrender = label(irenderplot) if (gotcontours) labelcont = label(icontourplot) !!--set label for column density (projection) plots if (ndim.eq.3 .and..not. x_sec .and..not.(use3Dperspective.and.use3Dopacityrendering)) then labelrender = integrate_label(labelrender,irender,iz,inormalise,iRescale,& labelzintegration,projlabelformat,iapplyprojformat) if (gotcontours) labelcont = integrate_label(labelcont,icontourplot,iz,inormalise,& iRescale,labelzintegration,projlabelformat,iapplyprojformat) endif !!--apply transformations to the label(s) for the rendered and contoured quantit(y,ies) labelrender = transform_label(labelrender,itrans(irenderplot)) if (gotcontours) labelcont = transform_label(labelcont,itrans(icontourplot)) !!--limits for rendered quantity if (.not.interactivereplot .or. irerender) then !!--find (adaptive) limits of rendered array if (logged) then renderminadapt = minval(datpix,mask=abs(datpix-error_in_log).gt.tiny(datpix)) ! see above else renderminadapt = minval(datpix) endif rendermaxadapt = maxval(datpix) !--fix case where no limits are set due to NaNs etc. if (renderminadapt.gt.rendermaxadapt) then print "(a)",' WARNING: NaNs in rendered quantity' renderminadapt = 0. rendermaxadapt = 0. endif if (gotcontours) then if (loggedcont) then contminadapt = minval(datpixcont,mask=abs(datpixcont+666.).gt.tiny(datpixcont)) else contminadapt = minval(datpixcont) endif contmaxadapt = maxval(datpixcont) !--fix case where no limits are set due to NaNs etc. if (contminadapt.gt.contmaxadapt) then print "(a)",' WARNING: NaNs in contoured quantity' contminadapt = 0. contmaxadapt = 1. endif endif if (.not.interactivereplot .and. .not.isetrenderlimits) then if (iadapt) then print*,'adapting render limits' rendermin = renderminadapt rendermax = rendermaxadapt else !!--or apply transformations to fixed limits rendermin = lim(irenderplot,1) rendermax = lim(irenderplot,2) call transform_limits(rendermin,rendermax,itrans(irenderplot)) endif if (gotcontours) then if (iadapt) then print*,'adapting contour limits' contmin = contminadapt contmax = contmaxadapt elseif (icontourplot.eq.irenderplot .and. lim2set(icontourplot)) then contmin = lim2(icontourplot,1) contmax = lim2(icontourplot,2) call transform_limits(contmin,contmax,itrans(icontourplot)) else contmin = lim(icontourplot,1) contmax = lim(icontourplot,2) call transform_limits(contmin,contmax,itrans(icontourplot)) endif endif endif endif if (iplotcont .and. .not.gotcontours) then ! ! this is the case where contoured quantity=rendered quantity ! don't need to recalculate the pixel array but limits can be independent ! => do this even during interactive replotting as rendermin,max can be changed ! but contour limits should copy changes unless separate contour limits are set ! contmin = rendermin contmax = rendermax if (lim2set(irenderplot) .and. .not.iadapt) then contmin = lim2(irenderplot,1) contmax = lim2(irenderplot,2) call transform_limits(contmin,contmax,itrans(irenderplot)) endif endif !! do not let max=0 on log plots as this is suspiciously wrong if (logged) then if (iadapt .and. abs(rendermax).lt.tiny(datpix)) then !!print*,'max=0 on log plot, fixing' rendermax = maxval(datpix) endif endif if (gotcontours .and. loggedcont) then if (iadapt .and. abs(contmax).lt.tiny(datpixcont)) then contmax = maxval(datpixcont) endif endif endif !------------------------------------------------------------------------- ! similar but where particle colouring is used instead of interpolation !------------------------------------------------------------------------- elseif (irenderpart.gt.0 .and. iplotpart) then !--allocate memory for particle colouring if (.not.allocated(renderplot)) then allocate(renderplot(ntoti),stat=ierr) if (ierr /= 0) stop 'error allocating temporary array for particle colouring' endif !--apply transformations to render array and set label renderplot(1:ntoti) = dat(1:ntoti,irenderpart) call transform(renderplot(1:ntoti),itrans(irenderpart)) labelrender = label(irenderpart) labelrender = transform_label(labelrender,itrans(irenderpart)) call adapt_limits(irenderpart,renderplot(1:ntoti),rendermin,rendermax, & renderminadapt,rendermaxadapt,trim(labelrender),& iamtype,ntoti,npartoftype,iusetype,ipagechange) !!--limits for rendered quantity if (.not.interactivereplot .and. .not.isetrenderlimits) then !!--find (adaptive) limits of rendered array ! (note: something may be not quite right here with adapt during anim sequences) if (iadapt) then rendermin = renderminadapt rendermax = rendermaxadapt else !!--use fixed limits and apply transformations rendermin = lim(irenderpart,1) rendermax = lim(irenderpart,2) call transform_limits(rendermin,rendermax,itrans(irenderpart)) endif endif ! !--actually colour the particles ! call colour_particles(renderplot(1:ntoti), & rendermin,rendermax,icolourme(1:ntoti),ntoti) !--deallocate memory if (allocated(renderplot)) deallocate(renderplot) endif !------------------------------------------------------------------------- ! similarly, get limits to be used in the vector plot so we can store ! them during page_setup for interactive plots !------------------------------------------------------------------------- if (ivectorplot.ne.0 .and. ndim.ge.2) then if (iamvec(ivectorplot).ne.0) then !!--choose quantity to be plotted ivecx = iamvec(ivectorplot) + iplotx - 1 ivecy = iamvec(ivectorplot) + iploty - 1 if (.not.interactivereplot) then ! not if vecmax changed interactively if (iadapt) then vecmax = -1.0 ! plot limits then set in vectorplot else vecmax = max(lim(ivecx,2),lim(ivecy,2)) endif endif endif endif !-----end of preliminary muff for 2D/3D cross sections/renderings ------------------ !--------------------------------- ! setup page !--------------------------------- call page_setup !--add to log if (x_sec.and.iplotpart .and. iplotz.gt.0 .and. iverbose > 1) then print "(' cross section: ',a1,' = ',f7.3,' to ',a1,' = ',f7.3)",& label(iplotz),zslicemin,label(iplotz),zslicemax endif !------------------------------ ! now actually plot the data !------------------------------ if (irenderplot.gt.0) then if ((ndim.eq.3).or.(ndim.eq.2.and. .not.x_sec)) then !!--call subroutine to actually render the image if (gotcontours .and. double_rendering) then !--if double rendering, plot first image in greyscale call render_pix(datpix,rendermin,rendermax,trim(labelrender), & npixx,npixy,xmin,ymin,pixwidth,pixwidthy, & 1,iplotcont,0,ncontours,.false.,ilabelcont,contmin,contmax) else if (use3Dperspective .and. use3Dopacityrendering .and. ndim.eq.3 .and. writeppm) then call render_pix(datpix,rendermin,rendermax,trim(labelrender), & npixx,npixy,xmin,ymin,pixwidth,pixwidthy, & icolours,iplotcont,0,ncontours,.false.,ilabelcont,contmin,contmax,alpha=brightness) else call render_pix(datpix,rendermin,rendermax,trim(labelrender), & npixx,npixy,xmin,ymin,pixwidth,pixwidthy, & icolours,iplotcont,0,ncontours,.false.,ilabelcont,contmin,contmax) endif endif !!--contour/2nd render plot of different quantity on top of 1st rendering if (gotcontours) then if (double_rendering) then call render_pix(datpixcont,contmin,contmax,trim(labelcont), & npixx,npixy,xmin,ymin,pixwidth,pixwidthy,icolours,.false.,& 0,ncontours,.false.,ilabelcont,transparent=.true.) else call render_pix(datpixcont,contmin,contmax,trim(labelcont), & npixx,npixy,xmin,ymin,pixwidth,pixwidthy,0,.true.,0,ncontours,& .false.,ilabelcont) endif endif PlotOnRender_tmp(:) = PlotOnRenderings(:) isinktype = get_sink_type(ntypes) if (use3Dperspective .and. use3Dopacityrendering .and. rendersinks .and. isinktype > 0) then PlotOnRender_tmp(isinktype) = .false. endif !!--write ppm if interpolate3D_opacity if ((.not. plotlib_supports_alpha) .and. & (use3Dperspective .and. use3Dopacityrendering .and. ndim.eq.3 .and. writeppm)) then !!--plot non-gas particle types (e.g. sink particles) on top (and to ppm) call particleplot(xplot(1:ntoti),yplot(1:ntoti), & zplot(1:ntoti),hh(1:ntoti),ntoti,iplotx,iploty, & icolourme(1:ntoti),iamtype,npartoftype(:),PlotOnRender_tmp(:), & (x_sec.or.use3Dperspective),zslicemin,zslicemax,labelz, & xmin,xmax,ymin,ymax,ifastparticleplot,datpix,npixx,npixy,rendermax,brightness) call write_pixmap_ppm(datpix,npixx,npixy,xmin,ymin,pixwidth,rendermin,rendermax, & trim(labelrender),((istep-1)*nframesloop + iframe),brightness) !!--dump pixmap to file if option set elseif (iwritepixmap) then !!--plot non-gas particle types (e.g. sink particles) on top (and to ppm) call particleplot(xplot(1:ntoti),yplot(1:ntoti), & zplot(1:ntoti),hh(1:ntoti),ntoti,iplotx,iploty, & icolourme(1:ntoti),iamtype,npartoftype(:),PlotOnRender_tmp(:), & (x_sec.or.use3Dperspective),zslicemin,zslicemax,labelz, & xmin,xmax,ymin,ymax,ifastparticleplot,datpix,npixx,npixy,rendermax) call writepixmap(datpix,npixx,npixy,xmin,ymin,pixwidth,rendermin,rendermax,labelrender,& unitslabel(irenderplot),((istep-1)*nframesloop + iframe),x_sec,rootname(ifileopen)) !!--no ppm write else !!--plot non-gas particle types (e.g. sink particles) on top call particleplot(xplot(1:ntoti),yplot(1:ntoti), & zplot(1:ntoti),hh(1:ntoti),ntoti,iplotx,iploty, & icolourme(1:ntoti),iamtype,npartoftype(:),PlotOnRender_tmp(:), & (x_sec.or.use3Dperspective),zslicemin,zslicemax,labelz, & xmin,xmax,ymin,ymax,ifastparticleplot) endif elseif (ndim.eq.2 .and. x_sec) then !--------------------------------------------------------------- ! plot 1D cross section through 2D data (contents of datpix) !--------------------------------------------------------------- call plot_line(npixx,xgrid,datpix1D) endif else !----------------------- ! particle plots !----------------------- if (iplotpart) then if (debugmode .and. size(icolourme).ge.10) & print*,'DEBUG: starting particle plot with ',ntoti,' particles ',& zplot(1:10),icolourme(1:10),npartoftype(:),iusetype(:) !!--plot all particle types call particleplot(xplot(1:ntoti),yplot(1:ntoti), & zplot(1:ntoti),hh(1:ntoti),ntoti,iplotx,iploty, & icolourme(1:ntoti),iamtype,npartoftype(:),iusetype(:), & (x_sec.or.use3Dperspective),zslicemin,zslicemax,labelz, & xmin,xmax,ymin,ymax,ifastparticleplot) else !!--plot non-gas particle types on top of vector plots (e.g. sinks) call particleplot(xplot(1:ntoti),yplot(1:ntoti), & zplot(1:ntoti),hh(1:ntoti),ntoti,iplotx,iploty, & icolourme(1:ntoti),iamtype,npartoftype(:),PlotOnRenderings(:), & (x_sec.or.use3Dperspective),zslicemin,zslicemax,labelz, & xmin,xmax,ymin,ymax,ifastparticleplot) endif endif !-------------------------------------------------------------- ! vector maps (can be on top of particle plots and renderings) !-------------------------------------------------------------- if (ivecx.gt.0 .and. ivecy.gt.0 .and. ivectorplot.gt.0) then if (iRescale) then labelvecplot = trim(labelvec(ivectorplot))//trim(unitslabel(ivectorplot)) else labelvecplot = trim(labelvec(ivectorplot)) endif !!--set label for projection plots (2268 or 2412 for integral sign) if (ndim.eq.3 .and..not. x_sec) then if (iRescale) then labelvecplot = '\(2268) '//trim(labelvecplot)//' d'// & trim(label(iz)(1:index(label(iz),unitslabel(iz))-1))//' [code units]' else labelvecplot = '\(2268) '//trim(labelvecplot)//' d'//trim(label(iz)) endif endif pixwidthvec = (xmax-xmin)/real(npixvec) if (just.eq.1) then pixwidthvecy = pixwidthvec !(xmax-xmin)/real(npixvec) else pixwidthvecy = pixwidthvec endif npixyvec = int(0.999*(ymax-ymin)/pixwidthvecy) + 1 pixwidth = (xmax-xmin)/real(npixx) ! used in synchrotron plots if (.not.ihavesetweights) then call set_weights(weight,dat,iamtype,(iusetype.and.UseTypeInRenderings)) endif call vector_plot(ivecx,ivecy,npixvec,npixyvec,pixwidthvec,pixwidthvecy,vecmax,labelvecplot,got_h) !--vecmax is returned with the adaptive value if sent in -ve ! store this for use in interactive_multi if (xmaxmulti(ivectorplot).lt.0.) xmaxmulti(ivectorplot) = vecmax endif !--------------------------------- ! plot rotated axes !--------------------------------- if (irotate .and. irotateaxes.gt.0 .and. icoordsnew.eq.1) then call rotatedaxes(irotateaxes,iplotx,iploty,angletempx,angletempy,angletempz, & dzscreentemp,zobservertemp) endif ! !--redraw axes over what has been plotted ! if (irenderplot.gt.0 .or. plotlib_is_pgplot) then call redraw_axes(iaxistemp,just,yscalealt,itransy) endif ! !--annotate with time / marker legend and title ! call legends_and_title ! !--plot exact solution if relevant (before going interactive) ! if (iexact.ne.0 .and.nyplot.le.nacross*ndown .and. & ipanelselect(iPlotExactOnlyOnPanel,ipanel,irow,icolumn)) then iaxisy = iaxis if (tile_plots .and. icolumn.ne.1) iaxisy = -1 if (iexact.eq.iexact_rochelobe .and. use_sink_data .and. ipmass > 0 .and. ndim >= 2) then isinktype = get_sink_type(ntypes) call locate_first_two_of_type(isink1,isink2,isinktype,iamtype,npartoftype,ntoti) mprim = dat(isink1,ipmass) msec = dat(isink2,ipmass) xprim(1) = xplot(isink1) xprim(2) = yplot(isink1) xsec(1) = xplot(isink2) xsec(2) = yplot(isink2) endif call exact_solution(iexact,iplotx,iploty, & itrans(iplotx),itrans(iploty),icoordsnew, & ndim,ndimV,timei,xmin,xmax,gammai, & xplot(1:ntoti),yplot(1:ntoti),icolourme(1:ntoti),iamtype,npartoftype,iusetype, & pmassmin,pmassmax,ntoti,imarktype(1), & units(iplotx),units(iploty),irescale,iaxisy) endif !--the following line sets the number of steps on page to nstepsonpage ! in the case where we reach the last timestep before nstepsonpage is reached ! (makes interactive replotting behave better) if (lastplot) istepsonpage = nstepsperpage ! !--enter interactive mode ! if (interactive) then if (nacross*ndown.eq.1 .and. (nstepsperpage.eq.1 .or. nsteps.eq.1)) then iadvance = nfreq call interactive_part(ntoti,iplotx,iploty,iplotz,irender,icontourplot,ivecx,ivecy, & xplot(1:ntoti),yplot(1:ntoti),zplot(1:ntoti), & hh(1:ntoti),icolourme(1:ntoti),iamtype,iusetype,npartoftype, & xmin,xmax,ymin,ymax,rendermin,rendermax,renderminadapt,rendermaxadapt,contmin,contmax,& contminadapt,contmaxadapt,vecmax, & angletempx,angletempy,angletempz,ndim,xorigin(1:ndim),x_sec,zslicepos,dz, & zobservertemp,dzscreentemp,use3Dopacityrendering,taupartdepthtemp,& (double_rendering .and. gotcontours),irerender,itrackpart,icolours,& iColourBarStyle,labelrender,iadvance,ipos,iendatstep,iframe,nframesloop,interactivereplot) !--turn rotation on if necessary if (abs(angletempx-anglex).gt.tol) irotate = .true. if (abs(angletempy-angley).gt.tol) irotate = .true. if (abs(angletempz-anglez).gt.tol) irotate = .true. if (iadvance.eq.-666 .or. interactivereplot) exit over_frames elseif ((ipanel.eq.nacross*ndown .and. istepsonpage.eq.nstepsperpage) .or. lastplot) then ! !--slightly different interactive mode if multiple plots on page ! iadvance = nfreq ! call interactive_step(iadvance,ipos,iendatstep,xmin,xmax,ymin,ymax) nplots = ipanel irerender = .true. call interactive_multi(iadvance,ipos,ifirststeponpage,iendatstep,iframe,nframefirstonpage, & nframesloop,ipanel,iplotxtemp(1:nplots),iplotytemp(1:nplots),irendertemp(1:nplots),& icontourtemp(1:nplots),ivecplottemp(1:nplots),double_rendering,xminmulti(:),xmaxmulti(:),& vptxmin(1:nplots),vptxmax(1:nplots),vptymin(1:nplots),vptymax(1:nplots),barwmulti(1:nplots), & xminadapt(:),xmaxadapt(:),nacross,ndim,xorigin(1:ndim),icolours,iColourBarStyle,interactivereplot) if (iadvance.eq.-666 .or. interactivereplot) exit over_frames endif endif ! !--%%%%%%%%%%%%% end loop over cross-section slices %%%%%%%%%%%%%%%%%%%%%%% ! enddo over_cross_sections !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! not both coordinates - these are just particle plots !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! elseif ((.not.iscoordplot).and.(iploty.le.ndataplots .and. iplotx.le.ndataplots)) then if (debugmode) print*,'DEBUG: starting particle plot...' ! !--sort out particle colouring ! (at present this is NOT used -can't render if not co-ord plot) ! if (irenderpart.gt.0 .and. irenderpart.le.numplot) then !--allocate memory for particle colouring if (.not.allocated(renderplot)) then allocate(renderplot(ntoti),stat=ierr) if (ierr /= 0) stop 'error allocating temporary array for particle colouring' endif !--apply transformations to render array and set label renderplot(1:ntoti) = dat(1:ntoti,irenderpart) call transform(renderplot(1:ntoti),itrans(irenderpart)) labelrender = label(irenderpart) labelrender = transform_label(labelrender,itrans(irenderpart)) !--limits for rendered quantity if (.not.interactivereplot) then !--find (adaptive) limits of rendered array call adapt_limits(irenderpart,renderplot(1:ntoti),rendermin,rendermax, & renderminadapt,rendermaxadapt,trim(labelrender),& iamtype,ntoti,npartoftype,iusetype,ipagechange) if (.not.iadapt) then !!--use fixed limits and apply transformations rendermin = lim(irenderpart,1) rendermax = lim(irenderpart,2) call transform_limits(rendermin,rendermax,itrans(irenderpart)) endif endif !--actually colour the particles call colour_particles(renderplot(1:ntoti), & rendermin,rendermax,icolourme(1:ntoti),ntoti) !--deallocate memory if (allocated(renderplot)) deallocate(renderplot) endif !-------------------------------- ! setup page !-------------------------------- just = 0 call page_setup !-------------------------------- ! now plot particles !-------------------------------- call particleplot(xplot(1:ntoti),yplot(1:ntoti), & zplot(1:ntoti),hh(1:ntoti),ntoti,iplotx,iploty, & icolourme(1:ntoti),iamtype,npartoftype(:),iusetype,.false., & zslicemin,zslicemax,' ',xmin,xmax,ymin,ymax,ifastparticleplot) !-------------------------------- ! plot error bars !-------------------------------- if (iploterrbars) then call plot_qci(icolourprev) ! query line style and colour call plot_sci(linecolourthisstep) ! set colour to current line !--y error bars if (ilocerrbars(iploty).gt.0 .and. ilocerrbars(iploty).le.ndataplots) then call plot_errorbarsy(ntoti,xplot,yplot,dat(:,ilocerrbars(iploty)),itransy) endif !--x error bars if (ilocerrbars(iplotx).gt.0 .and. ilocerrbars(iplotx).le.ndataplots) then call plot_errorbarsx(ntoti,xplot,yplot,dat(:,ilocerrbars(iplotx)),itransx) endif call plot_sci(icolourprev) ! restore line colour endif ! !--redraw axes over what has been plotted ! if (plotlib_is_pgplot) call redraw_axes(iaxis,just,yscalealt,itransy) ! !--annotate with time / marker legend and title ! call legends_and_title ! !--plot exact solution (after redrawn axis for residual plots) ! if (iexact.ne.0 .and.nyplot.le.nacross*ndown .and. & ipanelselect(iPlotExactOnlyOnPanel,ipanel,irow,icolumn)) then iaxisy = iaxis if (tile_plots .and. icolumn.ne.1) iaxisy = -1 call exact_solution(iexact,iplotx,iploty,itrans(iplotx),itrans(iploty), & icoordsnew,ndim,ndimV,timei,xmin,xmax,gammai, & xplot(1:ntoti),yplot(1:ntoti),icolourme(1:ntoti),iamtype,npartoftype,iusetype, & pmassmin,pmassmax,ntoti,imarktype(1), & units(iplotx),units(iploty),irescale,iaxisy) endif ! !--enter interactive mode !--the following line sets the number of steps on page to nstepsonpage ! in the case where we reach the last timestep before nstepsonpage is reached ! (makes interactive replotting behave better) if (lastplot) istepsonpage = nstepsperpage if (interactive) then if (nacross*ndown.eq.1 .and. (nstepsperpage.eq.1 .or. nsteps.eq.1)) then iadvance = nfreq call interactive_part(ntoti,iplotx,iploty,0,irenderpart,0,0,0, & xplot(1:ntoti),yplot(1:ntoti),zplot(1:ntoti), & hh(1:ntoti),icolourme(1:ntoti),iamtype,iusetype,npartoftype, & xmin,xmax,ymin,ymax,rendermin,rendermax,renderminadapt,rendermaxadapt,& contmin,contmax,contminadapt,contmaxadapt,vecmax, & angletempx,angletempy,angletempz,ndim,xorigin(1:ndim), & dumxsec,dummy,dummy,dummy,dummy,.false.,dummy,.false.,irerender, & itrackpart,icolours,iColourBarStyle,labelrender,iadvance,ipos,iendatstep,iframe,nframesloop,interactivereplot) if (iadvance.eq.-666 .or. interactivereplot) exit over_frames ! this should be unnecessary elseif ((ipanel.eq.nacross*ndown .and. istepsonpage.eq.nstepsperpage) .or. lastplot) then ! !--timestep control only if multiple plots on page ! iadvance = nfreq ! call interactive_step(iadvance,ipos,iendatstep,xmin,xmax,ymin,ymax) nplots = ipanel irerender = .true. call interactive_multi(iadvance,ipos,ifirststeponpage,iendatstep,iframe,nframefirstonpage, & nframesloop,ipanel,iplotxtemp(1:nplots),iplotytemp(1:nplots),irendertemp(1:nplots),& icontourtemp(1:nplots),ivecplottemp(1:nplots),.false.,xminmulti(:),xmaxmulti(:),& vptxmin(1:nplots),vptxmax(1:nplots),vptymin(1:nplots),vptymax(1:nplots),barwmulti(1:nplots), & xminadapt(:),xmaxadapt(:),nacross,ndim,xorigin(1:ndim),icolours,iColourBarStyle,interactivereplot) if (iadvance.eq.-666 .or. interactivereplot) exit over_frames endif endif elseif (iploty.le.numplot) then! ie iploty = extra !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! additional plots (not plots of particle data - e.g where some additional ! information is read from a file and plotted on the same page as the ! particle plots, or where some additional plot is calculated ! from the particle data, such as errors etc) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (debugmode) print*,'DEBUG: starting extra plot...' !-------------------------------------------------------------- ! plot surface density, Toomre Q parameter ! or Probability Distribution Function ! => these all involve a new "y column" ! but use a particle property as the x axis !-------------------------------------------------------------- if (iploty.eq.isurfdens .or. iploty.eq.itoomre .or. iploty.eq.ipdf) then just = 0 if (iploty.eq.itoomre) then itemp = 2 label(iploty) = 'Q\dToomre\u' labely = trim(label(iploty)) elseif (iploty.eq.isurfdens) then itemp = 1 label(iploty) = '\gS' labely = trim(label(iploty)) elseif (iploty.eq.ipdf) then label(iploty) = 'PDF ('//trim(label(iplotx))//')' labely = trim(label(iploty)) endif yplot(:) = 0. if (itrans(iploty).ne.0) then labely = trim(transform_label(label(iploty),itrans(iploty))) endif if ((.not.interactivereplot) .or. irerender) then !--call routines which actually calculate disc properties from the particles if (iploty.eq.isurfdens .or. iploty.eq.itoomre) then if (ispsound.gt.0 .and. ispsound.le.ndataplots) then icol = ispsound ! sound speed is present in data elseif (iutherm.gt.0 .and. iutherm.le.ndataplots) then icol = iutherm ! use thermal energy if spsound not present else icol = 0 endif ! work out the unit of mass, r needed for computing Toomre Q unit_mass = 1.d0 unit_r = 1.d0 unit_u = 1.d0 if (iRescale) then if (ix(1) > 0) unit_r = units(ix(1)) if (icol > 0) unit_u = units(icol) endif if (ipmass.gt.0 .and. ipmass.le.ndataplots) then if (iRescale) unit_mass = units(ipmass) if (icol.gt.0) then call disccalc(itemp,ntoti,xplot(1:ntoti),ntoti,dat(1:ntoti,ipmass),unit_mass,unit_r, & xmin,xmax,yminadapti,ymaxadapti,itrans(iplotx),itrans(iploty), & icolourme(1:ntoti),iamtype,iusetype,npartoftype,gammai,unit_u,dat(1:ntoti,icol),icol.eq.ispsound) else call disccalc(itemp,ntoti,xplot(1:ntoti),ntoti,dat(1:ntoti,ipmass),unit_mass,unit_r, & xmin,xmax,yminadapti,ymaxadapti,itrans(iplotx),itrans(iploty), & icolourme(1:ntoti),iamtype,iusetype,npartoftype,gammai) endif else if (iRescale .and. irho > 0) unit_mass = units(irho)*unitzintegration**3 if (icol.gt.0) then call disccalc(itemp,ntoti,xplot(1:ntoti),1,masstype(1),unit_mass,unit_r, & xmin,xmax,yminadapti,ymaxadapti,itrans(iplotx),itrans(iploty), & icolourme(1:ntoti),iamtype,iusetype,npartoftype,gammai,unit_u,dat(1:ntoti,icol),icol.eq.ispsound) else call disccalc(itemp,ntoti,xplot(1:ntoti),1,masstype(1),unit_mass,unit_r, & xmin,xmax,yminadapti,ymaxadapti,itrans(iplotx),itrans(iploty),& icolourme(1:ntoti),iamtype,iusetype,npartoftype,gammai) endif endif elseif (iploty.eq.ipdf) then if (npdfbins.gt.0) then ngrid = npdfbins else ! automatic number of bins determination ngrid = int(0.75*ntoti**(1./3.))+1 endif call set_grid1D(xmin,1.,ngrid) !--call routine which calculates pdf on the particles !--compute PDF on raw (un-transformed) data xplot(1:ntoti) = dat(1:ntoti,iplotx) if (irho.gt.0 .and. irho.le.ndataplots .and. ipmass.gt.0 .and. ipmass.le.ndataplots) then call pdf_calc(ntoti,xplot(1:ntoti),xmin,xmax,ngrid,xgrid,datpix1D, & yminadapti,ymaxadapti,(npdfbins.gt.0),volweightedpdf, & ierr,icolourme(1:ntoti),dat(1:ntoti,irho),dat(1:ntoti,ipmass)) else call pdf_calc(ntoti,xplot(1:ntoti),xmin,xmax,ngrid,xgrid,datpix1D, & yminadapti,ymaxadapti,(npdfbins.gt.0),volweightedpdf, & ierr,icolourme(1:ntoti)) endif ! !--write PDF to file ! if (ierr.eq.0) then call pdf_write(ngrid,xgrid,datpix1D,label(iplotx), & volweightedpdf,rootname(ifileopen),tagline) endif ! !--apply transformations to PDF data ! if (itrans(iplotx).gt.0) then !--reapply the x transform call transform(xplot,itrans(iplotx)) endif if (itrans(iploty).gt.0) then call transform(datpix1D,itrans(iploty)) call transform_limits(yminadapti,ymaxadapti,itrans(iploty)) endif endif endif if (iadapt .and. .not.interactivereplot) then print "(1x,a)",'adapting '//trim(labely)//' limits' ymin = yminadapti ymax = ymaxadapti endif call page_setup call plot_qci(icolourprev) ! query line style and colour call plot_qls(linestyleprev) ! set appropriate colour and style if multiple steps per page if (nstepsperpage.gt.1) then call plot_sci(linecolourthisstep) call plot_sls(linestylethisstep) endif if (iploty.eq.itoomre .or. iploty.eq.isurfdens) then call discplot() elseif (iploty.eq.ipdf) then ! !--plot PDF as line segment, with blanking at zero ! call plotline(size(xgrid),xgrid,datpix1D,blank=0.) endif !--restore line size and colour call plot_sci(icolourprev) call plot_sls(linestyleprev) if (plotlib_is_pgplot) call redraw_axes(iaxis,just,yscalealt,itransy) call legends_and_title ! !--plot exact solution (after redrawn axis for residual plots) ! if (iexact.ne.0 .and.nyplot.le.nacross*ndown .and. & ipanelselect(iPlotExactOnlyOnPanel,ipanel,irow,icolumn)) then iaxisy = iaxis if (tile_plots .and. icolumn.ne.1) iaxisy = -1 call exact_solution(iexact,iplotx,iploty,itrans(iplotx),itrans(iploty), & icoordsnew,ndim,ndimV,timei,xmin,xmax,gammai, & xplot(1:ntoti),yplot(1:ntoti),icolourme(1:ntoti),iamtype,npartoftype,iusetype, & pmassmin,pmassmax,ntoti,imarktype(1), & units(iplotx),units(iploty),irescale,iaxisy) endif if (lastplot) istepsonpage = nstepsperpage if (interactive .and. ((ipanel.eq.nacross*ndown .and. istepsonpage.eq.nstepsperpage) .or. lastplot)) then iadvance = nfreq nplots = ipanel irerender = .true. call interactive_multi(iadvance,ipos,ifirststeponpage,iendatstep,iframe,nframefirstonpage, & nframesloop,ipanel,iplotxtemp(1:nplots),iplotytemp(1:nplots),irendertemp(1:nplots),& icontourtemp(1:nplots),ivecplottemp(1:nplots),.false.,xminmulti(:),xmaxmulti(:),& vptxmin(1:nplots),vptxmax(1:nplots),vptymin(1:nplots),vptymax(1:nplots),barwmulti(1:nplots), & xminadapt(:),xmaxadapt(:),nacross,ndim,xorigin(1:ndim),icolours,iColourBarStyle,interactivereplot) if (iadvance.eq.-666 .or. interactivereplot) exit over_frames endif cycle over_plots !-------------------------------------------------------------- ! plot Toy star A-C plane solution !-------------------------------------------------------------- elseif (iexact.eq.4 .and. iploty.eq.iacplane) then ! !--A vs C for exact toystar solution ! if (ndim.eq.1) then call exact_toystar_acplane(atstar,ctstar,sigma,gammai) elseif (ndim.eq.2) then call exact_toystar_acplane2D(atstar,ctstar,sigma,gammai) endif !--increment page counter as setpage is not called iplots = iplots + 1 ipanel = ipanel + 1 if (ipanel.gt.nacross*ndown) ipanel = 1 !-------------------------------------------------------------- ! power spectrum plots (uses x and data as yet unspecified) !-------------------------------------------------------------- elseif (iploty.eq.ipowerspec) then labelx = 'frequency' labely = 'power' ! !--3D: use FFT routines ! if (ndim.eq.3) then if (.not.ihavesetweights) then call set_weights(weight,dat,iamtype,iusetype) endif call powerspec3D_sph(dat(1:ninterp,ix(1)),dat(1:ninterp,ix(2)),dat(1:ninterp,ix(3)), & hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,ipowerspecy),icolourme(1:ninterp), & ninterp,nfreqspec,lim(ipowerspecx,1),lim(ipowerspecx,2),xplot(1:nfreqspec), & yplot(1:nfreqspec),inormalise) xmin = max(minval(xplot(1:nfreqspec)),1.0) xmax = maxval(xplot(1:nfreqspec)) nfreqpts = nfreqspec else ! !--1D: use slow FT routines or Lomb periodogram ! if (.not.interactivereplot) then xmin = freqmin ! freq min xmax = freqmax ! freq max endif if (.not.interactivereplot .and. itrans(iploty).gt.0) then call transform_limits(xmin,xmax,itrans(iploty)) endif ! !--setup frequency grid (evenly spaced in transformed grid) ! nfreqpts = nfreqspec if (nfreqpts.ge.size(xplot)) then nfreqpts = size(xplot) print*,' WARNING: nfreqpts > array size, restricting to ',nfreqpts else print "(a,i6)",' number of frequency points = ',nfreqpts endif dxfreq = (xmax - xmin)/real(nfreqpts) do i=1,nfreqpts xplot(i) = xmin + (i-1)*dxfreq enddo ! !--transform back to frequency space ! if (itrans(iploty).gt.0) & call transform_inverse(xplot(1:nfreqpts),itrans(iploty)) if (.not.idisordered) then! interpolate first !!--allocate memory for 1D grid (size = 2*npart) ngrid = 2*npartoftype(1) !!--set up 1D grid xmingrid = lim(ipowerspecx,1) xmaxgrid = lim(ipowerspecx,2) dxgrid = (xmaxgrid-xmingrid)/ngrid call set_grid1D(xmingrid,dxgrid,ngrid) ninterp = ntoti !!--interpolate to 1D grid if (.not.ihavesetweights) then call set_weights(weight,dat,iamtype,iusetype) endif call interpolate1D(dat(1:ninterp,ipowerspecx),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,ipowerspecy),icolourme(1:ninterp), & ninterp,xmingrid,datpix1D,ngrid,dxgrid,inormalise) !!--plot interpolated 1D data to check it !!print*,minval(datpix1D),maxval(datpix1D) !call pgswin(xmin,xmax,minval(datpix1D),maxval(datpix1D),0,1) !call pgbox('BCNST',0.0,0,'1BVCNST',0.0,0) !call pglabel('x',label(ipowerspecy),'1D interpolation') !call pgline(ngrid,xgrid,datpix1D) !read* !call pgpage! change page !!--call power spectrum calculation on the even grid call powerspectrum(ngrid,xgrid,datpix1D,nfreqpts,xplot(1:nfreqpts), & yplot(1:nfreqpts),idisordered) if (allocated(datpix1D)) deallocate(datpix1D) if (allocated(xgrid)) deallocate(xgrid) else !!--or else call power spectrum calculation on the particles themselves call powerspectrum(ntoti,dat(1:ntoti,ipowerspecx), & dat(1:ntoti,ipowerspecy),nfreqpts, & xplot(1:nfreqpts),yplot(1:nfreqpts),idisordered) endif endif if (.not.interactivereplot) then ymin = minval(yplot(1:nfreqspec)) ymax = maxval(yplot(1:nfreqspec)) endif !!--uncomment next few lines to plot wavelengths instead !labelx = 'wavelength' !zplot(1:nfreqspec) = 1./xplot(1:nfreqspec) !xplot(1:nfreqspec) = zplot(1:nfreqspec) !if (.not.interactivereplot) then ! xmin = minval(xplot(1:nfreqspec)) ! xmax = maxval(xplot(1:nfreqspec)) !endif if (itrans(iploty).ne.0) then call transform(xplot(1:nfreqpts),itrans(iploty)) labelx = transform_label(labelx,itrans(iploty)) call transform(yplot(1:nfreqpts),itrans(iploty)) labely = transform_label(labely,itrans(iploty)) if (.not.interactivereplot) then call transform_limits(xmin,xmax,itrans(iploty)) call transform_limits(ymin,ymax,itrans(iploty)) endif endif just = 0 call page_setup call plot_qci(icolourprev) ! query line style and colour call plot_qls(linestyleprev) if (nstepsperpage.gt.1) then call plot_sci(linecolourthisstep) ! set appropriate colour and style if multiple steps per page call plot_sls(linestylethisstep) endif call plot_line(nfreqpts,xplot(1:nfreqpts),yplot(1:nfreqpts)) print*,' maximum power at '//trim(labelx)//' = ',xplot(maxloc(yplot(1:nfreqpts))) call plot_sci(icolourprev) call plot_sls(linestyleprev) ! !--redraw axes over what has been plotted ! if (plotlib_is_pgplot) call redraw_axes(iaxis,just,yscalealt,itransy) ! !--annotate with time / marker legend and title ! call legends_and_title elseif (iploty.eq.icolpixmap) then !-------------------------------------------------------------- ! plot the contents of a pixel map read from a file !-------------------------------------------------------------- ! !--irender should already be set, associating the pixmap ! with a column from the SPH data. Then we can use the ! limit settings from the SPH data. Otherwise just ! treat it like a separate column. ! if (irender.eq.0) irender = icolpixmap !--datpix is allocated inside the readpixmap routine if (allocated(datpix)) deallocate(datpix) if (irender.eq.icolpixmap) then labelrender = '|B_\phi|/|B_p|' else labelrender = label(irender) endif call readpixmap(datpix,npixx,npixy,rootname(ifileopen),& shortlabel(labelrender,unitslabel(irender)),istep,x_sec,ierr) if (.not.interactivereplot) then if (ndim.ge.1) then xmin = lim(ix(1),1) xmax = lim(ix(1),2) else xmin = 0. xmax = 1. endif if (ndim.ge.2) then ymin = lim(ix(3),1) ymax = lim(ix(3),2) else ymin = 0. ymax = 1. endif endif if (ndim.ge.1) iplotx = ix(1) if (ndim.ge.2) then iploty = ix(3) labely = label(ix(3)) endif pixwidth = (xmax-xmin)/real(npixx) if (itrans(irender).ne.0 .and. allocated(datpix)) then call transform(datpix,itrans(irender),errval=error_in_log) endif labelrender = transform_label(labelrender,itrans(irender)) !--find (adaptive) limits of rendered array if (allocated(datpix)) then renderminadapt = minval(datpix,mask=abs(datpix-error_in_log).gt.tiny(datpix)) rendermaxadapt = maxval(datpix) endif !--limits for rendered quantity if (.not.interactivereplot) then if (.not.iadapt) then !!--use fixed limits and apply transformations rendermin = lim(irender,1) rendermax = lim(irender,2) call transform_limits(rendermin,rendermax,itrans(irender)) endif endif just = 1 iPlotColourBar = .true. call page_setup if (ierr.eq.0 .and. allocated(datpix)) then !!--call subroutine to actually render the image call render_pix(datpix,rendermin,rendermax,trim(labelrender), & npixx,npixy,xmin,ymin,pixwidth,pixwidth, & icolours,iplotcont,0,0,.false.,.false.) endif ! !--redraw axes over what has been plotted ! if ((allocated(datpix) .and. ierr.eq.0) .or. plotlib_is_pgplot) then call redraw_axes(iaxis,just,yscalealt,itransy) endif ! !--annotate with time / marker legend and title ! call legends_and_title irender = 0 iploty = icolpixmap iplotx = 0 else !-------------------------------------------------------------- ! plot the contents of an extra two-column ascii file !-------------------------------------------------------------- call exact_fromfile('gwaves1.dat',xplot,yplot,1,2,nfreqpts,ierr) just = 0 labelx = 't [ms]' labely = 'h' if (.not.interactivereplot) then xmin = minval(xplot(1:nfreqpts)) xmax = maxval(xplot(1:nfreqpts)) ymin = minval(yplot(1:nfreqpts)) ymax = maxval(yplot(1:nfreqpts)) !--adjust y axes ymin = (ymin + ymax)/2. - 0.55*(ymax-ymin) ymax = (ymin + ymax)/2. + 0.55*(ymax-ymin) endif call page_setup !--plot extra point corresponding to current time ipt = 0 do i=1,nfreqpts-1 if (xplot(i).le.timei .and. xplot(i+1).gt.timei) ipt = i enddo if (ipt.ne.0) then call plot_pt1(xplot(ipt),yplot(ipt),4) call plot_line(ipt,xplot(1:ipt),yplot(1:ipt)) endif if (plotlib_is_pgplot) call redraw_axes(iaxis,just,yscalealt,itransy) call legends_and_title endif !--the following line sets the number of steps on page to nstepsonpage ! in the case where we reach the last timestep before nstepsonpage is reached ! (makes interactive replotting behave better) if (lastplot) istepsonpage = nstepsperpage if (interactive .and.((ipanel.eq.nacross*ndown .and. istepsonpage.eq.nstepsperpage) & .or. lastplot)) then iadvance = nfreq call interactive_step(iadvance,ipos,iendatstep,xmin,xmax,ymin,ymax,interactivereplot) irerender = .true. if (iadvance.eq.-666) exit over_frames endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! if plot not in correct range !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! else print*,' error in plotting : iplotx = ',iplotx,' iploty =',iploty, 'numplot =',numplot call plot_page! just skip to next plot endif ! ploty = whatever enddo over_plots ! over plots per timestep (nyplot) enddo over_frames ! over nframes for animation sequences ! !--frame changing for multiple steps on the page (ie. page split into panels) ! iframesave = 0 if (iadvance.ne.-666 .and..not.interactivereplot) then if (nacross*ndown.gt.1 .and. insidesequence(iseqpos)) then !--for the last panel on the page, reset the sequence for next time if (ipanel.eq.nacross*ndown) then if (iframe.lt.nframes) then ipos = ipos - nacross*ndown endif iframesave = iframe else iframesave = iframe - 1 endif endif endif !--free all dynamically allocated memory if (.not.interactivereplot) then if (allocated(datpix1D)) deallocate(datpix1D) if (allocated(datpix)) deallocate(datpix) if (allocated(brightness)) deallocate(brightness) if (allocated(datpix3D)) deallocate(datpix3D) if (allocated(xgrid)) deallocate(xgrid) if (allocated(vecplot)) deallocate(vecplot) if (allocated(datpixcont)) deallocate(datpixcont) if (allocated(datpixcont3D)) deallocate(datpixcont3D) endif !--free temporary arrays if (allocated(xplot)) deallocate(xplot) if (allocated(yplot)) deallocate(yplot) if (allocated(zplot)) deallocate(zplot) if (allocated(hh)) deallocate(hh) if (allocated(weight)) deallocate(weight) return contains !---------------------------------------------- ! interfaces to the page setup routines ! this is called just before a plot is ! actually plotted !---------------------------------------------- subroutine page_setup(dummy) use colourbar, only:get_colourbarmargins use pagesetup, only:setpage2 use settings_page, only:nstepsperpage,iUseBackgroundColourForAxes, & vposlegend,iPlotLegend,usecolumnorder use settings_limits, only:adjustlimitstodevice use plotlib, only:plot_qvp,plot_sci,plot_page,plotlib_is_pgplot,plot_set_opacity implicit none integer :: iplotsave,ipanelsave,ipanelpos,npanels_remaining real :: barwidth, TitleOffset,xminmargin,xmaxmargin,yminmargin,ymaxmargin real :: xminpix,xmaxpix,yminpix,ymaxpix,dxpix logical :: ipanelchange,dum,iprint_axes,lastrow logical, intent(in), optional :: dummy character(len=7) :: string !-------------------------------------------- ! whether or not this is a dummy call or not !-------------------------------------------- if (present(dummy)) then dum = dummy if (debugmode) print*,'DEBUG: entering page setup (dummy)' else dum = .false. if (debugmode) print*,'DEBUG: entering page setup' endif !--------------------- ! increment counters !--------------------- iplotsave = iplots ipanelsave = ipanel iplots = iplots + 1 ipanelchange = .true. if (nstepsperpage.eq.0 .and. iplots.gt.1) ipanelchange = .false. ! this is an option to never change panels if (iplots.gt.1 .and. nyplots.eq.1 .and. nacross*ndown.gt.1.and..not.ipagechange) ipanelchange = .false. if (ipanelchange) ipanel = ipanel + 1 if (ipanel.gt.nacross*ndown) ipanel = 1 ipanel = max(ipanel,1) ! catch panel=0 if panel is not changing !--set counter for where we are in row, col if (.not.usecolumnorder) then irow = ipanel - ((ipanel-1)/ndown)*ndown icolumn = (ipanel-1)/ndown + 1 ipanelpos = (irow-1)*nacross + icolumn else icolumn = ipanel - ((ipanel-1)/nacross)*nacross irow = (ipanel-1)/nacross + 1 ipanelpos = ipanel endif !--if we are in interactive mode, use the currently buffered plot limits if (interactivereplot .and. (nacross*ndown.gt.1 .or. (nstepsperpage.gt.1 .and. nsteps.gt.1))) then xmin = xminmulti(iplotx) xmax = xmaxmulti(iplotx) ymin = xminmulti(iploty) ymax = xmaxmulti(iploty) if (ivectorplot.gt.0 .and. ivectorplot.le.numplot) then vecmax = xmaxmulti(ivectorplot) endif endif !nsteps_remaining = (nsteps - istep)/nstepsperpage !nplots_remaining = (nyplots - nyplot)/nstepsperpage npanels_remaining = (nsteps - istep)/nstepsperpage !nplots_remaining*nsteps_remaining ! npanels_remaining = (nsteps - istep)*nyplots/nstepsperpage lastrow = (npanels_remaining < nacross) lastplot = ((ipos.eq.iendatstep .or. istep.eq.nsteps) & .and. nyplot.eq.nyplots .and. k.eq.nxsec) !-------------------------------------------------------------- ! output some muff to the screen !-------------------------------------------------------------- if (((interactive .and. ((ipanel.eq.nacross*ndown .and. istepsonpage.eq.nstepsperpage) .or. lastplot)) & .or. (iadapt .and. (istepsonpage.eq.nstepsperpage .or. lastplot))) .and. .not.dum) then print*,trim(labelx),' min, max = ',xmin,xmax print*,trim(labely),' min, max = ',ymin,ymax if (irender.gt.0 .and. .not.(ndim.eq.2 .and. x_sec)) then print*,trim(labelrender),' min, max = ',rendermin,rendermax if (gotcontours) then print*,trim(labelcont),' min, max = ',contmin,contmax endif endif endif !-------------------------------------------------------------- ! set up pgplot page !-------------------------------------------------------------- !--use foreground colour if (.not.dum) call plot_sci(1) !--page margins: zero if no box is drawn ! xminmargin = 0.0 ! xmaxmargin = 0.0 ! yminmargin = 0.0 ! ymaxmargin = 0.0 xminmargin = xminpagemargin xmaxmargin = xmaxpagemargin yminmargin = yminpagemargin ymaxmargin = ymaxpagemargin !--leave space for colour bar if necessary (at end of row only on tiled plots) if ((tile_plots .and. iAllowspaceforcolourbar).or.(.not.tile_plots.and.iPlotColourBar)) then call get_colourbarmargins(iColourBarStyle,xmaxmargin,yminmargin,barwidth) else barwidth = 0. endif !--work out whether or not to leave space above plots for titles/legends TitleOffset = -tiny(Titleoffset) if (iPlotTitles .and. nstepsperpage.eq.1 .and. vpostitle.gt.0.) TitleOffset = vpostitle if (iPlotLegend .and. nstepsperpage.eq.1 .and. vposlegend.lt.0.) TitleOffset = max(Titleoffset,-vposlegend) inewpage = ipanel.eq.1 .and. ipanelchange .and. ipagechange if (inewpage .and. .not.dum) then call plot_page !--store ipos and nyplot positions for first on page ! as starting point for interactive replotting nyplotfirstonpage = nyplot ifirststeponpage = ipos nframefirstonpage = iframe endif ! !--do not allow limits to be the same ! if (abs(xmax-xmin).lt.tiny(xmax)) then if (.not.dum) print "(a)",' WARNING: '//trim(labelx)//'min='//trim(labelx)//'max ' xmax = xmax + 1.0 if (xmin.gt.0.) then xmin = max(xmin - 1.0,xmin,0.) else xmin = xmin - 1.0 endif endif if (abs(ymax-ymin).lt.tiny(ymax)) then if (.not.dum) print "(a)",' WARNING: '//trim(labely)//'min='//trim(labely)//'max ' ymax = ymax + 1.0 if (ymin.gt.0.) then ymin = max(ymin - 1.0,ymin,0.) else ymin = ymin - 1.0 endif endif if (irender.gt.0 .and. abs(rendermax-rendermin).lt.tiny(rendermax) .or.rendermax.ne.rendermax) then if (.not.dum) print "(a)",' WARNING: '//trim(labelrender)//'min='//trim(labelrender)//'max ' rendermax = rendermax + 1.0 if (rendermin.gt.0.) then rendermin = max(rendermin - 1.0,rendermin,0.) else rendermin = rendermin - 1.0 endif endif if (debugmode) print*,'DEBUG: calling setpage...',nstepsperpage if (nstepsperpage.gt.0 .or. inewpage) then if (dum) then !--fake the page setup, then return if (.not.(interactivereplot .and. .not.irerender)) then call setpage2(ipanelpos,nacross,ndown,xmin,xmax,ymin,ymax, & trim(labelx),trim(labely),'NOPGBOX',just,iaxistemp, & xminmargin,xmaxmargin,yminmargin,ymaxmargin, & 0.0,TitleOffset,isamexaxis,tile_plots,adjustlimitstodevice, & lastrow,lastplot,yscalealt,labelyalt,itransy) call plot_qvp(3,xminpix,xmaxpix,yminpix,ymaxpix) if (debugmode) print*,'DEBUG: viewport xpix=',xminpix,'->',xmaxpix,' ypix=',yminpix,'->',ymaxpix npixx = max(nint(xmaxpix-xminpix),1) npixy = max(nint(ymaxpix-yminpix),1) if (debugmode) print*,'DEBUG: dx = ',xmax-xmin,' dy = ',ymax-ymin if (debugmode) print*,'DEBUG: dxpix = ',xmaxpix-xminpix,' dypix = ',ymaxpix-yminpix if (vectordevice .and. npixx.gt.1024) then npixx = 1024/nacross dxpix = (xmax-xmin)/npixx npixy = int(0.999*(ymax-ymin)/real(dxpix)) + 1 print "(a,i4,a,i4,a)",' auto-selecting resolution of ',npixx,' x ',npixy,' for vector device' print "(a)",' => set the number of pixels manually if you want more (or less) than this.' else if (npix.eq.0 .and. debugmode) & print "(a,i4,a,i4)",' auto-selecting device resolution = ',npixx,' x ',npixy ! !--warn about PGPLOT limitations ! if (plotlib_is_pgplot) then if ((xmaxpix-xminpix).gt.1024. .or. (ymaxpix-yminpix).gt.1024) then print "(/,75('*'))" print "(a)",'!! WARNING: PGPLOT will truncate image to 1024 pixels on pixel devices.' print "(a)",'!! To fix this, change line 18 of file grimg2.f in the PGPLOT source code:' print "(a)",'!! REAL BUFFER(1026)' print "(a)",'!! changing 1026 to something much bigger, then recompile PGPLOT.' print "(75('*'),/)" endif endif endif endif !--restore saved attributes iplots = iplotsave ipanel = ipanelsave if (debugmode) print*,'DEBUG: finished dummy page setup' return else !--if we are not changing page, do not reprint the axes iprint_axes = ipagechange .or. inewpage .or. & ((iplots.le.nacross*ndown) .and. (nyplot.le.nacross*ndown .and. istepsonpage.eq.1)) if (iprint_axes) then if (debugmode) print*,'DEBUG: printing axes ',ipagechange,inewpage,iplots,nyplot,istepsonpage string = ' ' else if (debugmode) print*,'DEBUG: not printing axes ',ipagechange,inewpage,iplots,nyplot,istepsonpage string = 'NOPGBOX' endif call setpage2(ipanelpos,nacross,ndown,xmin,xmax,ymin,ymax, & trim(labelx),trim(labely),string,just,iaxistemp, & xminmargin,xmaxmargin,yminmargin,ymaxmargin, & 0.0,TitleOffset,isamexaxis,tile_plots,adjustlimitstodevice, & lastrow,lastplot,yscalealt,labelyalt,itransy) endif endif if (debugmode) print*,'DEBUG: setpage ok, querying and saving viewport...' !--query and save viewport co-ordinates set up for this panel call plot_qvp(0,vptxmin(ipanel),vptxmax(ipanel),vptymin(ipanel),vptymax(ipanel)) !-------------------------------------------------------------- ! store current page setup for interactive mode on multiplots !-------------------------------------------------------------- if (tile_plots) then barwmulti(ipanel) = 0. else barwmulti(ipanel) = barwidth endif iplotxtemp(ipanel) = iplotx iplotytemp(ipanel) = iploty irendertemp(ipanel) = irender icontourtemp(ipanel) = icontourplot ivecplottemp(ipanel) = ivectorplot xminmulti(iplotx) = xmin xmaxmulti(iplotx) = xmax xminmulti(iploty) = ymin xmaxmulti(iploty) = ymax if (irender.gt.0 .and. irender.le.size(xmaxmulti)) then xminmulti(irender) = rendermin xmaxmulti(irender) = rendermax if (icontourplot.gt.0 .and. gotcontours .and. icontourplot.le.size(xmaxmulti)) then xminmulti(icontourplot) = contmin xmaxmulti(icontourplot) = contmax endif endif if (ivectorplot.gt.0 .and. ivectorplot.le.numplot) then xmaxmulti(ivectorplot) = vecmax endif ! ! store adaptive plot limits for a) in interactive mode ! on multiple plots per page ! !--adaptive plot limits are allowed to change even during ! interactive replotting !if (.not.interactivereplot) then if (inewpage) then xminadapt = huge(xminadapt) xmaxadapt = -huge(xmaxadapt) endif xminadapt(iplotx) = min(xminadapt(iplotx),xminadapti) xmaxadapt(iplotx) = max(xmaxadapt(iplotx),xmaxadapti) xminadapt(iploty) = min(xminadapt(iploty),yminadapti) xmaxadapt(iploty) = max(xmaxadapt(iploty),ymaxadapti) if (irender.gt.0) then xminadapt(irender) = min(xminadapt(irender),renderminadapt) xmaxadapt(irender) = max(xmaxadapt(irender),rendermaxadapt) if (icontourplot.gt.0) then xminadapt(icontourplot) = min(xminadapt(icontourplot),contminadapt) xmaxadapt(icontourplot) = max(xmaxadapt(icontourplot),contmaxadapt) endif endif !endif !--change to background colour index for overlaid text and axes if (iUseBackGroundColourForAxes) then call plot_sci(0) call plot_set_opacity(1.) ! ensure background colour is opaque endif if (debugmode) print*,'DEBUG: finished page setup' return end subroutine page_setup !------------------------------------------------------ ! draws legend(s), titles etc ! (must be called after rendering otherwise rendering ! will overwrite plot area) !------------------------------------------------------ subroutine legends_and_title use colourbar, only:plotcolourbar use legends, only:legend,legend_markers,legend_scale,ipanelselect use titles, only:pagetitles,steplegend,lensteplegend use filenames, only:nstepsinfile,nfiles,rootname use settings_page, only:iPlotLegend,iPlotStepLegend, & hposlegend,vposlegend,fjustlegend,legendtext,iPlotLegendOnlyOnPanel, & iPlotScale,iscalepanel,dxscale,hposscale,vposscale,scaletext,& alphalegend,iUseBackGroundColourForAxes use shapes, only:nshapes,plot_shapes use pagesetup, only:xlabeloffset use plotlib, only:plot_qci,plot_sci,plot_annotate,plot_set_opacity use labels, only:is_coord implicit none integer :: icoloursave character(len=lensteplegend) :: steplegendtext real :: xlabeloffsettemp integer :: ititle logical :: usebox !--save colour index call plot_qci(icoloursave) !--use foreground colour by default for legends call plot_sci(1) !-------------------------------------------------------------- ! plot colour bar for rendered plots (use currently set colour) ! do this here so it always appears OVERLAID on the renderings !-------------------------------------------------------------- if (irender.gt.0) then !--only plot colour bar at the end of first row on tiled plots if (tile_plots .and..not.(ipanel.eq.nacross*ndown .or. lastplot .or. & (OneColourBarPerRow.and.icolumn.eq.nacross))) iPlotColourBar = .false. if (iPlotColourBar) then xlabeloffsettemp = xlabeloffset + 1.0 if (iaxistemp.lt.0) xlabeloffsettemp = 0. !--for tiled plots only on last plot in first row, ! and use full viewport size in the y direction if (tile_plots .and. .not.OneColourBarPerRow) then if (double_rendering .and. gotcontours) then call plotcolourbar(iColourBarStyle,icolours,contmin,contmax, & trim(labelcont),.false.,xlabeloffsettemp, & minval(vptxmin(1:ipanel)),maxval(vptxmax(1:ipanel)), & minval(vptymin(1:ipanel)),maxval(vptymax(1:ipanel))) else call plotcolourbar(iColourBarStyle,icolours,rendermin,rendermax, & trim(labelrender),.false.,xlabeloffsettemp, & minval(vptxmin(1:ipanel)),maxval(vptxmax(1:ipanel)), & minval(vptymin(1:ipanel)),maxval(vptymax(1:ipanel))) endif elseif (.not.tile_plots .or. (OneColourBarPerRow .and. icolumn.eq.nacross)) then !!--plot colour bar if (double_rendering .and. gotcontours) then !--for double rendering, plot the colour bar in the 2nd quantity call plotcolourbar(iColourBarStyle,icolours,contmin,contmax, & trim(labelcont),.false.,xlabeloffsettemp) else call plotcolourbar(iColourBarStyle,icolours,rendermin,rendermax, & trim(labelrender),.false.,xlabeloffsettemp) endif endif endif endif !--plot time on plot if (iPlotLegend .and. nyplot.eq.1 & .and. ipanelselect(iPlotLegendOnlyOnPanel,ipanel,irow,icolumn) & .and. timei.gt.-0.5*huge(timei)) then ! but not if time has not been read from dump !--change to background colour index for legend text if overlaid if (iUseBackGroundColourForAxes .and. vposlegend.gt.0.) then call plot_sci(0) call plot_set_opacity(alphalegend) endif usebox = (ivectorplot.gt.0) if (istepsonpage.eq.1) then call legend(legendtext,timei,labeltimeunits,hposlegend,vposlegend,fjustlegend,usebox) endif endif !--line/marker style/colour legend for multiple timesteps on same page if (iPlotStepLegend .and. istepsonpage.gt.0 & .and.((nyplot.eq.1 .and. iPlotLegendOnlyOnPanel.eq.0) & .or. ipanelselect(iPlotLegendOnlyOnPanel,ipanel,irow,icolumn))) then !--change to background colour index for overlaid text and axes if (iUseBackGroundColourForAxes .and. vposlegend.gt.0.) call plot_sci(0) ! !--use filenames in legend if none set ! if (nstepsperpage.ge.1 .and. nsteplegendlines.ge.nstepsperpage*nacross*ndown) then steplegendtext = steplegend(istepsonpage + (ipanel-1)*nstepsperpage) elseif (istepsonpage.le.nsteplegendlines) then steplegendtext = steplegend(istepsonpage) elseif (all(nstepsinfile(1:nfiles).le.1)) then steplegendtext = trim(rootname(istep)) else write(steplegendtext,"(a,i4)") 'step ',istep endif if (debugmode) print "(a,i2,a)",& ' DEBUG: plotting step legend (step ',istepsonpage,': "'//trim(steplegendtext)//'")' if (iploty.gt.ndataplots) then call legend_markers(istepsonpage,linecolourthisstep,imarktype(1),linestylethisstep, & .false.,.true.,trim(steplegendtext),hposlegend,vposlegend,1.0) else call legend_markers(istepsonpage,linecolourthisstep,imarktype(1),linestylethisstep, & iusetype(1),iplotline,trim(steplegendtext),hposlegend,vposlegend,1.0) endif endif !--use foreground colour by default for title call plot_sci(1) !--print title if appropriate if (iPlotTitles .and. istepsonpage.eq.1 .and. ipanel.le.ntitles) then if (ntitles.gt.nacross*ndown) then ititle = (ipos - 1)/nstepsperpage + 1 if (ititle.gt.ntitles) ititle = ipanel else ititle = ipanel endif if (len_trim(pagetitles(ititle)).gt.0) then !--change to background colour index if title is overlaid if (iUseBackGroundColourForAxes .and. vpostitle.lt.0.) then call plot_sci(0) call plot_set_opacity(alphalegend) endif call plot_annotate('T',vpostitle,hpostitle,fjusttitle,trim(pagetitles(ititle))) endif endif !--use foreground colour by default for scale call plot_sci(1) !--scale on co-ordinate plots if (iPlotScale .and. (iscalepanel.eq.0 .or. ipanel.eq.iscalepanel) & .and. is_coord(iplotx,ndim) .and. is_coord(iploty,ndim)) then !--change to background colour index if title is overlaid if (iUseBackGroundColourForAxes .and. vposscale.gt.0.) then call plot_sci(0) call plot_set_opacity(alphalegend) endif call legend_scale(dxscale,hposscale,vposscale,scaletext) endif !--plot shapes if (nshapes.gt.0 .and. istepsonpage.eq.1) & call plot_shapes(ipanel,irow,icolumn,itrans(iplotx),itrans(iploty),timei) !--restore colour index call plot_sci(icoloursave) call plot_set_opacity(1.0) return end subroutine legends_and_title !-------------------------------------------- ! sets up a one dimensional grid of pixels ! and allocates memory for datpix1D !-------------------------------------------- subroutine set_grid1D(xmin1D,dxgrid1D,ngridpts) implicit none integer, intent(in) :: ngridpts real, intent(in) :: xmin1D, dxgrid1D integer :: igrid if (allocated(datpix1D)) deallocate(datpix1D) if (allocated(xgrid)) deallocate(xgrid) allocate (datpix1D(ngridpts)) allocate (xgrid(ngridpts)) do igrid = 1,ngridpts xgrid(igrid) = xmin1D + (igrid-0.5)*dxgrid1D enddo end subroutine set_grid1D !------------------------------------------------------------------- ! interface for setting limits when using particle tracking limits !------------------------------------------------------------------- subroutine settrackinglimits(itrackpart,iplot,xploti,xmini,xmaxi) use labels, only:is_coord use settings_limits, only:xminoffset_track,xmaxoffset_track implicit none integer, intent(in) :: itrackpart,iplot real, dimension(:), intent(in) :: xploti real, intent(inout) :: xmini,xmaxi !--particle tracking limits only apply to co-ordinate axes if (is_coord(iplot,ndim)) then xmini = xploti(itrackpart) - xminoffset_track(iplot) xmaxi = xploti(itrackpart) + xmaxoffset_track(iplot) endif return end subroutine settrackinglimits !------------------------------------------------------------------- ! interface for setting interpolation weights ! (to make calls above neater) !------------------------------------------------------------------- subroutine set_weights(weighti,dati,iamtypei,usetype) use settings_render, only:idensityweightedinterpolation use interpolation, only:set_interpolation_weights use settings_units, only:unit_interp use settings_xsecrot, only:rendersinks,use3Dopacityrendering implicit none real, dimension(:), intent(out) :: weighti real, dimension(:,:), intent(in) :: dati integer(kind=int1), dimension(:), intent(in) :: iamtypei logical, dimension(:), intent(in) :: usetype ihavesetweights = .true. inormalise = inormalise_interpolations call set_interpolation_weights(weighti,dati,iamtypei,usetype,& ninterp,npartoftype,masstype,ntypes,ndataplots,irho,ipmass,ih,ndim,& iRescale,idensityweightedinterpolation,inormalise,units,unit_interp,required,& (use3Dopacityrendering .and. rendersinks)) return end subroutine set_weights !------------------------------------------------------------------- ! interface to vector plotting routines ! so that pixel arrays are allocated appropriately !------------------------------------------------------------------- subroutine vector_plot(ivecx,ivecy,numpixx,numpixy,pixwidthvec,pixwidthvecy,vmax,label,got_h) use settings_vecplot, only:UseBackgndColorVecplot,iplotstreamlines,iplotarrowheads, & iplotsynchrotron,rcrit,zcrit,synchrotronspecindex,uthermcutoff, & ihidearrowswherenoparts,minpartforarrow,iVecplotLegend,iVecLegendOnPanel use interpolations2D, only:interpolate2D_vec use projections3D, only:interpolate3D_proj_vec,interp3D_proj_vec_synctron use interpolate_vec, only:mask_vectors,interpolate_vec_average use render, only:render_vec use fieldlines, only:streamlines,vecplot3D_proj use labels, only:iutherm,is_coord use plotlib, only:plot_qci,plot_qlw,plot_sci,plot_slw use system_utils, only:lenvironment use legends, only:ipanelselect implicit none integer, intent(in) :: ivecx,ivecy,numpixx,numpixy real, intent(in) :: pixwidthvec,pixwidthvecy real, intent(inout) :: vmax character(len=*), intent(in) :: label logical, intent(in) :: got_h real, dimension(numpixx,numpixy) :: vecpixx, vecpixy real, dimension(max(npixx,numpixx),max(npixy,numpixy)) :: datpixvec integer :: i,j,icoloursav,linewidthprev,ivecz real :: vmag real :: blankval,datmax logical :: usevecplot,use3Dstreamlines,plotlegend !--query colour index and line width call plot_qci(icoloursav) call plot_qlw(linewidthprev) !print*,'plotting vector field ',trim(label) if ((is_coord(ivecx,ndim) .or. ivecx.lt.0 .or.(ivecx.gt.ndataplots)) .or. & (is_coord(ivecy,ndim) .or. ivecy.lt.0 .or.(ivecy.gt.ndataplots))) then print*,'error finding location of vector plot in array' else use3Dstreamlines = (ndim.eq.3) .and. .not.x_sec !lenvironment('SPLASH_3DSTREAMLINES') !--plot arrows in either background or foreground colour if (UseBackgndColorVecplot) then call plot_sci(0) else call plot_sci(1) endif usevecplot = .false. if (irotate) then if (allocated(vecplot)) usevecplot = .true. if (debugmode) print*,'DEBUG: using vecplot' ! this is to indicate (to me) that extra memory is in use endif ! !--interpolate using appropriate routine for number of dimensions ! select case(ndim) case(3) if (x_sec) then ! take vector plot in cross section if (got_h) then if (usevecplot) then ! using rotation call interpolate3D_xsec_vec(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp), & vecplot(1,1:ninterp),vecplot(2,1:ninterp), & icolourme(1:ninterp),ninterp,xmin,ymin,zslicepos, & vecpixx,vecpixy,numpixx,numpixy,pixwidthvec,pixwidthvecy,inormalise) else call interpolate3D_xsec_vec(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp), & dat(1:ninterp,ivecx),dat(1:ninterp,ivecy), & icolourme(1:ninterp),ninterp,xmin,ymin,zslicepos, & vecpixx,vecpixy,numpixx,numpixy,pixwidthvec,pixwidthvecy,inormalise) endif else ! don't have smoothing length, use averaging if (usevecplot) then call interpolate_vec_average(xplot(1:ninterp),yplot(1:ninterp), & vecplot(1,1:ninterp),vecplot(2,1:ninterp),icolourme(1:ninterp), & xmin,ymin,pixwidthvec,pixwidthvecy,vecpixx,vecpixy, & ninterp,numpixx,numpixy,zplot(1:ninterp),zslicemin,zslicemax) else call interpolate_vec_average(xplot(1:ninterp),yplot(1:ninterp), & dat(1:ninterp,ivecx),dat(1:ninterp,ivecy),icolourme(1:ninterp), & xmin,ymin,pixwidthvec,pixwidthvecy,vecpixx,vecpixy, & ninterp,numpixx,numpixy,zplot(1:ninterp),zslicemin,zslicemax) endif endif else if (iplotsynchrotron .and. .not.iplotstreamlines .and. .not.iplotarrowheads) then !--get synchrotron polarisation vectors if (iutherm.gt.0 .and. iutherm.le.numplot .and. uthermcutoff.gt.0.) then if (usevecplot) then call interp3D_proj_vec_synctron(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),vecplot(1,1:ninterp),vecplot(2,1:ninterp), & icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,datpixvec(1:numpixx,1:numpixy),numpixx,numpixy,pixwidthvec, & rcrit,zcrit,synchrotronspecindex,pixwidthvec,.false., & dat(1:ninterp,iutherm),uthermcutoff) else call interp3D_proj_vec_synctron(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,ivecx),dat(1:ninterp,ivecy), & icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,datpixvec(1:numpixx,1:numpixy),numpixx,numpixy,pixwidthvec, & rcrit,zcrit,synchrotronspecindex,pixwidthvec,.false., & dat(1:ninterp,iutherm),uthermcutoff) endif else if (usevecplot) then call interp3D_proj_vec_synctron(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),vecplot(1,1:ninterp),vecplot(2,1:ninterp), & icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,datpixvec(1:numpixx,1:numpixy),numpixx,numpixy,pixwidthvec, & rcrit,zcrit,synchrotronspecindex,pixwidthvec,.false.) elseif (.not.iplotstreamlines) then call interp3D_proj_vec_synctron(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,ivecx),dat(1:ninterp,ivecy), & icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,datpixvec(1:numpixx,1:numpixy),numpixx,numpixy,pixwidthvec, & rcrit,zcrit,synchrotronspecindex,pixwidthvec,.false.) endif endif elseif (.not.(iplotstreamlines .and. use3Dstreamlines)) then if (got_h) then if (usevecplot) then if (.not.allocated(vecplot)) stop 'internal error: vecplot not allocated' call interpolate3D_proj_vec(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),vecplot(1,1:ninterp),vecplot(2,1:ninterp), & icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,numpixx,numpixy,pixwidthvec,pixwidthvecy,& .false.,zobservertemp,dzscreentemp) else call interpolate3D_proj_vec(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,ivecx),dat(1:ninterp,ivecy), & icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,numpixx,numpixy,pixwidthvec,pixwidthvecy, & .false.,zobservertemp,dzscreentemp) endif else ! don't have smoothing length, use averaging if (usevecplot) then call interpolate_vec_average(xplot(1:ninterp),yplot(1:ninterp), & vecplot(1,1:ninterp),vecplot(2,1:ninterp),icolourme(1:ninterp), & xmin,ymin,pixwidthvec,pixwidthvecy,vecpixx,vecpixy, & ninterp,numpixx,numpixy) else call interpolate_vec_average(xplot(1:ninterp),yplot(1:ninterp), & dat(1:ninterp,ivecx),dat(1:ninterp,ivecy),icolourme(1:ninterp), & xmin,ymin,pixwidthvec,pixwidthvecy,vecpixx,vecpixy, & ninterp,numpixx,numpixy) endif endif endif !--adjust the units of the z-integrated quantity !if (iRescale .and. units(ih).gt.0.) then ! vecpixx = vecpixx*(unitzintegration/units(ih)) ! vecpixy = vecpixy*(unitzintegration/units(ih)) !endif endif case(2) ! !--two dimensions ! if (got_h) then if (usevecplot) then call interpolate2D_vec(xplot(1:ninterp),yplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp),vecplot(1,1:ninterp), & vecplot(2,1:ninterp),icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,numpixx,numpixy,pixwidthvec,pixwidthvecy,inormalise,& isperiodicx,isperiodicy) else call interpolate2D_vec(xplot(1:ninterp),yplot(1:ninterp), & hh(1:ninterp),weight(1:ninterp),dat(1:ninterp,ivecx), & dat(1:ninterp,ivecy),icolourme(1:ninterp),ninterp,xmin,ymin, & vecpixx,vecpixy,numpixx,numpixy,pixwidthvec,pixwidthvecy,inormalise,& isperiodicx,isperiodicy) endif else ! don't have smoothing length, use averaging if (usevecplot) then call interpolate_vec_average(xplot(1:ninterp),yplot(1:ninterp), & vecplot(1,1:ninterp),vecplot(2,1:ninterp),icolourme(1:ninterp), & xmin,ymin,pixwidthvec,pixwidthvecy,vecpixx,vecpixy, & ninterp,numpixx,numpixy) else call interpolate_vec_average(xplot(1:ninterp),yplot(1:ninterp), & dat(1:ninterp,ivecx),dat(1:ninterp,ivecy),icolourme(1:ninterp), & xmin,ymin,pixwidthvec,pixwidthvecy,vecpixx,vecpixy, & ninterp,numpixx,numpixy) endif endif case default print "(a,i1,a)",'ERROR: Cannot do vector plotting in ',ndim,' dimensions' return end select ! !--plot it, either as streamlines or arrows ! if (iplotstreamlines) then if (ndim.eq.3) then !--normalise the 3D vector field do j=1,numpixy do i=1,numpixx vmag = sqrt(vecpixx(i,j)**2 + vecpixy(i,j)**2) if (vmag.gt.tiny(vmag)) then vecpixx(i,j) = vecpixx(i,j)/vmag vecpixy(i,j) = vecpixy(i,j)/vmag endif enddo enddo endif if (ndim.eq.3 .and. use3Dstreamlines .and. .not.x_sec) then if (usevecplot) then if (.not.allocated(vecplot)) stop 'vecplot not allocated' call vecplot3D_proj(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp), & vecplot(1,1:ninterp),vecplot(2,1:ninterp),vecplot(3,1:ninterp),vmax, & weight(1:ninterp),icolourme(1:ninterp),ninterp,pixwidthvec,zobservertemp,dzscreentemp) else ivecz = ivecx + (iplotz - ix(1)) call vecplot3D_proj(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp), & dat(1:ninterp,ivecx),dat(1:ninterp,ivecy),dat(1:ninterp,ivecz),vmax, & weight(1:ninterp),icolourme(1:ninterp),ninterp,pixwidthvec,zobservertemp,dzscreentemp) endif else call streamlines(vecpixx,vecpixy,datpixvec(1:numpixx,1:numpixy),numpixx,numpixy,pixwidthvec) if (ihidearrowswherenoparts) then datmax = maxval(datpixvec(1:numpixx,1:numpixy)) blankval = 2.*datmax call mask_vectors(xplot(1:ninterp),yplot(1:ninterp),icolourme(1:ninterp),ninterp, & xmin,xmax,ymin,ymax,datpixvec(1:numpixx,1:numpixy), & datpixvec(1:numpixx,1:numpixy),numpixx,numpixy,minpartforarrow,blankval) !--use blanking for values of zero call render_pix(datpixvec(1:numpixx,1:numpixy), & minval(datpixvec(1:numpixx,1:numpixy)), & datmax, & 'crap',numpixx,numpixy,xmin,ymin,pixwidthvec,pixwidthvecy, & 0,.true.,0,ncontours,.false.,ilabelcont,blank=blankval) else call render_pix(datpixvec(1:numpixx,1:numpixy), & minval(datpixvec(1:numpixx,1:numpixy)), & maxval(datpixvec(1:numpixx,1:numpixy)), & 'crap',numpixx,numpixy,xmin,ymin,pixwidthvec,pixwidthvecy, & 0,.true.,0,ncontours,.false.,ilabelcont) endif endif else if (ihidearrowswherenoparts) then call mask_vectors(xplot(1:ninterp),yplot(1:ninterp),icolourme(1:ninterp),ninterp, & xmin,xmax,ymin,ymax,vecpixx,vecpixy,numpixx,numpixy,minpartforarrow,0.) endif plotlegend = iVecplotLegend .and. ipanelselect(iVecLegendOnPanel,ipanel,irow,icolumn) call render_vec(vecpixx,vecpixy,vmax, & numpixx,numpixy,xmin,ymin,pixwidthvec,pixwidthvecy,trim(label),' ',plotlegend) if (iplotsynchrotron .and. .not. iplotarrowheads) then !--get synchrotron polarisation intensity using more pixels if (iutherm.gt.0 .and. iutherm.le.numplot .and. uthermcutoff.gt.0.) then call interp3D_proj_vec_synctron(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,ivecx),dat(1:ninterp,ivecy), & icolourme(1:ninterp),ninterp,xmin,ymin, & datpixvec(1:npixx,1:npixy),datpixvec(1:npixx,1:npixy), & ! these are just dummy arguments datpixvec(1:npixx,1:npixy),npixx,npixy,pixwidth, & rcrit,zcrit,synchrotronspecindex,pixwidthvec,.true., & dat(1:ninterp,iutherm),uthermcutoff) else call interp3D_proj_vec_synctron(xplot(1:ninterp), & yplot(1:ninterp),zplot(1:ninterp),hh(1:ninterp), & weight(1:ninterp),dat(1:ninterp,ivecx),dat(1:ninterp,ivecy), & icolourme(1:ninterp),ninterp,xmin,ymin, & datpixvec(1:npixx,1:npixy),datpixvec(1:npixx,1:npixy), & ! these are just dummy arguments datpixvec(1:npixx,1:npixy),npixx,npixy,pixwidth, & rcrit,zcrit,synchrotronspecindex,pixwidthvec,.true.) endif !--adjust the units of the z-integrated quantity !if (iRescale .and. units(ih).gt.0. .and..not.inormalise) then ! datpix = datpix*(unitzintegration/units(ih)) !endif !--plot contours of synchrotron intensity call render_pix(datpixvec(1:npixx,1:npixy),minval(datpixvec(1:npixx,1:npixy)), & maxval(datpixvec(1:npixx,1:npixy)),'crap', & npixx,npixy,xmin,ymin,pixwidth,pixwidthy,0,.true.,0,ncontours,.false.,ilabelcont) endif endif endif !--restore colour index and line width call plot_sci(icoloursav) call plot_slw(linewidthprev) end subroutine vector_plot end subroutine plotstep !---------------------------------------------------- ! adapt the (particle plot) limits to include all ! particles which are to be plotted on the page !---------------------------------------------------- subroutine adapt_limits(iplot,xploti,xmini,xmaxi,xminadaptive,xmaxadaptive,labeli,& iamtype,ntoti,npartoftype,iusetype,ipagechange) use params, only:int1,maxparttypes use labels, only:is_coord use limits, only:assert_sensible_limits use settings_limits, only:scalemax,iadapt,iadaptcoords use settings_data, only:debugmode,ndim use settings_part, only:iplotline implicit none integer, intent(in) :: iplot real, dimension(:), intent(in) :: xploti real, intent(inout) :: xmini,xmaxi,xminadaptive,xmaxadaptive character(len=*), intent(in) :: labeli integer(kind=int1), dimension(:), intent(in) :: iamtype integer, intent(in) :: ntoti integer, dimension(:), intent(in) :: npartoftype logical, dimension(:), intent(in) :: iusetype logical, intent(in) :: ipagechange integer :: index1,index2,itype,i logical :: mixedtypes !--calculate adaptive limits for this quantity xminadaptive = huge(xminadaptive) xmaxadaptive = -huge(xmaxadaptive) mixedtypes = size(iamtype).gt.1 if (mixedtypes) then do i=1,ntoti itype = iamtype(i) if (iusetype(itype) .or. (iplotline.and.itype.eq.1)) then xminadaptive = min(xminadaptive,xploti(i)) xmaxadaptive = max(xmaxadaptive,xploti(i))*scalemax endif enddo else index1 = 1 do itype=1,maxparttypes index2 = index1 + npartoftype(itype) - 1 if (iusetype(itype).and.npartoftype(itype).gt.0 & .or. (iplotline.and.itype.eq.1)) then xminadaptive = min(xminadaptive,minval(xploti(index1:index2))) xmaxadaptive = max(xmaxadaptive,maxval(xploti(index1:index2))*scalemax) endif index1 = index2 + 1 enddo endif !--avoid infs and NaNs call assert_sensible_limits(xminadaptive,xmaxadaptive) if (debugmode) print*,'DEBUG: ',iplot,': '//trim(labeli)// & 'min,max adaptive = ',xminadaptive,xmaxadaptive !--set these as limits if adaptive limits are on if (.not.interactivereplot) then if (((is_coord(iplot,ndim) .and. iadaptcoords) & .or.(.not.is_coord(iplot,ndim) .and. iadapt)) .and. ipagechange) then print "(1x,a)",'adapting '//trim(labeli)//' limits' xmini = xminadaptive xmaxi = xmaxadaptive endif endif end subroutine adapt_limits !------------------------------------------------------------------- ! interface to log, inverse transformations: ! also adjusts label (depending on ! whether log axes are also set or not). ! (independent) !------------------------------------------------------------------- subroutine applytrans(xploti,xmini,xmaxi,labelxi,itransxi,chaxis,iplotxi,iaxis,intreplot) use transforms, only:transform,transform_label,transform_limits use settings_data, only:numplot implicit none integer, intent(in) :: itransxi,iplotxi,iaxis real, dimension(:), intent(inout) :: xploti real, intent(inout) :: xmini,xmaxi character(len=*), intent(inout) :: labelxi character(len=1), intent(in) :: chaxis logical, intent(in) :: intreplot integer :: itranstemp,lstr character(len=20) :: string if (itransxi.ne.0) then if (iplotxi.gt.0 .and. iplotxi.le.numplot) call transform(xploti(:),itransxi) if ((chaxis.eq.'x' .and. (iaxis.eq.10 .or. iaxis.eq.30)).or. & (chaxis.eq.'y' .and. (iaxis.eq.20 .or. iaxis.eq.30))) then ! logarithmic axes write(string,*) itransxi string = adjustl(string) itranstemp = 0 lstr = len_trim(string) if (string(lstr:lstr).eq.'1') then if (lstr.gt.1) read(string(1:lstr-1),*) itranstemp labelxi = transform_label(labelxi,itranstemp) else labelxi = transform_label(labelxi,itransxi) endif else labelxi = transform_label(labelxi,itransxi) endif if (.not.intreplot) call transform_limits(xmini,xmaxi,itransxi) endif end subroutine applytrans !------------------------------------------------------------------- ! interface for adding rotation and perspective ! (completely independent) !------------------------------------------------------------------- subroutine rotationandperspective(anglexi,angleyi,anglezi,dzscreen,zobs,xploti,yploti,zploti, & ntot,iplotx,iploty,iplotz,dat,ivecstart,vecploti,itrackpart) use labels, only:ix use settings_data, only:ndim,xorigin,debugmode use settings_xsecrot, only:use3Dperspective use rotation, only:rotate2D,rotate3D implicit none real, intent(in) :: anglexi,angleyi,anglezi,dzscreen,zobs real, dimension(:), intent(inout) :: xploti,yploti,zploti real, dimension(:,:), intent(in) :: dat real, dimension(:,:), intent(out) :: vecploti integer, intent(in) :: ntot,iplotx,iploty,iplotz,ivecstart,itrackpart integer :: j,iposx,iposy,iposz,i real :: angleradx,anglerady,angleradz real, dimension(ndim) :: xcoords,veci ! !--convert angles to radians ! angleradz = anglezi*pi/180. anglerady = angleyi*pi/180. angleradx = anglexi*pi/180. if (ndim.eq.3) then print "(1x,a,2(f6.2,1x),f6.2,a)",'rotation: (z, y, x) = (',anglezi,angleyi,anglexi,')' else print "(1x,a,f6.2)",'rotating particles about z by ',anglezi endif if (ndim.eq.3 .and. use3Dperspective) then print*,' observer height = ',zobs,', screen at ',zobs-dzscreen elseif (ndim.eq.3) then if (abs(zobs).gt.tiny(zobs) .or. abs(dzscreen).gt.tiny(dzscreen)) then print "(a)",' INTERNAL ERROR: no 3D perspective but observer set' endif endif if (itrackpart.gt.0 .and. itrackpart.le.ntot) then print*,'rotating about tracked particle ',itrackpart,' x,y,z = ',dat(itrackpart,ix(1:ndim)) elseif (any(abs(xorigin).ge.tiny(xorigin))) then print*,'rotating about x,y,z = ',xorigin(1:ndim) endif if (debugmode .and. ivecstart.gt.0) print "(1x,a)",'(also rotating vector components)' ! !--set location of x,y and z ! such that: ! ix(iposx) = iplotx ! ix(iposy) = iploty ! ix(iposz) = iplotz ! iposx = 1 ! this is "just in case" iposy = 2 iposz = 3 do i=1,ndim if (ix(i).eq.iplotx) then iposx = i elseif (ix(i).eq.iploty) then iposy = i elseif (ix(i).eq.iplotz) then iposz = i else print "(a)",' WARNING: internal error in ix setting for rotation: ix = ',ix(:) endif enddo if (debugmode) print*,'DEBUG: in rotation, iplotz = ',iplotz,' iposz = ',iposz, xorigin(:) !$omp parallel default(none) & !$omp shared(dat,xorigin,ndim,angleradx,anglerady,angleradz,zobs,dzscreen) & !$omp shared(xploti,yploti,zploti,iposx,iposy,iposz,iplotz,ntot,ix,itrackpart) & !$omp shared(vecploti,ivecstart) & !$omp private(j,xcoords,veci) !$omp do do j=1,ntot if (itrackpart.gt.0 .and. itrackpart.le.ntot) then xcoords(1:ndim) = dat(j,ix(1:ndim)) - dat(itrackpart,ix(1:ndim)) else xcoords(1:ndim) = dat(j,ix(1:ndim)) - xorigin(1:ndim) endif if (ndim.eq.2) then call rotate2D(xcoords(:),angleradz) elseif (ndim.eq.3) then call rotate3D(xcoords(1:ndim),angleradx,anglerady,angleradz,zobs,dzscreen) endif if (itrackpart.gt.0 .and. itrackpart.le.ntot) then xploti(j) = xcoords(iposx) + dat(itrackpart,ix(iposx)) yploti(j) = xcoords(iposy) + dat(itrackpart,ix(iposy)) if (iplotz.gt.0) then zploti(j) = xcoords(iposz) + dat(itrackpart,ix(iposz)) endif else xploti(j) = xcoords(iposx) + xorigin(iposx) yploti(j) = xcoords(iposy) + xorigin(iposy) if (iplotz.gt.0) then zploti(j) = xcoords(iposz) + xorigin(iposz) endif endif ! !--rotate vector components ! if (ivecstart.gt.0) then veci(1:ndim) = dat(j,ivecstart:ivecstart+ndim-1) if (ndim.eq.2) then call rotate2D(veci(:),angleradz) elseif (ndim.eq.3) then call rotate3D(veci(1:ndim),angleradx,anglerady,angleradz,zobs,dzscreen) endif vecploti(1,j) = veci(iposx) vecploti(2,j) = veci(iposy) if (ndim.ge.3) vecploti(3,j) = veci(iposz) endif enddo !$omp end do !$omp end parallel return end subroutine rotationandperspective !------------------------------------------------------------------- ! interface for plotting rotated axes !------------------------------------------------------------------- subroutine rotatedaxes(irotateaxes,iplotx,iploty,anglexi,angleyi,anglezi,dzscreen,zobs) use labels, only:ix use rotation, only:rotate_axes3D,rotate_axes2D use settings_data, only:ndim,xorigin use settings_xsecrot, only:xminrotaxes,xmaxrotaxes,use3Dperspective implicit none integer, intent(in) :: irotateaxes,iplotx,iploty real, intent(in) :: anglexi,angleyi,anglezi real, intent(inout) :: dzscreen,zobs real :: angleradx,anglerady,angleradz ! !--convert angles to radians ! angleradz = anglezi*pi/180. anglerady = angleyi*pi/180. angleradx = anglexi*pi/180. if (ndim.eq.3) then if (.not.use3Dperspective .and. dzscreen.gt.tiny(zobs)) then print "(a)",' INTERNAL ERROR: no 3D perspective but observer set' zobs = 0. dzscreen = 0. endif call rotate_axes3D(irotateaxes,iplotx-ix(1)+1,iploty-ix(1)+1, & xminrotaxes(1:ndim),xmaxrotaxes(1:ndim),xorigin(1:ndim), & angleradx,anglerady,angleradz,zobs,dzscreen) elseif (ndim.eq.2) then call rotate_axes2D(irotateaxes,xminrotaxes(1:ndim), & xmaxrotaxes(1:ndim),xorigin(1:ndim),angleradz) endif return end subroutine rotatedaxes end module timestep_plotting splash/src/plotutils.f90000644 000770 000000 00000010072 11622211702 016110 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !--------------------------------------------------------------------------- ! module containing application programming interfaces for basic ! plotting functions. The idea is to add more to this module to ! eventually use it to be able to change backends more easily. !--------------------------------------------------------------------------- module plotutils use plotlib, only:plot_line,plot_bins implicit none public :: plotline,plotbins,formatreal private contains ! ! line plotting, with blanking ! subroutine plotline(npts,xline,yline,blank) implicit none integer, intent(in) :: npts real, intent(in), dimension(:) :: xline,yline real, intent(in), optional :: blank integer :: i,nseg,istart if (present(blank)) then nseg = 0 istart = 1 !--plot line in segments, leaving blank segments where y=blank do i=1,npts if (abs(yline(i)-blank).lt.tiny(yline) .or. i.eq.npts) then if (nseg.gt.0) call plot_line(nseg,xline(istart:istart+nseg),yline(istart:istart+nseg)) istart = i+1 nseg = 0 else nseg = min(nseg + 1,npts-1) endif enddo else call plot_line(npts,xline,yline) endif return end subroutine plotline ! ! binned histogram plotting, with blanking ! subroutine plotbins(nbins,xbins,ybins,blank) implicit none integer, intent(in) :: nbins real, intent(in), dimension(:) :: xbins,ybins real, intent(in), optional :: blank integer :: i,nseg,istart if (present(blank)) then nseg = 0 istart = 1 !--plot line in segments, leaving blank segments where y=blank do i=1,nbins if (abs(ybins(i)-blank).lt.tiny(ybins) .or. i.eq.nbins) then if (nseg.gt.0) call plot_bins(nseg,xbins(istart:istart+nseg),ybins(istart:istart+nseg),.true.) istart = i+1 nseg = 0 else nseg = min(nseg + 1,nbins-1) endif enddo else call plot_bins(nbins,xbins,ybins,.true.) endif return end subroutine plotbins ! ! formatting of real variables into strings (like PGNUMB) ! subroutine formatreal(val,string,ierror) implicit none real, intent(in) :: val character(len=*), intent(out) :: string integer, intent(out), optional :: ierror integer :: ierr,i,idot logical :: nonzero if (abs(val).ge.1.d99) then write(string,"(1pe10.3)",iostat=ierr) val elseif (abs(val).lt.1.e-3 .or. abs(val).ge.1.e4) then write(string,"(1pe9.2)",iostat=ierr) val elseif (abs(val).lt.0.1) then write(string,"(f8.3)",iostat=ierr) val elseif (abs(val).ge.100.) then write(string,"(f8.0)",iostat=ierr) val else write(string,"(f8.2)",iostat=ierr) val endif string = adjustl(trim(string)) if (present(ierror)) ierror = ierr ! !--strip trailing zeros after the decimal place ! (and the decimal place if it is the last character) ! idot = index(string,'.') if (idot.gt.0) then nonzero = .false. do i = len_trim(string),idot,-1 if (.not.nonzero .and. string(i:i).eq.'0') then string(i:i) = ' ' elseif (.not.nonzero .and. string(i:i).eq.'.') then string(i:i) = ' ' nonzero = .true. else nonzero = .true. endif enddo endif string = trim(string) return end subroutine formatreal end module plotutils splash/src/powerspectrums.f90000644 000770 000000 00000022134 12017612704 017163 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! contains subroutines for taking power spectrums on particle data ! module powerspectrums implicit none real, parameter, private :: pi = 3.141592653589 real, parameter, private :: twopi = 2.*pi public :: powerspectrum,powerspec3D_sph private contains subroutine powerspectrum(npts,x,dat,nfreqpts,freq,power,idisordered) implicit none integer, intent(in) :: npts, nfreqpts real, intent(in), dimension(npts) :: x real, intent(in), dimension(npts) :: dat real, intent(in), dimension(nfreqpts) :: freq real, intent(out), dimension(nfreqpts) :: power logical, intent(in) :: idisordered integer :: ifreq real :: datmean, datvar, omega if (.not.idisordered) then print*,' evaluating fourier transform' do ifreq=1,nfreqpts omega = twopi*freq(ifreq) !--get power at this frequency call power_fourier(npts,x,dat,omega,power(ifreq)) enddo else print*,'evaluating lomb periodogram...' ! !--calculate the mean and variance of the data ! call mean_variance(dat,npts,datmean,datvar) print*,'data mean = ',datmean,' std. dev = ',sqrt(datvar) if (datvar.le.0.) then print*,'error: variance = 0' power = 0. return endif do ifreq=1,nfreqpts omega = twopi*freq(ifreq) call power_lomb(npts,x,dat,datmean,datvar,omega,power(ifreq)) enddo endif end subroutine powerspectrum !------------------------------------------------------- ! subroutine to compute the power spectrum ! of evenly sampled data via a (slow) fourier transform !-------------------------------------------------------- subroutine power_fourier(npts,x,dat,omega,power) implicit none integer, intent(in) :: npts real, intent(in), dimension(npts) :: x, dat real, intent(in) :: omega real, intent(out) :: power integer :: i real :: sum1,sum2 power = 0. sum1 = 0. sum2 = 0. do i=1,npts sum1 = sum1 + dat(i)*COS(-omega*x(i)) sum2 = sum2 + dat(i)*SIN(-omega*x(i)) enddo power= sqrt(sum1**2 + sum2**2)/REAL(npts) return end subroutine power_fourier !---------------------------------------------------------- ! Subroutine to compute the power spectrum (periodogram) ! of unevenly sampled data via the Lomb (1976) method ! (algorithm described in Press et al, Numerical Recipes, sec 13.8, p569) ! ! Given the data (dat) on a set of points (x), ! returns an array of nfreq frequencies (freq) between freqmin and freqmax ! together with the power at each frequency (power) !---------------------------------------------------------- subroutine power_lomb(npts,x,dat,datmean,datvar,omega,power) implicit none integer, intent(in) :: npts real, intent(in), dimension(npts) :: x, dat real, intent(in) :: datmean,datvar,omega real, intent(out) :: power integer :: i real :: ddat real :: tau, tau_numerator, tau_denominator real :: term1_numerator, term1_denominator real :: term2_numerator, term2_denominator real :: omega_dx, cos_term, sin_term ! !--calculate tau for this frequency ! tau_numerator = 0. tau_denominator = 0. do i=1,npts tau_numerator = tau_numerator + SIN(2.*omega*x(i)) tau_denominator = tau_denominator + COS(2.*omega*x(i)) enddo tau = ATAN(tau_numerator/tau_denominator)/(2.*omega) ! !--calculate the terms in the power ! term1_numerator = 0. term1_denominator = 0. term2_numerator = 0. term2_denominator = 0. do i=1,npts ddat = dat(i) - datmean omega_dx = omega*(x(i) - tau) cos_term = COS(omega_dx) sin_term = SIN(omega_dx) term1_numerator = term1_numerator + ddat*cos_term term1_denominator = term1_denominator + cos_term**2 term2_numerator = term2_numerator + ddat*sin_term term2_denominator = term2_denominator + sin_term**2 enddo ! !--calculate the power at this frequency ! power = 1./(2.*datvar)*(term1_numerator**2/term1_denominator + & term2_numerator**2/term2_denominator) return end subroutine power_lomb !------------------------------------------------- ! Subroutine to calculate the mean and variance ! of a set of data points ! Mean is trivial but variance uses a special ! formula to reduce round-off error ! see Press et al Numerical Recipes, section 14.2 ! this is similar to their subroutine avevar !------------------------------------------------- subroutine mean_variance(x,npts,xmean,xvariance) implicit none integer, intent(in) :: npts real, intent(in), dimension(npts) :: x real, intent(out) :: xmean, xvariance real :: roundoff, delta integer :: i ! !--calculate average ! xmean = 0. do i=1,npts xmean = xmean + x(i) enddo xmean = xmean/real(npts) ! !--calculate variance using the corrected two-pass formula ! ! var = 1/(n-1)*( sum (x-\bar{x}) - 1/n * (sum(x-\bar{x}) )^2 ) ! ! where the last term corrects for the roundoff error ! in the first term ! xvariance = 0. roundoff = 0. do i=1,npts delta = x(i) - xmean roundoff = roundoff + delta xvariance = xvariance + delta*delta enddo xvariance = (xvariance - roundoff**2/npts)/real(npts-1) return end subroutine mean_variance ! ! interface to 3D powerspectrum calculation on particles ! assumes box size is the same in all directions ! subroutine powerspec3D_sph(x,y,z,dat,hh,weight,icolours,npart, & ngrid,xmin,xmax,freq,power,normalise) use interpolations3D, only:interpolate3D implicit none integer, intent(in) :: npart,ngrid real, dimension(npart), intent(in) :: x,y,z,dat,hh,weight integer, dimension(npart), intent(in) :: icolours real, intent(in) :: xmin,xmax real, dimension(ngrid), intent(out) :: freq,power logical, intent(in) :: normalise real, dimension(ngrid,ngrid,ngrid) :: dat3D real :: dx integer :: logngrid,ik logical :: periodicx,periodicy,periodicz ! !--make sure than ngrid is a factor of 2 ! logngrid = int(log(real(ngrid))/log(2.)) if (2**logngrid.ne.ngrid) then print*,' ERROR: ngrid not a power of 2 in powerspectrum interpolation ',2**logngrid,ngrid endif dx = (xmax - xmin)/real(ngrid) ! !--interpolate (normalised) from particles to 3D grid suitable for FFT ! print*,'ngrid = ',ngrid periodicx = .false. periodicy = .false. periodicz = .false. call interpolate3D(x,y,z,hh,weight,dat,icolours,npart, & xmin,xmin,xmin,dat3D,ngrid,ngrid,ngrid,dx,dx,normalise,& periodicx,periodicy,periodicz) ! !--setup grid of frequencies for plotting ! freq(1) = 0. do ik=2,ngrid freq(ik) = ik - 1. enddo ! !--calculate powerspectrum using fft ! call power3d_fft(dat3D,ngrid,ngrid,ngrid,power,ngrid) return end subroutine powerspec3D_sph ! !--power spectrum routine using Fast Fourier Transform ! subroutine power3d_fft(dat,nx,ny,nz,power,nk) implicit none ! include 'fftw3.f' integer, intent(in) :: nx,ny,nz,nk real, intent(in), dimension(nx,ny,nz) :: dat real, intent(out), dimension(nk) :: power integer, dimension(nk) :: numk complex :: dati(nx,ny,nz) real :: ddenom,ptot integer :: ierr,k,j,i,kz,ky,kx,kk,ik !--this is for ACML ! complex :: comm(nx*ny*nz+5*(nx+ny+nz)) !--this is for FFTW ! integer*8 :: plan ierr = 0 ! !--convert data to complex ! dati = cmplx(dat,0.0) print*,' starting 3D fft...' ! !--do fast fourier transform via AMD Core Math Library function ! ! call cfft3d(-1,nx,ny,nz,dati,comm,ierr) ! !--do fft via fftw ! ! call fftwf_plan_dft_3d(plan,nx,ny,nz,dati,dati,FFTW_FORWARD,FFTW_ESTIMATE) ! call fftwf_execute(plan) ! call fftwf_destroy_plan(plan) if (ierr /= 0) then write(*,*) 'error on powerspectrum output!' endif power = 0. numk = 0 ! !--get power from fourier coefficients ! do k=1,nz kz = min(k-1,nz-k+1) do j=1,ny ky = min(j-1,ny-j+1) do i=1,nx kx = min(i-1,nx-i+1) kk = sqrt(real(kx**2 + ky**2 + kz**2)) ik = 1.5 + kk !--only return requested number of frequencies if (ik .le. nk) then power(ik) = power(ik) + abs(dati(i,j,k))**2 numk(ik) = numk(ik) + 1 ! sum contributions at that frequency endif enddo enddo enddo ddenom = 1./(real(nx)*real(ny)*real(nz)) power = power*ddenom**2 ptot = sum(power) ! !--normalise according to power in k-space "shells" ! and number of contributions in that shell from kx,ky and kz ! do ik=1,nk power(ik) = power(ik)/(numk(ik) + 1.e-8)*4./3.*pi*((ik-0.5)**3 - (ik-1.5)**3) enddo !--rescale so that it has the same total power as before power = power*ptot/sum(power) return end subroutine power3d_fft end module powerspectrums splash/src/prompting.f90000644 000770 000000 00000052671 12240556126 016114 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !This is a small f90 module containing a generic subroutine for prompting !integer, real, double and logical variables and strings. !I use them quite often and found the solution below very useful. ! !The general syntax is: ! ! call prompt(PROMPT,VAR,...) ! !Action: writes the string PROMPT on the terminal plus the current ! value of the variable VAR and reads VAR. If default ! is pressed instead of a new value, ! the variable VAR stays untouched. ! !In addition there are a few optional parameter to the routine like !setting defaults or limits etc... ! !In principle three f90 features are used which are not available !in f77: recursion, non-advancing I/O and overloading. ! !A detailed description of the syntax can be found in the header !of the module below. !---------------------------- please cut here ------------------------------------- ! ! f90 Module 'prompting' ! ! Definition of Generic Subroutine: prompt ! ! Syntax: prompt(text, value, [min], [max]) ! text character string ! value integer, real or double ! min, max allowed range of same type as value (optional) ! [DJP] min2, max2 allowed 2nd range of same type as value (optional) ! ! prompt(text, string, [length], [case]) ! text character string ! string character string ! length length of string (optional on return) ! case option ! 1 -> convert string to lower case ! 2 -> convert string to upper case ! lower=1, upper=2 are defined public ! within this module ! ! prompt(text, value, [default]) ! text character string ! value logical ! default logical (optional) ! will always overwrite the current value ! ! Author: Th. S. Ullrich, University Heidelberg ! e-mail: ullrich@ceres1.physi.uni-heidelberg.de ! Last mod: 18 Aug 94 ! ! Changes by D.Price, University of Exeter, dprice@astro.ex.ac.uk: ! 19/10/04 : problem with if (present(min) .and. min < newvalue) ! on some compilers ! ! 31/10/06: D. Price: ! Function print_logical added for displaying logicals: takes in a logical ! variable and returns a string 'on' or 'off' as appropriate. ! ! 20/06/07: D. Price: ! Default part of prompt changed from "=" to the more human "default=" ! Also the character string prompt puts the default value in quotes ! ! 09/05/08: D. Price: ! String prompt accepts "blank" to set empty string, unless optional ! argument noblank is set to .true. ! ! 06/02/09: D. Price, Monash University, daniel.price@monash.edu ! Added optional "mask" argument to print_logical routine ! ! 27/01/10: D. Price: ! Added optional "list" argument to string_prompt routine, now recursive ! ! 24/02/10: D. Price: ! When noblank=.true., string prompt does not accept blank string ! (e.g. where it is the default input) and gives an error message ! ! 23/07/10: D. Price: ! Integer prompt accepts 2nd sub-range [min:max] [min2:max2] ! ! 06/05/11: D. Price: ! Added prompt for integer arrays ! ! 21/08/12: D. Price: ! Real/double prompting interfaces compile and work with -r8 ! ! 08/02/13: D. Price ! Integer prompt enforces default value to be between min and max ! ! 25/06/13: D. Price ! Real and double prompts print values using scientific notation 1.e8 instead of 0.1e9 ! module prompting private ! ! Options for string prompting routine ! integer, parameter, public :: lower = 1, upper = 2 ! ! Create generic name 'prompt' ! interface prompt module procedure & integer_prompt, real_prompt, string_prompt, double_prompt, logical_prompt, intarr_prompt end interface public :: prompt,print_logical contains ! ! Integer prompting routine ! recursive subroutine integer_prompt(text, value, min, max, min2, max2) character(len=*), intent(in) :: text integer, intent(inout) :: value integer :: newvalue character(len=64) :: string character(len=16) :: chmin, chmax, chmin2, chmax2 integer :: ios, ierr integer, optional, intent(in) :: min, max, min2, max2 logical :: error chmin = '' chmax = '' chmin2 = '' chmax2 = '' error = .false. ! ! Make sure default argument is within range! ! if (present(min)) then if (value < min) value = min endif if (present(max)) then if (value > max) value = max endif ! ! Pack arguments in strings for compact and nicer prompt ! write(string,*) value if (present(min)) write(chmin,"(g10.0)") min if (present(max)) write(chmax,"(g10.0)") max if (present(min2)) write(chmin2,"(g10.0)") min2 if (present(max2)) write(chmax2,"(g10.0)") max2 ! ! Write prompt string to terminal ! if (present(min).or.present(max)) then if (present(min2).or.present(max2)) then write(*,"(a,1x,'([',a,':',a,',',a,':',a,'],',1x,'default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(chmin)), & trim(adjustl(chmax)),trim(adjustl(chmin2)),& trim(adjustl(chmax2)),trim(adjustl(string)) else write(*,"(a,1x,'([',a,':',a,'],',1x,'default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(chmin)), & trim(adjustl(chmax)), trim(adjustl(string)) endif else write(*,"(a,1x,'(default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(string)) endif ! ! Read new value, quit and keep old value if zero sized string ! read(*,"(a)",iostat=ierr) string if (len(trim(adjustl(string))) == 0) return read(string,"(g10.0)",iostat=ios) newvalue ! ! Check if new string is of right type and within given range ! if (ios /= 0) then print "(a)", "Error, not an integer number" error = .true. else if (present(min)) then if (newvalue < min) then if (present(max2)) then if (newvalue > max2) then print "(a)", "Error, value out of range" error = .true. elseif (newvalue < min2) then print "(a)", "Error, value out of range" error = .true. endif else print "(a)", "Error, value out of range" error = .true. endif endif endif if (present(max)) then if (newvalue > max) then if (present(min2)) then if (newvalue < min2) then print "(a)", "Error, value out of range" error = .true. elseif (newvalue > max2) then print "(a)", "Error, value out of range" error = .true. endif else print "(a)", "Error, value out of range" error = .true. endif endif endif endif ! ! Assign new value if everything is ok, else prompt again ! if (error) then call integer_prompt(text, value, min, max, min2, max2) else value = newvalue endif end subroutine integer_prompt ! ! Real prompting routine ! recursive subroutine real_prompt(text, value, min, max) integer, parameter :: sp = selected_real_kind(p=6) character(len=*), intent(in) :: text real(kind=sp), intent(inout) :: value real(kind=sp) :: newvalue character(len=64) :: string character(len=16) :: chmin, chmax integer :: ios real(kind=sp), optional, intent(in) :: min, max logical :: error chmin = '' chmax = '' error = .false. ! ! Pack arguments in strings for compact and nicer prompt ! if (abs(value) < 0.1 .or. abs(value) >= 1.d4) then write(string,"(es13.4)") value else write(string,"(g13.4)") value endif if (present(min)) write(chmin,"(g13.4)") min if (present(max)) write(chmax,"(g13.4)") max ! ! Write prompt string to terminal ! if (present(min).or.present(max)) then write(*,"(a,1x,'([',a,':',a,'],',1x,'default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(chmin)), & trim(adjustl(chmax)), trim(adjustl(string)) else write(*,"(a,1x,'(default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(string)) endif ! ! Read new value, quit and keep old value if zero sized string ! read(*,"(a)") string if (len(trim(adjustl(string))) == 0) return read(string,*,iostat=ios) newvalue ! ! Check if new string is of right type and within given range ! if (ios /= 0) then print "(a)", "Error, not a real number" error = .true. else if (present(min)) then if (newvalue < min) then print "(a)", "Error, value out of range" error = .true. endif endif if (present(max)) then if (newvalue > max) then print "(a)", "Error, value out of range" error = .true. endif endif endif ! ! Assign new value if everything is ok, else prompt again ! if (error) then call real_prompt(text, value, min, max) else value = newvalue endif end subroutine real_prompt ! ! Double precision prompting routine ! recursive subroutine double_prompt(text, value, min, max) integer, parameter :: db = kind(0.d0) character(len=*), intent(in) :: text real(kind=db), intent(inout) :: value real(kind=db) :: newvalue character(len=64) :: string character(len=16) :: chmin, chmax integer :: ios real(kind=db), optional, intent(in) :: min, max logical :: error chmin = '' chmax = '' error = .false. ! ! Pack arguments in strings for compact and nicer prompt ! if (abs(value) < 0.1d0 .or. abs(value) >= 1.d4) then write(string,"(es13.4)") value else write(string,"(g13.4)") value endif if (present(min)) write(chmin,"(g13.4)") min if (present(max)) write(chmax,"(g13.4)") max ! ! Write prompt string to terminal ! if (present(min).or.present(max)) then write(*,"(a,1x,'([',a,':',a,'],',1x,'default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(chmin)), & trim(adjustl(chmax)), trim(adjustl(string)) else write(*,"(a,1x,'(default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(string)) endif ! ! Read new value, quit and keep old value if zero sized string ! read(*,"(a)") string if (len(trim(adjustl(string))) == 0) return read(string,*,iostat=ios) newvalue ! ! Check if new string is of right type and within given range ! if (ios /= 0) then print "(a)", "Error, not a real number" error = .true. else if (present(min)) then if (newvalue < min) then print "(a)", "Error, value out of range" error = .true. endif endif if (present(max)) then if (newvalue > max) then print "(a)", "Error, value out of range" error = .true. endif endif endif ! ! Assign new value if everything is ok, else prompt again ! if (error) then call double_prompt(text, value, min, max) else value = newvalue endif end subroutine double_prompt ! ! Logical prompting routine ! recursive subroutine logical_prompt(text, lvalue, default) character(len=*), intent(in) :: text logical, intent(inout) :: lvalue logical, optional, intent(in) :: default character(len=32) :: string ! ! If present, set default ! if (present(default)) lvalue = default ! ! Default answer yes/no ! if (lvalue) then string='yes' else string='no' endif ! ! Write prompt string to terminal ! write(*,"(a,1x,'(default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(string)) ! ! Read new value, quit and keep old value if zero sized string ! read(*,"(a)") string if (len(trim(adjustl(string))) == 0) return ! ! Translate answer in .true./.false., if invalid prompt again ! select case (adjustl(string)) case ('y') lvalue = .true. case ('yes') lvalue = .true. case ('on') lvalue = .true. case ('t') lvalue = .true. case ('true') lvalue = .true. case ('n') lvalue = .false. case ('no') lvalue = .false. case ('off') lvalue = .false. case ('f') lvalue = .false. case ('false') lvalue = .false. case default print "(a)", "Error, answer y(es)/t(rue)/on or n(o)/f(alse)/off" call logical_prompt(text, lvalue, default) end select end subroutine logical_prompt ! ! String prompting routine ! recursive subroutine string_prompt(text, string, length, case, noblank, list) character(len=*), intent(in) :: text character(len=*), intent(inout) :: string character(len=128) :: newstring integer, optional, intent(out) :: length integer, optional, intent(in) :: case logical, optional, intent(in) :: noblank integer :: is, ia integer, parameter :: aoffset = 32 logical :: allowblank,inlist character(len=*), dimension(:), intent(in), optional :: list ! ! Write prompt string to terminal ! if (present(noblank)) then allowblank = .not.noblank else allowblank = .true. endif if (allowblank .and. len_trim(adjustl(string)).gt.0) then write(*,"(a,1x,'(blank=""blank"",default=""',a,'""):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(string)) else write(*,"(a,1x,'(default=""',a,'""):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(string)) endif ! ! Read new value, quit and keep old value if zero sized string ! read(*,"(a)") newstring if (len_trim(newstring) > len(string)) then print "(a)", "Warning: string too long, will be truncated" endif if (allowblank .and. trim(adjustl(newstring)).eq.'blank') then string = ' ' elseif ( len_trim(adjustl(newstring)) /= 0 ) then string = newstring elseif ( .not.allowblank .and. len_trim(adjustl(string)).eq.0 ) then print "(a)", "Error, cannot enter blank string" if (present(list)) then call string_prompt(text,string,noblank=.not.allowblank,list=list) else call string_prompt(text,string,noblank=.not.allowblank) endif endif if (present(length)) length = len_trim(string) ! ! Convert string to upper/lower case if requested ! if (present(case)) then if (case == upper) then do is = 1, len(string) ia = iachar(string(is:is)) if (ia >= iachar('a').and.ia <= iachar('z')) & string(is:is) = achar(ia-aoffset) enddo endif if (case == lower) then do is = 1, len(string) ia = iachar(string(is:is)) if (ia >= iachar('A').and.ia <= iachar('Z')) & string(is:is) = achar(ia+aoffset) enddo endif endif if (present(list)) then inlist = .false. do i=1,size(list) if (trim(adjustl(list(i)))==trim(adjustl(string))) inlist = .true. enddo if (.not.inlist) then print "(a)", "Error, value not in list" call string_prompt(text,string,noblank=.not.allowblank,list=list) endif endif end subroutine string_prompt ! ! Integer array prompting routine (D. Price) ! recursive subroutine intarr_prompt(text, value, nvalues, min, max) character(len=*), intent(in) :: text integer, dimension(:), intent(inout) :: value integer, intent(inout) :: nvalues integer, dimension(size(value)) :: newvalue character(len=64) :: valstring character(len=120) :: string character(len=16) :: chmin, chmax integer :: ios integer, optional, intent(in) :: min, max logical :: error integer :: ival,nvaluesnew chmin = '' chmax = '' error = .false. ! ! Pack arguments in strings for compact and nicer prompt ! string = ' ' do ival=1,nvalues-1 write(valstring,*,iostat=ios) value(ival) string = trim(string)//trim(adjustl(valstring))//',' enddo if (nvalues.gt.0) then write(valstring,*,iostat=ios) value(nvalues) endif string = trim(string)//trim(adjustl(valstring)) if (present(min)) write(chmin,"(g10.0)") min if (present(max)) write(chmax,"(g10.0)") max ! ! Write prompt string to terminal ! if (present(min).or.present(max)) then write(*,"(a,1x,'([',a,':',a,'],',1x,'default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(chmin)), & trim(adjustl(chmax)), trim(adjustl(string)) else write(*,"(a,1x,'(default=',a,'):',1x)",advance='no') & trim(adjustl(text)), trim(adjustl(string)) endif ! ! Read new value, quit and keep old value if zero sized string ! read(*,"(a)") string if (len(trim(adjustl(string))) == 0) return ! !--register how many new values read ! newvalue = -huge(0) read(string,*,iostat=ios) newvalue(:) nvaluesnew = 0 do ival=1,size(newvalue) if (newvalue(ival).ne.-huge(0)) nvaluesnew = nvaluesnew + 1 enddo ! ! Check if new string is of right type and within given range ! if (nvaluesnew <= 0) then print "(a)", "Error, no integer numbers could be read" error = .true. else if (present(min)) then if (any(newvalue(1:nvaluesnew) < min)) then print "(a)", "Error, value(s) out of range (min)" error = .true. endif endif if (present(max)) then if (any(newvalue(1:nvaluesnew) > max)) then print "(a)", "Error, value(s) out of range (max)" error = .true. endif endif endif ! ! Assign new value if everything is ok, else prompt again ! if (error) then call intarr_prompt(text, value, nvalues, min, max) else value = newvalue nvalues = nvaluesnew endif end subroutine intarr_prompt ! ! Routine added by D.Price (31/10/06) ! Takes in a logical variable and returns a string 'on' or 'off' as appropriate ! function print_logical(lvalue,mask) implicit none logical, intent(in) :: lvalue logical, intent(in), optional :: mask character(len=3) :: print_logical logical :: maskval maskval = .true. if (present(mask)) maskval = mask if (maskval) then if (lvalue) then print_logical = 'ON' else print_logical = 'OFF' endif else print_logical = ' -' endif end function print_logical end module prompting splash/src/promptlist.f90000644 000770 000000 00000007135 12025727744 016314 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! Module implementing generic menu where objects can be added ! to/deleted from a list !------------------------------------------------------------------------- module promptlist implicit none interface subroutine print_objlist(nobj) integer, intent(in) :: nobj end subroutine end interface interface subroutine add_obj(istart,iend,nobj) integer, intent(in) :: istart,iend integer, intent(inout) :: nobj end subroutine add_obj end interface interface subroutine delete_obj(iobj,nobj) integer, intent(in) :: iobj,nobj end subroutine delete_obj end interface contains subroutine prompt_list(nobj,maxobj,objname,print_objlist,add_obj,delete_obj) use prompting, only:prompt implicit none integer, intent(inout) :: nobj integer, intent(in) :: maxobj character(len=*), intent(in) :: objname procedure(), pointer, intent(in) :: print_objlist,add_obj,delete_obj character(len=1) :: charp logical :: done,first integer :: istart,iend,ipick ipick = nobj + 1 done = .false. first = .true. charp = 'a' objmenu: do while(.not.done) call print_objlist(nobj) iend = maxobj if (nobj.gt.0 .or. .not.first) then charp='q' print* call prompt(' a)dd '//trim(objname)//', e)dit, d)elete, c)lear all or q)uit/finish?',& charp,list=(/'a','e','d','c','q','s','S','Q'/),noblank=.true.) select case(charp) case('a') istart = nobj iend = nobj + 1 case('e') if (nobj.gt.0) then ipick = 0 call prompt(' pick a '//objname//' to edit ',ipick,0,nobj) if (ipick.gt.0) then istart = ipick - 1 iend = istart + 1 else istart = 0 iend = 1 first = .false. cycle objmenu endif else istart = 0 iend = 1 endif first = .false. case('d') if (nobj.gt.0) then ipick = 0 call prompt(' pick a '//objname//' to delete ',ipick,0,nobj) call delete_obj(ipick,nobj) else print*,'nothing to delete!' endif first = .false. cycle objmenu case('c') nobj = 0 first = .false. cycle objmenu case('q','Q','s','S') done = .true. case default istart = 0 iend = maxobj end select else istart = 0 iend = 1 endif if (.not.done) call add_obj(istart,iend,nobj) first = .false. enddo objmenu return end subroutine prompt_list end module promptlist splash/src/read_data_aly.f90000644 000770 000000 00000021744 12133727455 016651 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! the data is stored in the global array dat ! ! THIS VERSION FOR ABDEL REHEAM's SPH CODE ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- !--local module to store header information so we can later set the labels module alydataread use params use labels, only:lenlabel implicit none character(len=16), dimension(maxplot) :: compName end module alydataread subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:npartoftype,masstype,time,gamma,dat,maxpart,maxstep,maxcol,iamtype use params use filenames, only:nfiles use settings_data, only:ndim,ndimV,ncolumns,ncalc, & buffer_data,iverbose,debugmode,ntypes use mem_allocation, only:alloc use labels, only:ipr,ivx,ih,irho,labeltype use alydataread, only:compName implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+4) :: datfile integer :: i,ierr,iunit,j,iblock integer :: npart_max,nstep_max integer, dimension(:), allocatable :: itype character(len=20) :: geomfile character(len=7) :: keyword character(len=70) :: title character(len=1) :: dumchar character(len=16) :: unitsys integer :: istep,jtype,np,ione,kk,idum,nblock real(kind=sing_prec) :: version,timesingle,dum real(kind=doub_prec) :: versiond,timedbl,dumd real :: timein,dx,dy logical :: singleprecision iunit = 11 ! file unit number nstepsread = 0 if (rootname(1:1).ne.' ') then datfile = trim(rootname) else print*,' **** no data read **** ' return endif if (iverbose.ge.1) print "(1x,a)",'reading Aly format' write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ndim = 2 ndimV = 2 ! !--open data file and read data ! open(unit=iunit,iostat=ierr,file=datfile,status='old',form='unformatted',access='stream') if (ierr /= 0) then print*,' *** Error opening '//trim(datfile)//' ***' return endif ! !--read first header line ! read(iunit,iostat=ierr,end=80) keyword read(iunit,iostat=ierr,end=80) version read(iunit,iostat=ierr,end=80) title read(iunit,iostat=ierr,end=80) istep read(iunit,iostat=ierr,end=80) timesingle timein = timesingle read(iunit,iostat=ierr,end=80) np read(iunit,iostat=ierr,end=80) ione if (ierr /= 0 .or. np <= 0 .or. timesingle.lt.0.) then ! !--try single precision ! rewind(iunit) read(iunit,iostat=ierr,end=80) keyword read(iunit,iostat=ierr,end=80) versiond version = versiond read(iunit,iostat=ierr,end=80) title read(iunit,iostat=ierr,end=80) istep read(iunit,iostat=ierr,end=80) timedbl timein = timedbl read(iunit,iostat=ierr,end=80) np read(iunit,iostat=ierr,end=80) ione singleprecision = .false. if (ierr /= 0 .or. np < 0 .or. timedbl < 0.) then print "(a)",' *** Error reading first header ***' close(iunit) return endif endif print "(a,f4.2)",' keyword = '//trim(keyword)//' version = ',version !print "(a)",' title = '//trim(title) print "(a,i6,a,es10.3,a,i6)",' step = ',istep,' time = ',timein,' np = ',np ! !--allocate memory for data arrays ! if (buffer_data) then nstep_max = max(nfiles,maxstep,indexstart) else nstep_max = max(1,maxstep,indexstart) endif npart_max = max(int(1.1*np),maxpart) ncolumns = 7 if (.not.allocated(dat) .or. npart_max.gt.maxpart & .or. nstep_max.gt.maxstep .or. ncolumns+ncalc.gt.maxcol) then call alloc(npart_max,nstep_max,ncolumns+ncalc,mixedtypes=.true.) endif i = indexstart nstepsread = 0 time(i) = timein gamma(i) = 5./3. npartoftype(1,i) = np do j=1,np read(iunit,iostat=ierr,end=67) idum,(dat(j,kk,i),kk=1,2),dum enddo read(iunit,iostat=ierr,end=67) nblock read(iunit,iostat=ierr,end=67) (idum,j=1,nblock) ntypes = 4 allocate(itype(np)) read(iunit,iostat=ierr,end=67) (itype(j),j=1,nblock) npartoftype(:,i) = 0 do j=1,np jtype = itype(j) !--map types from code types to splash types select case(jtype) case(1) jtype = 2 ! boundary case(2) jtype = 1 ! water case default ! unknown jtype = 4 end select iamtype(j,i) = jtype npartoftype(jtype,i) = npartoftype(jtype,i) + 1 enddo deallocate(itype) read(iunit,iostat=ierr,end=67) (dumchar,j=1,nblock) read(iunit,iostat=ierr,end=67) (idum,j=1,nblock) call set_labels do iblock=1,1 read(iunit,iostat=ierr,end=67) nblock read(iunit,iostat=ierr,end=67) idum do j=1,nblock read(iunit,iostat=ierr,end=67) compName(j),unitsys,idum,idum,dum !print*,trim(compName(j)) enddo do j=1,np read(iunit,iostat=ierr,end=67) dum,dat(j,ipr,i),dat(j,ivx,i),dat(j,ivx+1,i),dat(j,1,i),dat(j,2,i) if (abs(dum).lt.tiny(0.)) then npartoftype(iamtype(j,i),i) = npartoftype(iamtype(j,i),i) - 1 ! remove from previous type iamtype(j,i) = 3 npartoftype(3,i) = npartoftype(3,i) + 1 ! add to "box" type endif enddo enddo ! !--fake other properties: density, mass, smoothing length etc. ! masstype(1,i) = 1./npartoftype(1,i) ! !--assume smoothing length to be the max dimension divided by the number of particles^(1/ndim) ! dx = maxval(dat(1:np,1,i)) - minval(dat(1:np,1,i)) dy = maxval(dat(1:np,2,i)) - minval(dat(1:np,2,i)) dat(:,ih,i) = dx/(npartoftype(1,i))**(1./ndim)*(dy/dx) print*,' WARNING: ASSUMING SMOOTHING LENGTH = ',dat(1,ih,i),' AND ARBITRARY PARTICLE MASSES' dat(:,irho,i) = 1. nstepsread = 1 do jtype=1,ntypes write(*,"(' n(',a,') = ',i6)",advance="no") trim(labeltype(jtype)),npartoftype(jtype,i) enddo write(*,*) !read* goto 68 67 continue print "(a)",' > end of file reached <' 68 continue ! !--close data file and return ! close(unit=11) if (debugmode) print*,'DEBUG> Read steps ',indexstart,'->',indexstart + nstepsread - 1, & ' last step ntot = ',sum(npartoftype(:,indexstart+nstepsread-1)) return 80 continue print*,' *** data file empty : no timesteps ***' return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:ix,ivx,ih,irho,ipr,& iamvec,labelvec,label,labeltype use params use settings_data, only:ndim,ndimV,UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = ndim + 1 ipr = ndim + ndimV + 1 irho = ipr + 1 ih = irho + 1 label(ipr) = 'pressure' label(irho) = 'density' label(ih) = 'h' label(ix(1:ndim)) = labelcoord(1:ndim,1) ! !--label vector quantities (e.g. velocity) appropriately ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' ! !--set labels for each type of particles ! labeltype(1) = 'water' labeltype(2) = 'boundary' labeltype(3) = 'box' labeltype(4) = 'unknown' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. UseTypeInRenderings(3) = .false. UseTypeInRenderings(4) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_amuse_hdf5.f90000644 000770 000000 00000031644 12442021255 020070 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR HDF5 OUTPUT FROM THE AMUSE FRAMEWORK ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Columns with the 'required' flag set to false are not read !------------------------------------------------------------------------- ! ! The module below contains interface routines to c functions ! that perform the actual calls to the HDF5 libs ! !------------------------------------------------------------------------- module amusehdf5read use params, only:maxplot,doub_prec use labels, only:lenlabel use, intrinsic :: iso_c_binding, only:c_int,c_double,c_char implicit none real :: hsoft character(len=lenlabel), dimension(maxplot) :: blocklabel logical :: havewarned = .false. integer, parameter :: maxtypes = 6 interface subroutine read_amuse_hdf5_header(filename,npart,ncol,ndim,ndimV,time,ierr) bind(c) import character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(out) :: npart,ncol,ndim,ndimV,ierr real(kind=c_double), intent(out) :: time end subroutine read_amuse_hdf5_header subroutine read_amuse_hdf5_data(filename,maxtypes,npartoftypei,& ncol,isrequired,ierr) bind(c) import implicit none character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(in), value :: maxtypes integer(kind=c_int), dimension(6), intent(in) :: npartoftypei integer(kind=c_int), intent(in), value :: ncol integer(kind=c_int), intent(out) :: ierr integer(kind=c_int), dimension(ncol), intent(in) :: isrequired end subroutine read_amuse_hdf5_data end interface end module amusehdf5read !------------------------------------------------------------------------- ! ! The routine that reads the data into splash's internal arrays ! !------------------------------------------------------------------------- subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,npartoftype,masstype,time,gamma,maxpart,maxcol,maxstep use params, only:doub_prec,maxparttypes,maxplot use settings_data, only:ndim,ndimV,ncolumns,ncalc,iformat,required,ipartialread, & ntypes,debugmode,iverbose use settings_page, only:legendtext use mem_allocation, only:alloc use labels, only:ih,irho,ipmass,labeltype use system_utils, only:renvironment,lenvironment,ienvironment,envlist use asciiutils, only:cstring use amusehdf5read, only:hsoft,blocklabel,havewarned,read_amuse_hdf5_header, & read_amuse_hdf5_data,maxtypes implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile,densfile,hfile character(len=20) :: string integer :: i,j,itype,ierr integer :: index1,index2,nhfac integer :: ncolstep,npart_max,nstep_max,ntoti,ntotall,idot integer, parameter :: iunit = 11 logical :: iexist,reallocate,usez,debug,goterrors real(doub_prec) :: timetemp,ztemp real :: hfact,hfactmean,pmassi real, parameter :: pi = 3.1415926536 integer, dimension(maxplot) :: isrequired nstepsread = 0 goterrors = .false. if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! print "(1x,a)",'reading AMUSE HDF5 format' inquire(file=datfile,exist=iexist) if (.not.iexist) then ! !--append .hdf5 on the end if not already present ! datfile=trim(rootname)//'.hdf5' inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(rootname)//': file not found ***' return endif endif ! !--set parameters which do not vary between timesteps ! ndim = 3 ndimV = 3 ! !--read data from snapshots ! i = istepstart write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open file and read header information ! if (debug) print*,'DEBUG: reading header...' call read_amuse_hdf5_header(cstring(datfile),ntoti,ncolstep,ndim,ndimV,timetemp,ierr) if (ierr /= 0) then print "(a)", '*** ERROR READING HEADER ***' return endif ncolumns = ncolstep if (iverbose >= 1) print "(2(a,1x,i10))",' npart: ',ntoti,' ncolumns: ',ncolstep ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if (ntoti.gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*ntotall) else ! if first time, save on memory npart_max = int(ntoti) endif endif if (i.ge.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol)) endif ! !--copy header data into allocated arrays ! npartoftype(1,i) = ntoti time(i) = real(timetemp) masstype(:,i) = 0. ! all masses read from file ! !--read particle data ! got_particles: if (ntoti > 0) then isrequired(:) = 0 where (required(1:ncolumns)) isrequired(1:ncolumns) = 1 call read_amuse_hdf5_data(cstring(datfile),ntypes,npartoftype(:,i),ncolumns,isrequired,ierr) nstepsread = 1 endif got_particles ! !--now memory has been allocated, set arrays which are constant for all time ! gamma = 5./3. ! !--set flag to indicate that only part of this file has been read ! if (.not.all(required(1:ncolstep))) ipartialread = .true. ! !--call set labels to identify location of smoothing length ! call set_labels ! !--for read from multiple files, work out the next file in the sequence ! ! !--for some reason the smoothing length output by GADGET is ! twice the usual SPH smoothing length ! (do this after we have read data from all of the files) ! if (required(ih) .and. size(dat(1,:,:)).ge.ih .and. npartoftype(1,i).gt.0 .and. ih.gt.0) then print "(a)",' converting GADGET smoothing length on gas particles to usual SPH definition (x 0.5)' dat(1:npartoftype(1,i),ih,i) = 0.5*dat(1:npartoftype(1,i),ih,i) endif ! !--give a friendly warning about using too few or too many neighbours ! (only works with equal mass particles because otherwise we need the number density estimate) ! if (ih.gt.0 .and. required(ih) .and. ipmass.gt.0 .and. required(ipmass) & .and. abs(masstype(1,i)).lt.tiny(0.) .and. ndim.eq.3 .and. .not.havewarned) then nhfac = 100 if (npartoftype(1,i).gt.nhfac) then hfactmean = 0. do j=1,nhfac pmassi = dat(j,ipmass,i) if (pmassi.gt.0.) then pmassi = 1./pmassi else pmassi = 0. endif hfact = dat(j,ih,i)*(dat(j,irho,i)*pmassi)**(1./ndim) hfactmean = hfactmean + hfact enddo hfact = hfactmean/real(nhfac) havewarned = .true. print "(/,1x,a,f5.1,a,/,1x,a,f4.2,a,i1,a,/)", & 'Simulations employ ',4./3.*pi*(2.*hfact)**3,' neighbours,', & 'corresponding to h = ',hfact,'*(m/rho)^(1/',ndim,') in 3D' endif endif ! !--cover the special case where no particles have been read ! if (ntoti.le.0) then npartoftype(1,i) = 1 dat(:,:,i) = 0. endif if (nstepsread.gt.0) then print "(a,i10,a)",' >> read ',sum(npartoftype(:,istepstart+nstepsread-1)),' particles' endif return end subroutine read_data subroutine read_amuse_hdf5_data_fromc(icol,npartoftypei,temparr,itype) bind(c) use, intrinsic :: iso_c_binding, only:c_int,c_double use particle_data, only:dat,iamtype use settings_data, only:debugmode use labels, only:label implicit none integer(kind=c_int), intent(in) :: icol,npartoftypei,itype real(kind=c_double), intent(in) :: temparr(npartoftypei) integer(kind=c_int) :: i,icolput integer :: nmax,nerr,idi logical :: useids icolput = icol if (debugmode) print "(a,i2,a,i2,a,i8)",'DEBUG: reading column ',icol,' type ',itype,' -> '//trim(label(icolput)) ! check column is within array limits if (icolput.gt.size(dat(1,:,1)) .or. icolput.eq.0) then print "(a,i2,a)",' ERROR: column = ',icolput,' out of range in receive_data_fromc' return endif ! ensure no array overflows nmax = min(npartoftypei,size(dat(:,1,1))) ! copy data into main splash array dat(1:nmax,icolput,1) = real(temparr(1:nmax)) ! set particle type if (size(iamtype(:,1)).gt.1) then do i=1,nmax iamtype(i,1) = itype + 1 enddo endif return end subroutine read_amuse_hdf5_data_fromc !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,ix,ivx,ipmass, & ih,irho,ipr,iutherm,iBfirst,idivB,iax use params use settings_data, only:ndim,ndimV,ncolumns,ntypes,UseTypeInRenderings,iformat use geometry, only:labelcoord use system_utils, only:envlist,ienvironment use amusehdf5read, only:hsoft,blocklabel use asciiutils, only:lcase implicit none integer :: i,j,icol,irank if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif ix = 0 iutherm = 0 do icol=1,size(blocklabel) select case(trim(lcase(blocklabel(icol)))) case('x') ix(1) = icol case('y') ix(2) = icol case('z') ix(3) = icol case('vx') ivx = icol case('ax') iax = icol case('h_smooth') ih = icol case('mass') ipmass = icol case('density') irho = icol end select label(icol) = trim(blocklabel(icol)) enddo ! set labels of the quantities read in if (ix(1).gt.0) label(ix(1:ndim)) = labelcoord(1:ndim,1) !if (irho.gt.0) label(irho) = 'density' !if (iutherm.gt.0) label(iutherm) = 'u' !if (ipmass.gt.0) label(ipmass) = 'particle mass' !if (ih.gt.0) label(ih) = 'h' ! set labels for vector quantities if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'_'//labelcoord(i,1) enddo endif if (iax.gt.0) then iamvec(iax:iax+ndimV-1) = iax labelvec(iax:iax+ndimV-1) = 'a' do i=1,ndimV label(iax+i-1) = trim(labelvec(iax))//'_'//labelcoord(i,1) enddo endif ! set labels for each particle type labeltype(1) = 'gas' UseTypeInRenderings(:) = .false. UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels subroutine set_blocklabel(icol,name) bind(c) use, intrinsic :: iso_c_binding, only:c_int, c_char use amusehdf5read, only:blocklabel use asciiutils, only:fstring implicit none integer(kind=c_int), intent(in) :: icol character(kind=c_char), intent(in) :: name(256) blocklabel(icol) = trim(fstring(name)) !print*,icol,' name = ',trim(blocklabel(icol)) end subroutine set_blocklabel splash/src/read_data_amuse_hdf5_utils.c000644 000770 000000 00000032303 12370316150 021126 0ustar00dpricewheel000000 000000 /* * This subroutine performs the calls to the HDF5 library for the * GADGET data read * * Easier to do it this way and link with c than to try to link against * the Fortran interface (in the latter case the modules must * have been compiled with the *exact* compiler used to compile splash * which is a real pain). * */ #include #include #include #include static int debug = 0; int checkfordataset(hid_t file_id, char *datasetname); int read_amuse_hdf5_dataset(hid_t group_id, char *datasetname, int itype, int maxtypes, int npartoftype[maxtypes], int ncol, int isrequired[ncol], int *j); int get_rank(hid_t dataspace_id); int get_rank_by_name(hid_t group_id, char *name); void set_blocklabel(int *icol, char *name); void read_amuse_hdf5_data_fromc(int *icol, int *npartoftypei, double temparr[*npartoftypei],int *itype); void read_amuse_hdf5_header(char *filename, int *npart, int *ncol, int *ndim, int *ndimV, double *time, int *ierr) { hid_t file_id; hid_t group_id, group_id1, group_id2; hid_t attrib_id; herr_t status; herr_t HDF5_error = -1; *ierr = 0; *ndim = 0; *ndimV = 0; if (debug) printf("DEBUG: opening %s \n",filename); file_id = H5Fopen(filename,H5F_ACC_RDONLY,H5P_DEFAULT); if (file_id == HDF5_error) { printf("ERROR opening %s \n",filename); *ierr = 1; return; } char *maingroup = "particles"; /* * Open the "particles" dataset and read the number of particles attribute * */ if (!checkfordataset(file_id,maingroup)) { printf(" ERROR: \"%s\" dataset not found in AMUSE HDF5 file\n",maingroup); *ierr = 2; return; } #if H5_VERSION_GE(1,8,0) group_id1 = H5Gopen2(file_id,maingroup,H5P_DEFAULT); #else group_id1 = H5Gopen(file_id,maingroup); #endif if (group_id1 == HDF5_error) { printf("ERROR opening %s data set \n",maingroup); *ierr = 2; return; } #if H5_VERSION_GE(1,8,0) group_id = H5Gopen2(group_id1,"0000000001",H5P_DEFAULT); #else group_id = H5Gopen(group_id1,"0000000001"); #endif if (group_id == HDF5_error) { printf("ERROR opening 00000000001 data set \n"); *ierr = 2; return; } int nattrib; int i; char name[256]; nattrib = H5Aget_num_attrs(group_id); if (debug) printf("number of attributes found = %i\n",nattrib); /* * Read through all of the attributes in the header, so we * can still spit out the values even if they are not used by SPLASH */ for(i=0; i < nattrib; i++) { attrib_id = H5Aopen_idx(group_id,i); ssize_t attr_status; attr_status = H5Aget_name(attrib_id, 256, name); hid_t type_id; type_id = H5Aget_type(attrib_id); /*type_class = H5Tget_native_type(type_id,H5T_DIR_ASCEND);*/ if (strcmp(name,"time")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,time); } else if (strcmp(name,"number_of_particles")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,npart); } else { if (debug) printf("DEBUG: unknown attribute %s \n",name); } if (status==HDF5_error) { printf(" ERROR reading attribute %s \n",name); } status = H5Aclose(attrib_id); } /* * Now we need to get the number of data columns in the file * (from the number of datasets in the "attributes" group) */ #if H5_VERSION_GE(1,8,0) group_id2 = H5Gopen2(group_id,"attributes",H5P_DEFAULT); #else group_id2 = H5Gopen(group_id,"attributes"); #endif if (group_id2 == HDF5_error) { printf("ERROR opening %s data set \n","attributes"); *ierr = 2; return; } hsize_t ndatasets; status = H5Gget_num_objs(group_id2, &ndatasets); if (debug) printf("DEBUG: number of datasets = %i \n",(int)ndatasets); *ncol = (int)ndatasets; int idim; /* check that coordinates are present in file */ idim = get_rank_by_name(group_id2,"x"); if (idim <= 0) { printf("ERROR: x positions not found\n"); *ierr = 3; } idim = get_rank_by_name(group_id2,"y"); if (idim <= 0) { printf("ERROR: y positions not found\n"); *ierr = 3; } idim = get_rank_by_name(group_id2,"z"); if (idim <= 0) { printf("z positions not found, assuming file is 2D \n"); *ndim = 2; *ndimV = 2; } else { *ndim = 3; *ndimV = 3; } /* finish, close all open datasets and close file */ status = H5Gclose(group_id2); if (status == HDF5_error) { printf("ERROR closing attributes data set \n"); *ierr = 3; return; } status = H5Gclose(group_id); if (status == HDF5_error) { printf("ERROR closing %s data set \n",maingroup); *ierr = 3; return; } status = H5Gclose(group_id1); if (status == HDF5_error) { printf("ERROR closing 0001 data set \n"); *ierr = 3; return; } status = H5Fclose( file_id ); if (status == HDF5_error) { printf("ERROR closing file \n"); *ierr = 7; } if (debug) printf("DEBUG: finished header read \n"); } void read_amuse_hdf5_data(char *filename, int maxtypes, int npartoftype[maxtypes], int ncol, int isrequired[ncol], int *ierr) { hid_t file_id; hid_t group_id, group_id1, group_id2; herr_t status; herr_t HDF5_error = -1; char groupname[12]; char datasetname[256]; int i; if (debug) printf("DEBUG: re-opening %s \n",filename); file_id = H5Fopen(filename,H5F_ACC_RDONLY,H5P_DEFAULT); if (file_id == HDF5_error) { printf("ERROR re-opening %s \n",filename); *ierr = 1; return; } /* open main particles group */ char *maingroup = "particles"; #if H5_VERSION_GE(1,8,0) group_id1 = H5Gopen2(file_id,maingroup,H5P_DEFAULT); #else group_id1 = H5Gopen(file_id,maingroup); #endif if (debug) printf("DEBUG: maxtypes = %i\n",maxtypes); /* read dataset for each particle type present in dump file */ int itype,iobjtype; for (itype=0;itype 0) { /* If npartoftype[N] > 0 in header, look for dataset of the form 000000000N */ sprintf(groupname,"00000000%02i",itype+1); if (debug) printf("DEBUG: opening group %s\n",groupname); #if H5_VERSION_GE(1,8,0) group_id = H5Gopen2(group_id1,groupname,H5P_DEFAULT); #else group_id = H5Gopen(group_id1,groupname); #endif if (group_id == HDF5_error) { printf("ERROR opening %s group \n",groupname); *ierr = 2; } else { #if H5_VERSION_GE(1,8,0) group_id2 = H5Gopen2(group_id,"attributes",H5P_DEFAULT); #else group_id2 = H5Gopen(group_id,"attributes"); #endif if (group_id2 == HDF5_error) { printf("ERROR opening attributes group \n"); *ierr = 2; } else { hsize_t ndatasets; status = H5Gget_num_objs(group_id2, &ndatasets); if (debug) printf("DEBUG: number of datasets = %i \n",(int)ndatasets); int j = 0; /* always read particle positions first */ *ierr = read_amuse_hdf5_dataset(group_id2,"x",itype,maxtypes,npartoftype,ncol,isrequired,&j); j = 1; *ierr = read_amuse_hdf5_dataset(group_id2,"y",itype,maxtypes,npartoftype,ncol,isrequired,&j); j = 2; *ierr = read_amuse_hdf5_dataset(group_id2,"z",itype,maxtypes,npartoftype,ncol,isrequired,&j); /* read remaining datasets in the order they appear in the file */ for(i=0; i < (int)ndatasets; i++) { status = H5Gget_objname_by_idx(group_id2, i, datasetname, 256); iobjtype = H5Gget_objtype_by_idx(group_id2, i); if (strcmp(datasetname,"x")&& strcmp(datasetname,"y")&& strcmp(datasetname,"z")&& (iobjtype == H5G_DATASET)) { *ierr = read_amuse_hdf5_dataset(group_id2,datasetname,itype,maxtypes,npartoftype,ncol,isrequired,&j); } } /* close "attributes" group */ H5Gclose(group_id2); } H5Gclose(group_id); } } } H5Gclose(group_id1); status = H5Fclose( file_id ); if (status == HDF5_error) { printf("ERROR closing file \n"); *ierr = 7; } } int read_amuse_hdf5_dataset(hid_t group_id, char *datasetname, int itype, int maxtypes, int npartoftype[maxtypes], int ncol, int isrequired[ncol], int *j) { hid_t dataset_id, dataspace_id, memspace_id; herr_t status; herr_t HDF5_error = -1; int ierr = 0; char name[256]; if (!checkfordataset(group_id,datasetname)) { ierr = 1; return ierr; } #if H5_VERSION_GE(1,8,0) dataset_id = H5Dopen2(group_id,datasetname,H5P_DEFAULT); #else dataset_id = H5Dopen(group_id,datasetname); #endif dataspace_id = H5Dget_space(dataset_id); int rank = get_rank(dataspace_id); int k, flag; /* do nothing if none of the columns are required */ flag = 0; for (k=0;k1) { rank = dims[1]; } else { rank = 1; } return rank; } /* * utility function to get dimensionality of a dataset */ int get_rank_by_name(hid_t group_id, char *name) { if (!checkfordataset(group_id,name)) { return 0; } herr_t HDF5_error = -1; #if H5_VERSION_GE(1,8,0) hid_t dataset_id = H5Dopen2(group_id,name,H5P_DEFAULT); #else hid_t dataset_id = H5Dopen(group_id,name); #endif if (dataset_id == HDF5_error) { printf("ERROR opening %s data set \n",name); return 0; } hid_t dataspace_id = H5Dget_space(dataset_id); int rank = get_rank(dataspace_id); H5Dclose(dataset_id); return rank; } splash/src/read_data_ascii.f90000644 000770 000000 00000041352 12541236676 017154 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR GENERAL ASCII DATA FORMATS ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! ASPLASH_COLUMNSFILE gives the location of the default 'columns' file ! (overridden by the presence of a `columns' file in the working directory) ! ! ASPLASH_NCOLUMNS can be used to override the automatic ncolumns choice ! ! e.g. setenv ASPLASH_NCOLUMNS=10 ! ! ASPLASH_NHEADERLINES can be used to override the automatic number of header line determination ! ! e.g. setenv ASPLASH_NHEADERLINES=1 ! ! ASPLASH_TIMEVAL can be used to set the time (fixed for all files) ! ASPLASH_GAMMAVAL can be used to set gamma (fixed for all files) ! ASPLASH_HEADERLINE_TIME can be used to set the header line where the time is listed ! ASPLASH_HEADERLINE_GAMMA can be used to set the header line where gamma is listed ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- module asciiread integer :: icoltype end module asciiread subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,npartoftype,time,gamma,maxpart,maxcol,maxstep,iamtype use params use settings_data, only:ndim,ndimV,ncolumns,ncalc,iverbose,ntypes use mem_allocation, only:alloc use asciiutils, only:get_ncolumns use system_utils, only:ienvironment,renvironment use asciiread, only:icoltype use labels, only:labeltype,print_types implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,ierr,iunit,ncolstep,ncolenv,nerr,iheader_time,iheader_gamma integer :: nprint,npart_max,nstep_max,icol,nheaderlines,nheaderenv,itype integer :: noftype(maxparttypes),iverbose_was logical :: iexist,timeset,gammaset real :: dummyreal character(len=len(rootname)+4) :: dumpfile character(len=40) :: line integer, parameter :: notset = -66 nstepsread = 0 nstep_max = 0 npart_max = maxpart iunit = 15 ! logical unit number for input dumpfile = trim(rootname) if (iverbose.gt.0) print "(1x,a)",'reading ascii format' print "(26('>'),1x,a,1x,26('<'))",trim(dumpfile) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions (0 means no particle coords) ! ndim = 0 ndimV = 0 j = indexstart nstepsread = 0 icoltype = 0 ! no particle type defined by default ! !--open the file and read the number of particles ! open(unit=iunit,iostat=ierr,file=dumpfile,status='old',form='formatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return else call get_ncolumns(iunit,ncolstep,nheaderlines) !--override header lines setting nheaderenv = ienvironment('ASPLASH_NHEADERLINES',-1) if (nheaderenv.ge.0) then if (iverbose.gt.0) print*,' setting nheader lines = ',nheaderenv,' from ASPLASH_NHEADERLINES environment variable' nheaderlines = nheaderenv endif !--override columns setting with environment variable ncolenv = ienvironment('ASPLASH_NCOLUMNS',-1) if (ncolenv.gt.0) then if (iverbose.gt.0) print "(a,i3,a)",' setting ncolumns = ',ncolenv,' from ASPLASH_NCOLUMNS environment variable' ncolstep = ncolenv endif if (ncolstep.le.0) then print "(a)",'*** ERROR: zero/undetermined number of columns in file ***' return endif iverbose_was = iverbose iverbose = 0 ncolumns = ncolstep call set_labels() ! to see if types are defined iverbose = iverbose_was ! !--allocate memory initially ! nprint = 101 nstep_max = max(nstep_max,indexstart,1) if (.not.allocated(dat) .or. (nprint.gt.npart_max) .or. (ncolstep+ncalc).gt.maxcol) then npart_max = max(npart_max,INT(1.1*(nprint))) call alloc(npart_max,nstep_max,ncolstep+ncalc,mixedtypes=(icoltype > 0)) endif endif npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+1,maxcol,mixedtypes=(icoltype > 0)) endif ! !--can set either set the time and gamma explicitly ! using environment variables (fixed for all files) ! or can specify on which header line the time appears ! timeset = .false. gammaset = .false. dummyreal = renvironment('ASPLASH_TIMEVAL',errval=-1.) if (dummyreal.gt.0.) then time(j) = dummyreal timeset = .true. endif dummyreal = renvironment('ASPLASH_GAMMAVAL',errval=-1.) if (dummyreal.gt.0.) then gamma(j) = dummyreal gammaset = .true. endif iheader_time = ienvironment('ASPLASH_HEADERLINE_TIME',errval=notset) iheader_gamma = ienvironment('ASPLASH_HEADERLINE_GAMMA',errval=notset) ! !--read header lines, try to use it to set time ! if (nheaderlines.gt.0 .and. iverbose.gt.0) print*,'skipping ',nheaderlines,' header lines' do i=1,nheaderlines !--read header lines as character strings ! so that blank lines are counted in nheaderlines read(iunit,"(a)",iostat=ierr) line read(line,*,iostat=ierr) dummyreal if (i.eq.iheader_time .and. .not.timeset) then if (ierr.eq.0) then time(j) = dummyreal timeset = .true. print*,'setting time = ',dummyreal,' from header line ',i print*,'(determined from ASPLASH_HEADERLINE_TIME setting)' else print "(a,i2,a)",' ** ERROR reading time from header line ',i, & ' (using ASPLASH_HEADERLINE_TIME)' endif elseif (i.eq.iheader_gamma .and. .not.gammaset) then if (ierr.eq.0) then gamma(j) = dummyreal gammaset = .true. print*,'setting gamma = ',dummyreal,' from header line ',i print*,'(determined from ASPLASH_HEADERLINE_GAMMA setting)' else print "(a,i2,a)",' ** ERROR reading gamma from header line ',i, & ' (using ASPLASH_HEADERLINE_GAMMA)' endif elseif (timeset .and. .not.gammaset .and. ierr.eq.0 .and. iheader_gamma.eq.notset & .and. dummyreal.gt.0.999999 .and. dummyreal.lt.2.000001) then print*,'setting gamma = ',dummyreal,' from header line ',i gamma(j) = dummyreal gammaset = .true. elseif (ierr.eq.0 .and. .not. timeset .and. iheader_time.eq.notset) then time(j) = dummyreal timeset = .true. print*,'setting time = ',dummyreal,' from header line ',i endif enddo ! !--now read the timestep data in the dumpfile ! i = 0 ierr = 0 nerr = 0 noftype(:) = 0 ntypes = 1 overparts: do while (ierr >= 0) i = i + 1 if (i.gt.npart_max) then ! reallocate memory if necessary npart_max = 10*npart_max call alloc(npart_max,nstep_max,ncolstep+ncalc,mixedtypes=(icoltype > 0)) endif read(iunit,*,iostat=ierr) (dat(i,icol,j),icol = 1,ncolstep) if (icoltype > 0 .and. icoltype <= ncolstep .and. ierr==0 .and. (size(iamtype(:,j)) > 1)) then !--set particle type from type column itype = nint(dat(i,icoltype,j)) if (itype > 0 .and. itype < maxparttypes) then iamtype(i,j) = int(itype,kind=1) else iamtype(i,j) = 1 endif itype = iamtype(i,j) noftype(itype) = noftype(itype) + 1 ntypes = max(itype,ntypes) endif if (ierr > 0) then nerr = nerr + 1 if (nerr .le. 10) print "(a,i8,a)",' ERROR reading data from line ',i+nheaderlines,', skipping' i = i - 1 ! ignore lines with errors endif enddo overparts nprint = i - 1 nstepsread = nstepsread + 1 if (nerr > 10) then print "(a,i8,a)",' *** WARNING: errors whilst reading file on ',nerr,' lines: skipped these ***' endif if (ierr < 0) then print "(2(a,i10))",' read npts = ',nprint,' ncolumns = ',ncolstep endif npartoftype(:,j) = 0 if (icoltype > 0 .and. icoltype <= ncolstep) then npartoftype(1:ntypes,j) = noftype(1:ntypes) call print_types(npartoftype(:,j),labeltype) else npartoftype(1,j) = nprint endif close(iunit) return end subroutine read_data !!------------------------------------------------------------------- !! set labels for each column of data !! !! read these from a file called 'columns' in the current directory !! then take sensible guesses as to which quantities are which !! from the column labels !! !!------------------------------------------------------------------- subroutine set_labels use asciiutils, only:lcase use labels, only:label,labeltype,ix,irho,ipmass,ih,iutherm, & ipr,ivx,iBfirst,iamvec,labelvec,lenlabel !use params, only:maxparttypes use settings_data, only:ncolumns,ndim,ndimV,UseTypeInRenderings,iverbose use geometry, only:labelcoord use system_commands, only:get_environment use filenames, only:fileprefix use asciiread, only:icoltype implicit none integer :: i,ierr,ndimVtemp character(len=120) :: columnfile character(len=lenlabel) :: labeli logical :: iexist ! !--read column labels from the columns file if it exists ! ! first look for a columns file in the current directory ! either called splash.columns or just 'columns' ! columnfile=trim(fileprefix)//'.columns' inquire(file=trim(columnfile),exist=iexist) if (.not.iexist) then columnfile='columns' inquire(file=trim(columnfile),exist=iexist) endif ! ! if it does not exist see if the environment variable is set ! and the corresponding file exists ! if (.not.iexist) then call get_environment('ASPLASH_COLUMNSFILE',columnfile) if (len_trim(columnfile).gt.0) then inquire(file=trim(columnfile),exist=iexist) if (iexist) then if (iverbose.gt.0) print "(a)",' using ASPLASH_COLUMNSFILE='//trim(columnfile) else print "(a)",' ERROR: ASPLASH_COLUMNSFILE='//trim(columnfile)//' DOES NOT EXIST' columnfile = 'columns' endif else columnfile = 'columns' endif endif open(unit=51,file=trim(columnfile),status='old',iostat=ierr) if (ierr /=0) then if (iverbose > 0) then print "(3(/,a))",' WARNING: columns file not found: using default labels',& ' To change the labels, create a file called ''columns'' ',& ' in the current directory with one label per line' endif else overcols: do i=1,ncolumns read(51,"(a)",iostat=ierr) label(i) ! !--compare all strings in lower case, trimmed and with no preceding spaces ! labeli = trim(adjustl(lcase(label(i)))) ! !--guess positions of various quantities from the column labels ! if (ndim.le.0 .and. (labeli(1:1).eq.'x' .or. labeli(1:1).eq.'r')) then ndim = 1 ix(1) = i endif if (ndim.eq.1 .and. i.eq.ix(1)+1 .and. (labeli(1:1).eq.'y' .or. labeli(1:1).eq.'z')) then ndim = 2 ix(2) = i endif if (ndim.eq.2 .and. i.eq.ix(2)+1 .and. labeli(1:1).eq.'z') then ndim = 3 ix(3) = i endif if (labeli(1:3).eq.'den' .or. index(labeli,'rho').ne.0 .or. labeli(1:3).eq.'\gr') then irho = i elseif (labeli(1:5).eq.'pmass' .or. labeli(1:13).eq.'particle mass' & .or. index(labeli,'mass').ne.0) then ipmass = i elseif (ipmass.eq.0 .and. trim(labeli).eq.'m') then ipmass = i !--use first column labelled h as smoothing length elseif (ih.eq.0 .and. (labeli(1:1).eq.'h' & .or. labeli(1:6).eq.'smooth')) then ih = i elseif (trim(labeli).eq.'u'.or.labeli(1:6).eq.'utherm' & .or.trim(labeli).eq.'internal energy') then iutherm = i elseif (labeli(1:2).eq.'pr' .or. trim(labeli).eq.'p') then ipr = i elseif (ivx.eq.0 .and. labeli(1:1).eq.'v') then ivx = i ndimV = 1 elseif (icoltype==0 .and. index(labeli,'type').ne.0) then icoltype = i endif !--set ndimV as number of columns with v as label if (ivx.gt.0 .and. i.gt.ivx .and. i.le.ivx+2) then if (labeli(1:1).eq.'v') ndimV = i - ivx + 1 endif if (iBfirst.eq.0 .and. (labeli(1:2).eq.'bx')) then iBfirst = i endif !--set ndimV as number of columns with v as label if (iBfirst.gt.0 .and. i.gt.iBfirst .and. i.le.iBfirst+2) then if (labeli(1:1).eq.'b') then ndimVtemp = i - iBfirst + 1 if (ndimV.gt.0 .and. ndimVtemp.gt.ndimV) then if (iverbose > 0) print "(a)",' WARNING: possible confusion with vector dimensions' ndimV = ndimVtemp endif endif endif if (ierr < 0) then if (iverbose > 0) print "(a,i3)",' end of file in columns file: read to column ',i-1 exit overcols elseif (ierr > 0) then if (iverbose > 0) print "(a)",' *** error reading from columns file ***' exit overcols endif enddo overcols close(unit=51) endif if (ndim.lt.1) ndimV = 0 if (iverbose > 0) then if (ndim.gt.0) print "(a,i1)",' Assuming number of dimensions = ',ndim if (ndim.gt.0) print "(a,i2,a,i2)",' Assuming positions in columns ',ix(1),' to ',ix(ndim) if (ndimV.gt.0) print "(a,i1)",' Assuming vectors have dimension = ',ndimV if (irho.gt.0) print "(a,i2)",' Assuming density in column ',irho if (ipmass.gt.0) print "(a,i2)",' Assuming particle mass in column ',ipmass if (ih.gt.0) print "(a,i2)",' Assuming smoothing length in column ',ih if (iutherm.gt.0) print "(a,i2)",' Assuming thermal energy in column ',iutherm if (ipr.gt.0) print "(a,i2)",' Assuming pressure in column ',ipr if (ivx.gt.0) then if (ndimV.gt.1) then print "(a,i2,a,i2)",' Assuming velocity in columns ',ivx,' to ',ivx+ndimV-1 else print "(a,i2)",' Assuming velocity in column ',ivx endif endif if (icoltype.gt.0) print "(a,i2)",' Assuming particle type in column ',icoltype if (ndim.eq.0 .or. irho.eq.0 .or. ipmass.eq.0 .or. ih.eq.0) then print "(4(/,a))",' NOTE: Rendering capabilities cannot be enabled', & ' until positions of density, smoothing length and particle', & ' mass are known (for the ascii read the simplest way is to ', & ' label the relevant columns appropriately in the columns file)' endif endif if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo endif if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = ivx labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = 'B\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! !ntypes = 1 !!maxparttypes labeltype(1) = 'gas' UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_bauswein.f90000644 000770 000000 00000017534 11622211702 017664 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM ANDREAS BAUSWEIN'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! BSPLASH_R8 if 'YES' or 'TRUE' then assumes data is double precision ! BSPLASH_NCOL to change the number of columns read from the file, ! e.g. setenv BSPLASH_NCOL=22 ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,time,npartoftype,gamma,maxpart,maxcol use params use settings_data, only:ndim,ndimV,ncolumns use mem_allocation, only:alloc use system_utils, only:lenvironment,ienvironment implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,k,ierr integer :: nprint,n1,npart_max,nstep_max integer :: ncol,nread,nerr,ncoltemp logical :: iexist,doubleprec character(len=len(rootname)) :: dumpfile real :: timei,dti real(doub_prec), dimension(maxcol) :: datdb real(doub_prec) :: timedb,dtdb nstepsread = 0 nstep_max = 0 npart_max = maxpart dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 !--number of columns to read from file ncol = 21 doubleprec = .false. !--can override these settings with environment variables if (lenvironment('BSPLASH_R8')) doubleprec = .true. ncoltemp = ienvironment('BSPLASH_NCOL') if (ncoltemp.gt.0) ncol = ncoltemp ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 print "(1x,a)",'reading Andreas Bauswein format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,file=dumpfile,status='old',form='unformatted',iostat=ierr) if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return else ! !--read the number of particles in the header and allocate memory ! if (doubleprec) then read(15,end=55,iostat=ierr) nprint,n1,timedb,dtdb timei = real(timedb) dti = real(dtdb) else read(15,end=55,iostat=ierr) nprint,n1,timei,dti endif print "(a,f10.2,a,i10,a,i10,a,f10.4)",' time: ',timei,' npart: ',nprint,' n1: ',n1,' dt = ',dti !--barf if stupid values read if (nprint.le.0 .or. nprint.gt.1e10) then print "(a)",' *** ERRORS IN TIMESTEP HEADER: WRONG ENDIAN? ***' close(15) return elseif (ierr /= 0) then print "(a)",'*** WARNING: ERRORS READING HEADER ***' endif if (timei.lt.0. .or. dti.lt.0.) print "(a)",'*** ERROR: t < 0: use setenv BSPLASH_R8=TRUE for double precision' ncolumns = ncol if (.not.allocated(dat) .or. nprint.gt.npart_max) then npart_max = max(npart_max,nprint) call alloc(npart_max,nstep_max,ncolumns) endif ! !--now read the timestep data in the dumpfile ! dat(:,:,j) = 0. time(j) = timei if (doubleprec) then nread = 0 nerr = 0 do i=1,nprint nread = nread + 1 read(15,end=44,iostat=ierr) (datdb(k),k=1,ncol) if (ierr /= 0) nerr = nerr + 1 dat(i,4,j) = real(datdb(1)) dat(i,1:3,j) = real(datdb(2:4)) dat(i,5:ncol,j) = real(datdb(5:ncol)) enddo else nread = 0 nerr = 0 do i=1,nprint nread = nread + 1 read(15,end=44,iostat=ierr) dat(i,4,j),dat(i,1:3,j),(dat(i,k,j),k=5,ncol) if (ierr /= 0) nerr = nerr + 1 enddo endif 44 continue if (nerr.gt.0) print *,'*** WARNING: ERRORS DURING READ ON ',nerr,' LINES' if (nread.lt.nprint) then print "(a)",' WARNING: END OF FILE: read to particle ',nread nprint = nread endif nstepsread = nstepsread + 1 npartoftype(1,j) = nprint gamma(j) = 1.666666666667 j = j + 1 endif 55 continue ! !--reached end of file during header read ! close(15) if (allocated(npartoftype)) then print*,'>> end of dump file: nsteps =',j-1,'ntot = ',sum(npartoftype(:,j-1)) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,labelvec,labeltype,iamvec,& ix,ivx,ih,irho,iutherm,ipmass use settings_data, only:ndim,ndimV,ntypes,UseTypeInRenderings use geometry, only:labelcoord !use settings_units, only:units,unitslabel implicit none integer :: i,ipmom if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ih = 4 ivx = 5 ipmom = 8 iutherm = 11 ipmass = 14 irho = 17 label(ix(1:ndim)) = labelcoord(1:ndim,1) label(ih) = 'h' if (iutherm.gt.0) label(iutherm) = 'u' label(12) = 'psi\dpot\u' label(13) = 'alpha\dpot\u' label(ipmass) = 'particle mass' label(15) = '\gr' label(16) = 'P\deff' label(irho) = '\gr*' label(18) = 'tau' label(19) = '\ga\dvisc' label(20) = 'Ye' label(21) = 'temperature' if (ivx.ne.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = labelvec(ivx)//'\d'//labelcoord(i,1) enddo endif if (ipmom.ne.0) then iamvec(ipmom:ipmom+ndimV-1) = ipmom labelvec(ipmom:ipmom+ndimV-1) = 'momentum' do i=1,ndimV label(ipmom+i-1) = labelvec(ipmom)//'\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 1 labeltype(1) = 'gas' UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_dansph_old.f90000644 000770 000000 00000037413 11622211702 020160 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! the data is stored in the global array dat ! ! THIS VERSION FOR DAN'S SPMHD CODE (BINARY DUMPS) ! PRE NOV 2005 FORMAT ! -> Now automatically handles single/double precision ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use exact, only:hfact use particle_data use params use labels use filenames, only:nfiles use settings_data, only:ndim,ndimV,ncolumns,ncalc,icoords,iformat, & buffer_data use mem_allocation use geometry, only:labelcoordsys implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+4) :: datfile integer :: i,j,icol,ierr,iunit integer :: ncol_max,ndim_max,npart_max,ndimV_max,nstep_max integer :: npartin,ntotin,ncolstep,nparti,ntoti integer, dimension(3) :: ibound logical :: reallocate, singleprecision real :: timein, gammain, hfactin real, dimension(3) :: xmin, xmax real(doub_prec) :: timeind,gammaind,hfactind real(doub_prec), dimension(3) :: xmind, xmaxd iunit = 11 ! file unit number ndim_max = 1 ndimV_max = 1 nstepsread = 0 if (rootname(1:1).ne.' ') then datfile = trim(rootname) !print*,'rootname = ',rootname else print*,' **** no data read **** ' return endif print "(1x,a)",'reading old ndspmhd format' write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! open(unit=iunit,iostat=ierr,file=datfile,status='old',form='unformatted') if (ierr /= 0) then print*,'*** Error opening '//trim(datfile)//' ***' return endif ! !--read first header line ! singleprecision = .false. read(iunit,iostat=ierr,end=80) timeind,npartin,ntotin,gammaind, & hfactind,ndim_max,ndimV_max,ncol_max,icoords !!print*,'time = ',timeind,' hfact = ',hfactind,' ndim=',ndim_max,'ncol=',ncol_max !!print*,'npart = ',npartin,ntotin if (ierr /= 0 .or. ndim_max.le.0 .or. ndim_max.gt.3 & .or. ndimV_max.le.0 .or. ndimV_max.gt.3 & .or. ncol_max.le.0 .or. ncol_max.gt.100 & .or. npartin.le.0 .or. npartin.gt.1e7 .or. ntotin.le.0 .or. ntotin.gt.1e7 & .or. icoords.le.0 .or. icoords.gt.10) then ! !--try single precision ! rewind(iunit) read(iunit,iostat=ierr,end=80) timein,npartin,ntotin,gammain, & hfactin,ndim_max,ndimV_max,ncol_max,icoords singleprecision = .true. if (ierr /= 0) then print "(a)",'*** Error reading first header ***' print*,' time = ',timein,' hfact = ',hfactin,' ndim=',ndim_max,'ncol=',ncol_max close(iunit) return endif endif ! !--allocate memory for data arrays ! if (buffer_data) then nstep_max = max(nfiles,maxstep,indexstart) else nstep_max = max(1,maxstep,indexstart) endif npart_max = max(int(1.5*ntotin),maxpart) if (.not.allocated(dat) .or. ntotin.gt.maxpart & .or. nstep_max.gt.maxstep .or. ncol_max.gt.maxcol) then call alloc(npart_max,nstep_max,ncol_max+ncalc) endif ! !--rewind file ! rewind(iunit) i = indexstart nstepsread = 0 overstepsinfile: do while (i <= maxstep) !!print*,' reading step ',i reallocate = .false. npart_max = maxpart nstep_max = maxstep ! !--read header line for this timestep ! if (singleprecision) then print "(a)",'single precision dump' read(iunit,iostat=ierr,end=67) timein,nparti,ntoti,gammain, & hfactin,ndim,ndimV,ncolstep,icoords,iformat,ibound(1:ndim), & xmin(1:ndim),xmax(1:ndim) else print "(a)",'double precision dump' read(iunit,iostat=ierr,end=67) timeind,nparti,ntoti,gammaind, & hfactind,ndim,ndimV,ncolstep,icoords,iformat,ibound(1:ndim), & xmind(1:ndim),xmaxd(1:ndim) timein = real(timeind) gammain = real(gammaind) hfactin = real(hfactind) xmin = real(xmind) xmax = real(xmaxd) endif if (ierr /= 0) then print*,'*** error reading timestep header ***' close(iunit) return else ! count this as a successfully read timestep, even if data is partial nstepsread = nstepsread + 1 endif time(i) = timein gamma(i) = gammain hfact = hfactin npartoftype(1,i) = nparti npartoftype(2,i) = ntoti - nparti print "(/a14,':',f8.4,a8,':',i8,a8,':',i8)",' time',time(i),'npart',nparti,'ntotal',ntoti print "(a14,':',i8,a8,':',f8.4,a8,':',f8.4)",' ncolumns',ncolstep,'gamma',gamma(i),'hfact',hfact print "(a14,':',i8,a8,':',i8)",'ndim',ndim,'ndimV',ndimV if (icoords.gt.1) print "(a14,':',2x,a)",' geometry',labelcoordsys(icoords) if (any(ibound(1:ndim).ne.0)) then print "(a14,':',a15,' =',3(f8.4))",'boundaries','xmin',xmin(1:ndim) print "(15x,a15,' =',3(f8.4))",'xmax',xmax(1:ndim) endif ! !--check for errors in timestep header ! if (ndim.gt.3 .or. ndimV.gt.3) then print*,'*** error in header: ndim or ndimV in file> 3' nstepsread = nstepsread - 1 ndim = ndim_max ndimV = ndimV_max close(iunit) return endif if (ndim.gt.ndim_max) ndim_max = ndim if (ndimV.gt.ndimV_max) ndimV_max = ndimV if (ncolstep.ne.ncol_max) then print*,'*** Warning number of columns not equal for timesteps' ncolumns = ncolstep print*,'ncolumns = ',ncolumns,ncol_max if (ncolumns.gt.ncol_max) ncol_max = ncolumns endif if (ncolstep.gt.maxcol) then reallocate = .true. ncolumns = ncolstep ncol_max = ncolumns else ncolumns = ncolstep endif if (ntoti.gt.maxpart) then !print*, 'ntot greater than array limits!!' reallocate = .true. npart_max = int(1.5*ntoti) endif if (i.gt.maxstep) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate) then call alloc(npart_max,nstep_max,ncol_max+ncalc) endif if (ntoti.gt.0) then ! !--read position vector ! icol = 1 call readvec(dat(1:ntoti,1:ndim,i),ntoti,ndim,singleprecision,ierr) if (ierr /= 0) then print "(a)",'*** error reading particle positions ***' exit overstepsinfile endif icol = icol + ndim ! !--read velocity vector ! call readvec(dat(1:ntoti,icol:icol+ndimV-1,i),ntoti,ndimV,singleprecision,ierr) if (ierr /= 0) then print "(a)",'*** error reading velocities ***' exit overstepsinfile endif icol = icol + ndimV ! !--read scalar variables ! do j=1,4 call readcol(dat(1:ntoti,icol,i),ntoti,singleprecision,ierr) if (ierr /= 0) print "(a)",'*** error reading column data ***' icol = icol + 1 enddo ! !--non-MHD output ! if (iformat.ne.2) then ! !--read alpha, alphau ! call readvec(dat(1:ntoti,icol:icol+1,i),ntoti,2,singleprecision,ierr) if (ierr /= 0) then print "(a)",'*** error reading alphas ***' exit overstepsinfile endif icol = icol + 2 ! !--pr, div v, gradh ! do j=icol,ncolstep call readcol(dat(1:ntoti,j,i),ntoti,singleprecision,ierr) if (ierr /= 0) print "(a)",'*** error reading column data ***' enddo else ! !--MHD output ! ! !--read alpha, alphau, alphaB ! call readvec(dat(1:ntoti,icol:icol+2,i),ntoti,3,singleprecision,ierr) if (ierr /= 0) then print "(a)",'*** error reading alphas ***' exit overstepsinfile endif icol = icol + 3 ! !--Bfield ! call readvec(dat(1:ntoti,icol:icol+ndimV-1,i),ntoti,ndimV,singleprecision,ierr) if (ierr /= 0) then print "(a)",'*** error reading B ***' exit overstepsinfile endif icol = icol + ndimV ! !--psi, pr, div v, div B ! do j = 1,4 call readcol(dat(1:ntoti,icol,i),ntoti,singleprecision,ierr) if (ierr /= 0) print "(a)",'*** error reading column data ***' icol = icol + 1 enddo ! !--curl B ! call readvec(dat(1:ntoti,icol:icol+ndimV-1,i),ntoti,ndimV,singleprecision,ierr) if (ierr /= 0) then print "(a)",'*** error reading curl B ***' exit overstepsinfile endif icol = icol + ndimV endif !!print*,'columns read = ',icol,' should be = ',ncolumns else npartoftype(1,i) = 1 npartoftype(2,i) = 0 dat(:,:,i) = 0. endif i = i + 1 enddo overstepsinfile 67 continue !!!print "(a)",' > end of file <' ! !--close data file and return ! close(unit=11) ncolumns = ncol_max ndim = ndim_max ndimV = ndimV_max print*,'> Read steps ',indexstart,'->',indexstart + nstepsread - 1, & ' last step ntot = ',sum(npartoftype(:,indexstart+nstepsread-1)) return ! !--errors ! 80 continue print*,' *** data file empty, no steps read ***' return contains subroutine readvec(datin,ntotal,ndims,singleprec,ierr) implicit none integer, intent(in) :: ndims,ntotal integer, intent(out) :: ierr real, intent(out), dimension(ntotal,ndims) :: datin logical, intent(in) :: singleprec integer :: ipos real, dimension(ndims,ntotal) :: datvec real(doub_prec), dimension(ndims,ntotal) :: datvecd ! !--read a vector quantity and restructure into columns ! if (singleprec) then read (iunit,iostat=ierr) datvec(1:ndims,1:ntotal) do ipos = 1,ndims datin(1:ntotal,ipos) = datvec(ipos,1:ntotal) enddo else read (iunit,iostat=ierr) datvecd(1:ndims,1:ntotal) do ipos = 1,ndims datin(1:ntotal,ipos) = real(datvecd(ipos,1:ntotal)) enddo endif end subroutine readvec ! !--read scalar quantity and convert to single precision ! subroutine readcol(datin,ntotal,singleprec,ierr) implicit none integer, intent(in) :: ntotal integer, intent(out) :: ierr real, intent(out), dimension(ntotal) :: datin logical, intent(in) :: singleprec real(doub_prec), dimension(ntotal) :: dattempd ! !--read several scalar quantities ! if (singleprec) then read (iunit,iostat=ierr) datin(1:ntotal) else read (iunit,iostat=ierr) dattempd(1:ntotal) datin(1:ntotal) = real(dattempd(1:ntotal)) endif end subroutine readcol end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data, only:ndim,ndimV,ncolumns,iformat,ntypes, & UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = ndim + 1 ih = ndim + ndimV + 1 ! smoothing length irho = ndim + ndimV + 2 ! location of rho in data array iutherm = ndim + ndimV + 3 ! thermal energy ipmass = ndim + ndimV + 4 ! particle mass label(ix(1:ndim)) = labelcoord(1:ndim,1) ! !--label vector quantities (e.g. velocity) appropriately ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx+i-1))//'\d'//labelcoord(i,1) enddo label(irho) = '\gr' label(iutherm) = 'u' label(ih) = 'h ' label(ipmass) = 'particle mass' label(ndim + ndimV+5) = '\ga' label(ndim + ndimV+6) = '\ga\du' if (iformat.eq.2) then ! !--mag field (vector) ! label(ndim + ndimV+7) = '\ga\dB' iBfirst = ndim + ndimV+7+1 ! location of Bx iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'\d'//labelcoord(i,1) !' (x10\u-3\d)' !//'/rho' enddo ! !--more scalars ! label(ndim+2*ndimV+8) = 'psi' ipr = ndim + 2*ndimV + 9 ! pressure label(ipr) = 'P' label(ndim+2*ndimV+10) = 'div v' idivB = ndim+2*ndimV+11 label(idivB) = 'div B' ! !--current density (vector) ! iJfirst = ndim+2*ndimV+11+1 iamvec(iJfirst:iJfirst+ndimV-1) = iJfirst labelvec(iJfirst:iJfirst+ndimV-1) = 'J' do i=1,ndimV label(iJfirst+i-1) = trim(labelvec(iJfirst))//labelcoord(i,1) enddo else ipr = ndim + ndimV + 7 ! pressure label(ipr) = 'P' label(ndim+ndimV+8) = 'grad h' label(ndim+ndimV+9) = 'grad soft' label(ndim+ndimV+10) = 'phi' label(ndim+ndimV+11) = 'f_grav' ! label(ndim+ndimV+8) = 'div v' ! label(ndim+ndimV+9) = 'grad h' if (iformat.eq.3) then !!!irho = ndim+ndimV+9 label(ndim+ndimV+9) = 'rho*' label(ndim+ndimV+10) = 'sqrt g' iamvec(ndim+ndimV+11:ndim+ndimV+10+ndimV) = ndim+ndimV+11 labelvec(ndim+ndimV+11:ndim+ndimV+10+ndimV) = 'pmom' do i=1,ndimV label(ndim+ndimV+10+i) = labelvec(ndim+ndimV+11)//labelcoord(i,1) enddo endif iBfirst = 0 endif if (ncolumns.gt.ndim+3*ndimV+11) then label(ndim+3*ndimV+12) = 'f_visc_x' label(ndim+3*ndimV+13) = 'f_visc_y' label(ndim+3*ndimV+14) = 'f_x' label(ndim+3*ndimV+15) = 'f_y' endif ! !--these are here for backwards compatibility -- could be removed ! if (ncolumns.gt.ndim+3*ndimV+7) then ! label(ndim + 3*ndimV+8) = 'v_parallel' ! label(ndim + 3*ndimV+9) = 'v_perp' ! label(ndim + 3*ndimV+10) = 'B_parallel' ! label(ndim + 3*ndimV+11) = 'B_perp' ! endif ! !--set labels for each type of particles ! ntypes = 2 labeltype(1) = 'gas' labeltype(2) = 'ghost' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_dragon.f90000644 000770 000000 00000064674 12160267416 017343 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2011 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR OUTPUT FROM THE DRAGON CODE ! HANDLES BOTH ASCII AND BINARY FILES ! ! THE FOLLOWING ENVIRONMENT VARIABLES AFFECT THIS FORMAT: ! ! DSPLASH_EXTRACOLS : set to number of extra columns to read (after itype) ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Partial data read implemented means that columns with ! the 'required' flag set to false are not read (read is therefore much faster) !------------------------------------------------------------------------- module unit_constants integer, parameter :: DP = selected_real_kind(p=15) ! double precision ! Length units in metres real(kind=DP),parameter :: r_pc = 3.08568E16_DP ! parsec real(kind=DP),parameter :: r_au = 1.49597870E11_DP ! astronomical unit real(kind=DP),parameter :: r_sun = 6.96E8_DP ! solar radius real(kind=DP),parameter :: r_earth = 6.371E6_DP ! Earth radius ! Mass units in kilograms real(kind=DP),parameter :: m_sun = 1.98892E30_DP ! solar mass real(kind=DP),parameter :: m_jup = 1.8986E27_DP ! Jupiter mass real(kind=DP),parameter :: m_earth = 5.9736E24_DP ! Earth mass ! Time units in seconds real(kind=DP),parameter :: myr = 3.1556952E13_DP ! megayear real(kind=DP),parameter :: yr = 3.1556952E7_DP ! year real(kind=DP),parameter :: day = 8.64E4_DP ! day end module unit_constants subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,iamtype,npartoftype,time,gamma,maxpart,maxcol,maxstep use params use settings_data, only:ndim,ndimV,ncolumns,ncalc,required,ipartialread,ntypes use settings_units, only:unitzintegration, unit_interp use mem_allocation, only:alloc use labels, only:label,labeltype,labelzintegration use system_utils, only:ienvironment implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile integer, parameter :: iunit = 16 integer :: i,j,icol,ierr,iambinaryfile,itype integer :: ncolstep,npart_max,nstep_max,ntoti,nlastcol,nextracols logical :: iexist,reallocate,doubleprec character(len=11) :: fmt character(len=50) :: string integer :: nei_want,nei_min,nmax integer, dimension(:), allocatable :: iparttype integer, dimension(20) :: idata real, dimension(50) :: rdata real(doub_prec), dimension(50) :: rdatadb real :: timetemp,gammatemp,runit,massunit,sinksoft,sinkrad nstepsread = 0 if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(datfile)//': file not found ***' return endif ! !--set parameters which do not vary between timesteps ! ndim = 3 ndimV = 3 ncolstep = ndim + ndimV + 4 ! pos x 3, vel x 3, temp, h, rho, mass nlastcol = ncolstep nextracols = ienvironment('DSPLASH_EXTRACOLS',0) if (nextracols.gt.0 .and. nextracols.le.99) then print "(a,i2,a)",' ASSUMING ',nextracols,' EXTRA COLUMNS BEYOND ITYPE' ncolstep = ncolstep + nextracols else nextracols = 0 endif ncolumns = ncolstep call set_labels ! !--read data from snapshots ! j = istepstart write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! ! !--determine whether file is binary or ascii, open it and read the header ! inquire(file=datfile,form=fmt) !print*,'fmt = ',fmt ! select case(trim(adjustl(fmt))) ! case('UNFORMATTED') ! iambinaryfile = 1 ! open(unit=iunit,file=datfile,status='old',form='unformatted',iostat=ierr) ! write (6,*) "Compiler identified as UNFORMATTED" ! case('FORMATTED') ! iambinaryfile = 0 ! open(unit=iunit,file=datfile,status='old',form='formatted',iostat=ierr) ! write (6,*) "Compiler identified as FORMATTED" ! case default !--if compiler cannot distinguish the two, try binary first, then ascii iambinaryfile = -1 open(unit=iunit,file=datfile,status='old',form='unformatted',iostat=ierr) ! end select if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(datfile)//' ***' return endif ! !--read the file header ! try binary format first, and if unsuccessful try ascii ! doubleprec = .true. if (iambinaryfile.eq.1) then print "(a)",' reading binary dragon format ' call read_dragonheader_binary(iunit,ierr) else if (iambinaryfile.eq.0) then print "(a)",' reading ascii dragon format ' call read_dragonheader_ascii(iunit,ierr,iambinaryfile) else call read_dragonheader_binary(iunit,ierr) if (ierr.eq.0) then !--if successful binary header read, file is doubleprec binary iambinaryfile = 1 print "(a)",' reading binary dragon format ' print "(a)",' Double precision file' else !--otherwise, close binary file, and assume file is single precision binary doubleprec = .false. close(unit=iunit) iambinaryfile = 1 open(unit=iunit,file=datfile,status='old',form='unformatted',iostat=ierr) call read_dragonheader_binary(iunit,ierr) if (ierr.eq.0) then print "(a)",' reading binary dragon format ' print "(a)",' Single precision file' else print "(a)",' reading ascii dragon format ' iambinaryfile = 0 close(unit=iunit) open(unit=iunit,file=datfile,status='old',form='formatted',iostat=ierr) call read_dragonheader_ascii(iunit,ierr,iambinaryfile) if (ierr/=0) then print "(a)",' ERROR reading ascii file header: wrong endian binary? ' close (iunit) ndim = 0 ncolumns = 0 return end if end if endif endif ! !--get values of quantities from the header ! ntoti = idata(1) nmax = idata(3) nei_want = idata(10) nei_min = idata(12) !--check for errors in integer header (either from corrupt file or wrong endian) if (ntoti.le.0 .or. ntoti.gt.1.e10 .or. nmax.lt.0 & .or. nei_want.lt.0 .or. nei_want.gt.1e6 .or. nei_min.lt.0) then if (iambinaryfile.eq.1) then print "(a)",' ERROR reading binary file header: wrong endian? ' else print "(a)",' ERROR reading ascii file header ' endif ndim = 0 ncolumns = 0 close(unit=iunit) return endif if (doubleprec) then timetemp = rdatadb(1) runit = rdatadb(21) massunit = rdatadb(22) gammatemp = rdatadb(26) sinksoft = rdatadb(27) sinkrad = rdatadb(38) else timetemp = rdata(1) runit = rdata(21) massunit = rdata(22) gammatemp = rdata(26) sinksoft = rdata(27) sinkrad = rdata(38) end if !--assume first that the file is single precision, check values are sensible, if not try double ! if (iambinaryfile.eq.1) then ! if (timetemp.lt.0. .or. runit.lt.0. .or. massunit.lt.0. .or. gammatemp.lt.0. & ! .or. gammatemp.gt.6.) then ! print "(a)",' double precision file' ! doubleprec = .true. ! rewind(iunit) ! call read_dragonheader_binary(iunit,ierr) ! else ! print "(a)",' single precision file' ! endif ! endif print*,'time : ',timetemp print*,'gamma : ',gammatemp print*,'n_total : ',ntoti if (ierr /= 0) then if (iambinaryfile.eq.1) then print "(a)",' ERROR reading real part of binary file header ' else print "(a)",' ERROR reading real part of ascii file header ' endif ndim = 0 ncolumns = 0 close(unit=iunit) return endif ! !--if successfully read header, increment the nstepsread counter ! nstepsread = nstepsread + 1 ! !-- now work out dimensionless weight unit and z integration unit ! call find_weights(unit_interp,unitzintegration,labelzintegration) ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if (ntoti.gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*ntoti) else ! if first time, save on memory npart_max = int(ntoti) endif endif if (j.ge.maxstep .and. j.ne.1) then nstep_max = j + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolstep+ncalc,maxcol),mixedtypes=.true.) endif ! !--copy header into header arrays ! npartoftype(:,j) = 0 npartoftype(1,j) = ntoti time(j) = timetemp gamma(j) = gammatemp ! !--read particle data ! if (ntoti.gt.0) then if (iambinaryfile.eq.1) then call read_dragonbody_binary(iunit,ierr) else call read_dragonbody_ascii(iunit,ierr) endif else ntoti = 0 npartoftype(1,i) = 0 dat(:,:,i) = 0. endif if (allocated(iamtype)) then !--relabel particle types call set_types(iamtype(:,j),ntoti,npartoftype(:,j)) endif if (any(npartoftype(2:,j).ne.0)) then do itype=1,ntypes if (npartoftype(itype,j).gt.0) then string = ' ' write(string,"(a)") 'n_'//trim(labeltype(itype)) write(string(18:len(string)),"(a)") ':' print*,trim(string),' ',npartoftype(itype,j) endif enddo endif ! !--set flag to indicate that only part of this file has been read ! if (.not.all(required(1:ncolstep))) ipartialread = .true. ! !--close data file and return ! if (allocated(iparttype)) deallocate(iparttype) close(unit=iunit) return contains !---------------------------------------------------- ! binary header read !---------------------------------------------------- subroutine read_dragonheader_binary(iunitb,ierr) implicit none integer, intent(in) :: iunitb integer, intent(out) :: ierr read(iunitb,end=55,iostat=ierr) idata if (doubleprec) then read(iunitb,end=55,iostat=ierr) rdatadb else read(iunitb,end=55,iostat=ierr) rdata endif return 55 continue !print "(a)",' ERROR: end of file in binary header read' ierr = -1 return end subroutine read_dragonheader_binary !---------------------------------------------------- ! ascii header read !---------------------------------------------------- subroutine read_dragonheader_ascii(iunita,ierr,iwarn) implicit none integer, intent(in) :: iunita,iwarn integer, intent(out) :: ierr do i=1,size(idata) read(iunita,*,end=55,iostat=ierr) idata(i) enddo do i=1,size(rdata) read(iunita,*,end=55,iostat=ierr) rdata(i) enddo doubleprec = .false. return 55 continue if (iwarn.ge.0) print "(a)",' ERROR: end of file in binary header read' ierr = -1 return end subroutine read_dragonheader_ascii !---------------------------------------------------- ! binary body read !---------------------------------------------------- subroutine read_dragonbody_binary(iunitb,ierr) implicit none integer, intent(in) :: iunitb integer, intent(out) :: ierr real(doub_prec), dimension(:,:), allocatable :: dummyx real(doub_prec), dimension(:), allocatable :: dummy integer, dimension(:), allocatable :: idumtype integer :: icol if (doubleprec .and. any(required(1:ndim+ndimV))) then allocate(dummyx(3,ntoti),stat=ierr) if (ierr /= 0) then print *,' ERROR allocating memory' goto 56 endif endif !--positions if (any(required(1:ndim))) then if (doubleprec) then read(iunitb,end=55,iostat=ierr) dummyx(1:ndim,1:ntoti) do i=1,ntoti dat(i,1:ndim,j) = real(dummyx(1:ndim,i)) enddo else read(iunitb,end=55,iostat=ierr) (dat(i,1:ndim,j),i=1,ntoti) endif if (ierr /= 0) print*,' WARNING: errors reading positions ' else read(iunitb,end=55,iostat=ierr) if (ierr /= 0) print*,' WARNING: error skipping positions ' endif !--velocities if (any(required(ndim+1:ndim+ndimV))) then if (doubleprec) then read(iunitb,end=55,iostat=ierr) dummyx(1:ndimV,1:ntoti) do i=1,ntoti dat(i,ndim+1:ndim+ndimV,j) = real(dummyx(1:ndimV,i)) enddo else read(iunitb,end=55,iostat=ierr) (dat(i,ndim+1:ndim+ndimV,j),i=1,ntoti) endif if (ierr /= 0) print*,' WARNING: errors reading velocities ' else read(iunitb,end=55,iostat=ierr) if (ierr /= 0) print*,' WARNING: error skipping velocities ' endif if (doubleprec .and. any(required(ndim+ndimV+1:ncolstep))) then allocate(dummy(ntoti),stat=ierr) if (ierr /= 0) then print*,' ERROR allocating memory' goto 56 endif endif !--the rest do icol = ndim+ndimV+1,nlastcol if (required(icol)) then if (doubleprec) then read(iunitb,end=55,iostat=ierr) dummy(1:ntoti) dat(1:ntoti,icol,j) = real(dummy(1:ntoti)) else read(iunitb,end=55,iostat=ierr) dat(1:ntoti,icol,j) endif if (ierr /= 0) print*,' WARNING: errors reading '//trim(label(icol)) else read(iunitb,end=55,iostat=ierr) if (ierr /= 0) print*,' WARNING: error skipping '//trim(label(icol)) endif enddo if (size(iamtype(:,j)).gt.1) then allocate(idumtype(ntoti),stat=ierr) if (ierr /= 0) then print*,'error reading type, assuming all gas' iamtype(1:ntoti,j) = 1 else read(iunitb,end=55,iostat=ierr) idumtype(1:ntoti) iamtype(1:ntoti,j) = idumtype(1:ntoti) endif deallocate(idumtype) if (ierr /= 0) print*,' WARNING: error reading itype' endif !--extra columns beyond itype do icol = nlastcol+1,nlastcol+nextracols if (required(icol)) then if (doubleprec) then read(iunitb,end=55,iostat=ierr) dummy(1:ntoti) dat(1:ntoti,icol,j) = real(dummy(1:ntoti)) else read(iunitb,end=55,iostat=ierr) dat(1:ntoti,icol,j) endif if (ierr /= 0) print*,' WARNING: errors reading '//trim(label(icol)) else read(iunitb,end=55,iostat=ierr) if (ierr /= 0) print*,' WARNING: error skipping '//trim(label(icol)) endif enddo if (allocated(dummyx)) deallocate(dummyx) if (allocated(dummy)) deallocate(dummy) return 55 continue print "(a)",' ERROR: end of file in binary read' 56 continue ierr = -1 if (allocated(dummyx)) deallocate(dummyx) if (allocated(dummy)) deallocate(dummy) return end subroutine read_dragonbody_binary !---------------------------------------------------- ! ascii body read !---------------------------------------------------- subroutine read_dragonbody_ascii(iunita,ierr) implicit none integer, intent(in) :: iunita integer, intent(out) :: ierr integer :: nerr,idumtype !--positions nerr = 0 do i=1,ntoti read(iunita,*,end=55,iostat=ierr) dat(i,1:ndim,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print*,' WARNING: ',nerr,' errors reading positions ' !--velocities nerr = 0 do i=1,ntoti read(iunita,*,end=55,iostat=ierr) dat(i,ndim+1:ndim+ndimV,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print*,' WARNING: ',nerr,' errors reading velocities ' !--the rest if (any(required(ndim+ndimV+1:nlastcol))) then do icol = ndim+ndimV+1,nlastcol nerr = 0 do i=1,ntoti read(iunita,*,end=55,iostat=ierr) dat(i,icol,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print*,' WARNING: ',nerr,' errors reading '//trim(label(icol)) enddo endif !--particle type if (size(iamtype(:,j)).gt.1) then nerr = 0 do i=1,ntoti read(iunita,*,end=55,iostat=ierr) idumtype iamtype(i,j) = idumtype if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print*,' WARNING: ',nerr,' errors reading itype' endif !--the rest if (any(required(nlastcol+1:nlastcol+nextracols))) then do icol = nlastcol+1,nlastcol+nextracols nerr = 0 do i=1,ntoti read(iunita,*,end=55,iostat=ierr) dat(i,icol,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print*,' WARNING: ',nerr,' errors reading '//trim(label(icol)) enddo endif return 55 continue print "(a)",' ERROR: end of file in ascii read' ierr = -1 return end subroutine read_dragonbody_ascii !---------------------------------------------------- ! translate types into order (for old dragon read) !---------------------------------------------------- subroutine set_types(itypei,ntotal,noftype) implicit none integer(kind=int1), dimension(:), intent(inout) :: itypei integer, intent(in) :: ntotal integer, dimension(:), intent(out) :: noftype integer :: ngas,nsink,nbnd,ncloud,nsplit,nunknown,nstar !--types ! 1 gas ! -1 sink ! -2 star ! 6 boundary (fixed) ! 9 intercloud (hydro only) ! 4 split particle (obsolete?) ! !--we translate these into ! 1 gas ! 2 boundary ! 3 sink ! 4 intercloud ! 5 split ! 6 unknown / the rest ! 7 star ! ngas = 0 nsink = 0 nbnd = 0 ncloud = 0 nsplit = 0 nunknown = 0 nstar = 0 do i=1,ntotal select case(itypei(i)) case(1) ngas = ngas + 1 itypei(i) = 1 case(-1) nsink = nsink + 1 itypei(i) = 3 case(6) nbnd = nbnd + 1 itypei(i) = 2 case(9) ncloud = ncloud + 1 itypei(i) = 4 case(4) nsplit = nsplit + 1 itypei(i) = 5 case(-2) nstar = nstar + 1 itypei(i) = 6 case default nunknown = nunknown + 1 ! itypei(i) = 6 write (6,*) "Unknown particle type ", itypei(i), "!!" stop end select enddo noftype(1) = ngas noftype(2) = nbnd noftype(3) = nsink noftype(4) = ncloud noftype(5) = nsplit noftype(6) = nstar if (sum(noftype(1:6)).ne.ntotal) then print "(a)",' INTERNAL ERROR setting number in each type in dragon read' endif return end subroutine set_types end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,ix,ivx,ipmass,ih,irho use params use settings_data, only:ndim,ndimV,ntypes,UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = ndim+1 label(ivx+ndimV) = 'temperature' ih = ivx + ndimV + 1 irho = ih + 1 ! location of rho in data array ipmass = irho + 1 ! !--set labels of the quantities read in ! label(ix(1:ndim)) = labelcoord(1:ndim,1) label(irho) = 'density' !label(iutherm) = 'u' label(ipmass) = 'particle mass' label(ih) = 'h' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo !--set labels for each particle type ! ntypes = 6 labeltype(1) = 'gas' labeltype(2) = 'boundary' labeltype(3) = 'sink' labeltype(4) = 'cloud' labeltype(5) = 'split' labeltype(6) = 'star' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. UseTypeInRenderings(4) = .true. UseTypeInRenderings(5) = .true. UseTypeInRenderings(6) = .false. !----------------------------------------------------------- return end subroutine set_labels subroutine find_weights(out_unit_interp,out_unitzintegration,out_labelzintegration) use labels, only:ipmass,ih,irho use params use settings_data, only:ndim use unit_constants use system_commands, only:get_environment implicit none real(doub_prec), intent(out) :: out_unit_interp real, intent(out) :: out_unitzintegration character(len=20), intent(out) :: out_labelzintegration real(doub_prec) :: dm_unit, dh_unit, drho_unit, dr_unit logical :: do_dimweight, do_zintegration character(len=20) :: rho_length_label real(doub_prec) :: rho_length character(len=20) :: r_unit ! length unit character(len=20) :: m_unit ! mass unit character(len=20) :: rho_unit ! density unit character(len=20) :: h_unit ! smoothing length unit call get_environment("DRAGON_R_UNIT",r_unit) call get_environment("DRAGON_M_UNIT",m_unit) call get_environment("DRAGON_RHO_UNIT",rho_unit) call get_environment("DRAGON_H_UNIT",H_unit) out_unit_interp = 1.0 out_unitzintegration = 1.0 out_labelzintegration = "" do_dimweight = .TRUE. do_zintegration = .TRUE. ! Length unit in S.I. units (m) if (r_unit=="") then print*,'No positions or no position units!' print*,'Set environment variable DRAGON_R_UNIT to:' print*,' pc, au, r_sun, r_earth, km, m, cm or 1 (dimensionless)' do_zintegration = .FALSE. dr_unit = 1._DP else if (r_unit=="pc") then dr_unit = r_pc else if (r_unit=="au") then dr_unit = r_au else if (r_unit=="r_sun") then dr_unit = r_sun else if (r_unit=="r_earth") then dr_unit = r_earth else if (r_unit=="km") then dr_unit = 1000.0_DP else if (r_unit=="m") then dr_unit = 1.0_DP else if (r_unit=="cm") then dr_unit = 0.01_DP else if (r_unit=="1") then dr_unit = 1._DP else print*,'Unknown position unit ', r_unit, '!' do_zintegration = .FALSE. dr_unit = 1._DP end if ! Length unit in S.I. units (m) if (h_unit=="") then print*,'No smoothing lengths or no smoothing length units!' print*,'Set environment variable DRAGON_H_UNIT to: ' print*,' pc, au, r_sun, r_earth, km, m, cm or 1 (dimensionless)' do_dimweight = .FALSE. dh_unit = 1._DP else if (h_unit=="pc") then dh_unit = r_pc else if (h_unit=="au") then dh_unit = r_au else if (h_unit=="r_sun") then dh_unit = r_sun else if (h_unit=="r_earth") then dh_unit = r_earth else if (h_unit=="km") then dh_unit = 1000.0_DP else if (h_unit=="m") then dh_unit = 1.0_DP else if (h_unit=="cm") then dh_unit = 0.01_DP else if (h_unit=="1") then dh_unit = 1._DP else print*,'Unknown smoothing length unit ', h_unit, '!' do_dimweight = .FALSE. dh_unit = 1._DP end if ! Mass units in S.I. units (kg) if (m_unit=="") then print*,'No masses or no mass units!' print*,'Set environment variable DRAGON_M_UNIT to:' print*,' m_sun, m_jup, m_earth, kg, g or 1 (dimensionless)' do_dimweight = .FALSE. dm_unit = 1._DP else if (m_unit=="m_sun") then dm_unit = m_sun else if (m_unit=="m_jup") then dm_unit = m_jup else if (m_unit=="m_earth") then dm_unit = m_earth else if (m_unit=="kg") then dm_unit = 1._DP else if (m_unit=="g") then dm_unit = 1.0E-3_DP else if (m_unit=="1") then dm_unit = 1._DP else print*,'Unknown mass unit ', m_unit, '!' do_dimweight = .FALSE. dm_unit = 1._DP end if ! Density units in S.I. units (i.e. kg/m^3) if (rho_unit=="") then print*,'No densities or no density units!' print*,'Set environment variable DRAGON_RHO_UNIT to:' if (ndim==3) print*,' m_sun_pc3, kg_m3, g_cm3 or 1 (dimensionless)' if (ndim==2) print*,' m_sun_pc2, kg_m2, g_cm2 or 1 (dimensionless)' if (ndim==1) print*,' 1 (dimensionless)' do_dimweight = .FALSE. do_zintegration = .FALSE. rho_length = 1._DP else if (rho_unit=="m_sun_pc3") then drho_unit = m_sun / (r_pc**3) rho_length = r_pc rho_length_label = "pc" else if (rho_unit=="m_sun_pc2") then drho_unit = m_sun / (r_pc**2) rho_length = r_pc rho_length_label = "pc" else if (rho_unit=="kg_m3") then drho_unit = 1.0_DP rho_length = 1.0_DP rho_length_label = "m" else if (rho_unit=="kg_m2") then drho_unit = 1.0_DP rho_length = 1.0_DP rho_length_label = "m" else if (rho_unit=="g_cm3") then drho_unit = 1.0E3_DP rho_length = 0.01_DP rho_length_label = "cm" else if (rho_unit=="g_cm2") then drho_unit = 10.0_DP rho_length = 0.01_DP rho_length_label = "cm" else if (rho_unit=="1") then drho_unit = 1._DP rho_length = 1._DP rho_length_label = "" else print*,'Unknown density unit ', rho_unit, '!' do_dimweight = .FALSE. do_zintegration = .FALSE. rho_length = 1._DP end if if (do_dimweight) then out_unit_interp = dm_unit/(drho_unit*dh_unit**ndim) else print*,'Cannot create dimensionless weight' print*,'(unnormalised rendered plots may be incorrect)' end if if (do_zintegration) then out_unitzintegration = dr_unit / rho_length out_labelzintegration = rho_length_label else print*,'Cannot set unitzintegration' print*,'(column density plots may be incorrect)' end if return end subroutine find_weights splash/src/read_data_egaburov.f90000644 000770 000000 00000024725 11622211702 017661 0ustar00dpricewheel000000 000000 !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR OUTPUT FROM THE GADGET CODE ! ! NOTE THAT THIS ONLY "OFFICIALLY" WORKS WITH THE PARALLEL CODE AS WE ! REQUIRE KNOWLEDGE OF THE PARTICLE SMOOTHING LENGTHS ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! GSPLASH_USE_Z if 'YES' uses redshift in the legend instead of time ! GSPLASH_DARKMATTER_HSOFT if given a value > 0.0 will assign a ! smoothing length to dark matter particles which can then be ! used in the rendering ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Partial data read implemented Nov 2006 means that columns with ! the 'required' flag set to false are not read (read is therefore much faster) !------------------------------------------------------------------------- subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,npartoftype,time,gamma,maxpart,maxcol,maxstep use params use settings_data, only:ndim,ndimV,ncolumns,ncalc,iformat,required,ipartialread use settings_page, only:legendtext use mem_allocation, only:alloc use labels, only:ih,irho use system_utils, only:renvironment,lenvironment implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile ! integer, dimension(maxparttypes) :: npartoftypei,Nall ! integer, dimension(:), allocatable :: iamtemp integer :: i,j,ierr ! integer :: index1,index2,indexstart,indexend,Nmassesdumped integer :: ncolstep,npart_max,nstep_max ! integer :: iFlagSfr,iFlagFeedback,iFlagCool,nfiles logical :: iexist,reallocate ! real(doub_prec) :: timetemp,ztemp, dummy ! real(doub_prec), dimension(6) :: massoftypei ! real, dimension(:), allocatable :: dattemp1 ! real :: hsoft ! integer :: ntot, nnopt, nout, nit, nav, ngr, nrelax ! real(doub_prec) :: hmin, hmax, sep0, tf, dtout, alpha, beta, eta2, trelax, dt, omega2 ! real(doub_prec) :: dx, dy, dz, dm, dh, drho, dvx, dvy, dvz ! real(doub_prec) :: duth, dmmu ! real(doub_prec) :: rscale, mscale !!!!!!!!!!!!!!!! integer :: proc, nread integer :: myproc, nproc, npx, npy, npz; integer :: global_n, local_n, ndim_data real(sing_prec) :: t_global, dt_global integer :: iteration real(sing_prec) :: cfl_no, gamma_gas integer :: periodic_flag real(sing_prec) :: xmin, ymin, zmin, xmax, ymax, zmax integer :: idx real(sing_prec) :: posx, posy, posz, pvelx, pvely, pvelz real(sing_prec) :: dens, ethm, pres, pmag, vabs real(sing_prec) :: velx, vely, velz, Bx, By, Bz real(sing_prec) :: hsml, wght, Bpsi, divB, v1, v2, v3, v4 !!!!!!!!!!!!!!!!!! nstepsread = 0 npart_max = maxpart if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(datfile)//': file not found ***' STOP endif ! !--set parameters which do not vary between timesteps ! ndim = 3 ndimV = 3 ! !--read data from snapshots ! i = istepstart write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! open(11,iostat=ierr,file=datfile,status='old', form='unformatted') if (ierr /= 0) then print "(a)", '*** ERROR OPENING FILE ***' STOP endif ! !--read header for this timestep ! read(11, iostat=ierr) myproc, nproc, npx, npy, npz, & global_n, local_n, ndim_data, t_global, dt_global, iteration, & cfl_no, gamma_gas, periodic_flag, & xmin, ymin, zmin, xmax, ymax, zmax print *, global_n print *, local_n print *, nproc if (ierr /= 0) then print "(a)", '*** ERROR READING TIMESTEP HEADER ***' STOP endif ! t_global = t_global - 0.13 iformat = 0 ncolstep = 30 ncolumns = ncolstep print*,'nproc : ',nproc print*,'npx, npy, npz : ',npx, npy, npz print*,'time : ',t_global print*,'gamma_gas : ',gamma_gas print*,'N_total : ',global_n print*,'N data columns : ',ncolstep ! !--if successfully read header, increment the nstepsread counter ! nstepsread = nstepsread + 1 ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if (global_n .gt. maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*global_n) else ! if first time, save on memory npart_max = int(global_n) endif endif if (i.ge.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolstep+ncalc,maxcol)) endif npartoftype(:,i) = 0 npartoftype(1,i) = global_n !--use this line for code time time(i) = real(t_global) ! !--read particle data ! nread = 0 do proc = 1, nproc do j = 1, local_n read(11, iostat=ierr) & idx, & posx, posy, posz, pvelx, pvely, pvelz, & dens, ethm, pres, pmag, vabs, & velx, vely, velz, Bx, By, Bz, & hsml, wght, Bpsi, divB, & v1, v2, v3, v4 ! if (pres > 10) then ! print *, posx, posy, posz ! end if if (ierr /= 0) then print *, '*** ERROR READING PARTICLE', i, 'PROC:', myproc STOP endif dat(j + nread, 1, i) = posx dat(j + nread, 2, i) = posy dat(j + nread, 3, i) = posz dat(j + nread, 4, i) = velx dat(j + nread, 5, i) = vely dat(j + nread, 6, i) = velz dat(j + nread, 7, i) = dens dat(j + nread, 8, i) = pres dat(j + nread, 9, i) = pmag dat(j + nread, 10, i) = vabs dat(j + nread, 11, i) = Bx dat(j + nread, 12, i) = By dat(j + nread, 13, i) = Bz if (pmag > 0) then dat(j + nread, 14, i) = abs(divB/sqrt(pmag*2.0)) else dat(j + nread, 14, i) = 0.0; end if dat(j + nread, 15, i) = Bpsi dat(j + nread, 16, i) = hsml*2 dat(j + nread, 17, i) = wght dat(j + nread, 18, i) = pvelx dat(j + nread, 19, i) = pvely dat(j + nread, 20, i) = pvelz dat(j + nread, 21, i) = abs(divB) dat(j + nread, 22, i) = dens*wght dat(j + nread, 23, i) = pres/dens/(gamma_gas - 1.0) ! uthermal dat(j + nread, 24, i) = sqrt(pmag*2.0) dat(j + nread, 25, i) = pres + pmag dat(j + nread, 26, i) = v1; dat(j + nread, 27, i) = v2; dat(j + nread, 28, i) = v3; dat(j + nread, 29, i) = v4; dat(j + nread, 30, i) = idx; end do nread = nread + local_n; if (proc < nproc) then read(11, iostat=ierr) myproc, nproc, npx, npy, npz, & global_n, local_n, ndim_data, t_global, dt_global, iteration, & cfl_no, gamma_gas, periodic_flag, & xmin, ymin, zmin, xmax, ymax, zmax if (ierr /= 0) then print *, '*** ERROR READING TIMESTEP HEADER ***, proc=', proc STOP endif end if end do if (nread .ne. global_n) then print *, 'nread= ', nread print *, 'global_n= ', global_n print "(a)", ' *** SOMETHING WENT WRONG ***' STOP end if !!!!!!!!!!!!!!!!!!!!! gamma = gamma_gas irho = 7 ih = 16 ! !--set flag to indicate that only part of this file has been read ! if (.not.all(required(1:ncolstep))) ipartialread = .true. ! !--close data file and return ! close(unit=11) if (nstepsread.gt.0) then print*,'>> last step ntot =',sum(npartoftype(:,istepstart+nstepsread-1)) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,ix,ivx,ipmass,ih,irho,ipr,iutherm, idivb, iBfirst use params use settings_data, only:ndim,ndimV,ncolumns,ntypes,UseTypeInRenderings use geometry, only:labelcoord use system_utils, only:renvironment implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 irho = 7 iutherm = 23 ipr = 8 ih = 16 iBfirst = 11 ipmass = 22 idivb = 14 label(ix(1:ndim)) = labelcoord(1:ndim,1) label(irho) = 'density' label(iutherm) = 'cs' label(ih) = 'h' label(ipmass) = 'particle mass' label(ipr) = 'pressure' label(9) = 'Pmag' label(10) = 'vabs' label(15) = "\gpsi" label(18) = 'pvelx' label(19) = 'pvely' label(20) = 'pvelz' label(11) = 'Bx' label(12) = 'By' label(13) = 'Bz' label(14) = 'divB' label(24) = '|B|' label(25) = 'Ptot' label(26) = 'scal0' label(27) = 'scal1' label(28) = 'scal2' label(29) = 'scal3' label(30) = 'idx' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo !--mag field if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 1 labeltype(1) = 'gas' UseTypeInRenderings(1) = .true. return end subroutine set_labels splash/src/read_data_falcON_hdf5.f90000644 000770 000000 00000037056 12567067742 020146 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR HDF5 OUTPUT FROM W. DEHNEN'S FALCON CODE ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Columns with the 'required' flag set to false are not read !------------------------------------------------------------------------- ! ! The module below contains interface routines to c functions ! that perform the actual calls to the HDF5 libs ! !------------------------------------------------------------------------- module falconhdf5read use params, only:maxplot,doub_prec use labels, only:lenlabel use, intrinsic :: iso_c_binding, only:c_int,c_double,c_char implicit none character(len=lenlabel), dimension(maxplot) :: blocklabel integer, parameter :: maxtypes = 6 integer :: i_current_step interface ! opens a falcON HDF5 snapshot file subroutine open_falcon_file(filename,ierr) bind(c,name="open_falcON_file") import character(c_char), intent(in) :: filename(*) integer(c_int), intent(out) :: ierr end subroutine open_falcon_file ! queries whether a file is open function falcon_file_is_open() bind(c,name="falcON_file_is_open") import integer(c_int) :: falcon_file_is_open end function falcon_file_is_open ! closes the currently open (if any) falcON HDF5 snapshot file. subroutine close_falcon_file() bind(c,name="close_falcON_file") ! no arguments end subroutine close_falcon_file ! queries if there is another snapshot present the currently open file function num_falcon_snapshots(ierr) bind(c,name="num_falcON_snapshots") import integer(c_int) :: num_falcon_snapshots integer(c_int), intent(out) :: ierr end function num_falcon_snapshots ! set falcON debugging level subroutine set_falcon_debugging_level(level) bind(c,name="set_falcON_debugging_level") import integer(c_int), intent(in) :: level end subroutine set_falcon_debugging_level ! read falcON header subroutine open_falcon_snapshot(ntype,npart,ncol,dimX,dimV,time,hper,ierr) & bind(c,name="open_falcON_snapshot") import integer(c_int), intent(out) :: ntype,ncol,dimX,dimV,ierr integer(c_int), intent(out) :: npart(*) real(c_double), intent(out) :: time,hper(3) end subroutine open_falcon_snapshot ! read falcON data subroutine read_falcon_snapshot(ierr) bind(c,name="read_falcON_snapshot") import integer(c_int), intent(out) :: ierr end subroutine read_falcon_snapshot end interface contains ! map types from falcON to splash integer function itypemap_falcon(itype) integer, intent(in) :: itype select case(itype) case(1) ! sinks itypemap_falcon = 2 case(2) ! gas itypemap_falcon = 1 case(3:4) itypemap_falcon = itype case(5:maxtypes) itypemap_falcon = itype+1 case default itypemap_falcon = 5 ! unknown end select end function itypemap_falcon ! get starting position in particle array integer function ioffset(itype,npartoftype) integer, intent(in) :: itype integer, intent(in) :: npartoftype(:) integer :: i ioffset = 0 do i=1,size(npartoftype) if (i < itype) ioffset = ioffset + npartoftype(i) enddo end function ioffset end module falconhdf5read !------------------------------------------------------------------------- ! ! The routine that reads the data into splash's internal arrays ! !------------------------------------------------------------------------- subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,npartoftype,masstype,time,gamma,maxpart,maxcol use params, only:doub_prec,maxparttypes !,maxplot use settings_data, only:ndim,ndimV,ncolumns,ncalc,ipartialread, & ntypes,debugmode,iverbose!, required use mem_allocation, only:alloc use labels, only:print_types,labeltype use system_utils, only:lenvironment use asciiutils, only:cstring use dataread_utils, only:check_range use falconhdf5read implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile integer :: i,j,ierr,ierror(8) integer :: ncolstep,npart_max,nstep_max,ntoti,ntotall integer :: npartoftypei(maxparttypes) logical :: iexist,reallocate,debug,goterrors real(doub_prec) :: timetemp,hperiodic(3) !integer, dimension(maxplot) :: isrequired nstepsread = 0 goterrors = .false. if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! print "(1x,a)",'reading FalcON hdf5 format' inquire(file=datfile,exist=iexist) if (.not.iexist) then ! !--append .h5 on the end if not already present ! datfile=trim(rootname)//'.h5' inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(rootname)//': file not found ***' return endif endif ! ! set parameters which do not vary between timesteps ! ndim = 3 ndimV = 3 debug = (debugmode .or. lenvironment('FSPLASH_DEBUG')) ! ! read data from snapshots ! i = istepstart write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! ! open file and read header information ! if (debug) print*,'DEBUG: reading header...' call open_falcON_file(cstring(datfile),ierr) if (ierr /= 0) then print "(a)", '*** ERROR OPENING FALCON FILE ***' return endif if (falcON_file_is_open() /= 1) then print "(a)", '*** ERROR: falcON_file_is_open /= 1 after opening ***' return endif if (debug) call set_falcON_debugging_level(3); nstep_max = num_falcON_snapshots(ierr); if (debug) print*,'got ',nstep_max,' falcON snapshots in file' if (nstep_max <= 0) then print "(a)",'*** ERROR: no falcON snapshots found in file ***' return endif ntotall = 0 over_snapshots: do i=istepstart,istepstart+nstep_max-1 ! ! read falcON header ! if (debug) print*,'DEBUG: opening snapshot ',i npartoftypei(:) = 0 call open_falcon_snapshot(ntypes, npartoftypei, & ncolstep, ndim, ndimV, timetemp, & hperiodic, ierr) ! ! error checking on header info ! ierror(:) = 0 call check_range(ntypes,'ntypes',min=1,err=ierror(1)) call check_range(npartoftypei(1:ntypes),'npartoftype',min=0,err=ierror(2)) call check_range(sum(npartoftypei(1:ntypes)),'ntot',min=1,err=ierror(3)) call check_range(ndim,'ndim',min=1,max=3,err=ierror(4)) call check_range(ndimV,'ndimV',min=ndim,max=3,err=ierror(5)) call check_range(timetemp,'time',min=0.d0,err=ierror(6)) call check_range(ierr,'error during header read',min=0,max=0,err=ierror(7)) if (any(ierror(1:7) > 0)) then print*,'*** ERROR during falcON header read ***' return endif ncolumns = ncolstep ntoti = sum(npartoftypei(1:ntypes)) ntotall = max(ntoti,ntotall) ! ! print header information ! if (iverbose >= 1) then !print "(2(a,1x,i10))",' npart: ',ntoti,' ncolumns: ',ncolstep !print "(a,i2)",' ntypes: ',ntypes,' !print*,' npartoftype = ',(npartoftypei(itypemap_falcon(j)),j=1,ntypes) !print*,' ncolstep = ',ncolstep,' ndim = ',ndim,ndimV print*,' time = ',timetemp !,' hper = ',hperiodic(:) endif ! ! now read data ! reallocate = .false. npart_max = maxpart if (ntoti.gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*ntotall) else ! if first time, save on memory npart_max = int(ntoti) endif endif ! ! reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol)) endif ! ! copy header data into allocated arrays ! do j=1,ntypes npartoftype(itypemap_falcon(j),i) = npartoftypei(j) enddo time(i) = real(timetemp) masstype(:,i) = 0. ! all masses read from file ! ! read particle data ! got_particles: if (ntoti > 0) then !isrequired(:) = 0 !where (required(1:ncolumns)) isrequired(1:ncolumns) = 1 i_current_step = i call read_falcon_snapshot(ierr); if (ierr /= 0) then print "(/,1x,a,/)",' *** ERROR reading falcON snapshot ***' print*,'Press any key to continue (but there is likely something wrong with the file...)' read* endif nstepsread = nstepsread + 1 call print_types(npartoftype(:,i),labeltype) else ! ! cover the special case where no particles have been read ! npartoftype(1,i) = 1 dat(:,:,i) = 0. endif got_particles enddo over_snapshots ! ! now memory has been allocated, set arrays which are constant for all time ! gamma = 5./3. ! ! set flag to indicate that only part of this file has been read ! ipartialread = .false. !if (.not.all(required(1:ncolstep))) ipartialread = .true. ! ! call set labels to identify location of smoothing length ! call set_labels if (nstepsread.gt.0) then print "(a,i10,a)",' >> read ',sum(npartoftype(:,istepstart+nstepsread-1)),' particles' endif return end subroutine read_data subroutine read_falcon_data_into_splash(icol,npartoftypei,temparr,itypec) bind(c,name="read_falcON_data_into_splash") use, intrinsic :: iso_c_binding, only:c_int,c_double use particle_data, only:dat,iamtype,npartoftype use settings_data, only:debugmode use labels, only:label use falconhdf5read, only:itypemap_falcon,ioffset,i_current_step implicit none integer(kind=c_int), intent(in) :: icol,npartoftypei,itypec real(kind=c_double), intent(in) :: temparr(*) integer(kind=c_int) :: icolput integer :: istart,iend,nmax,itype,i itype = itypec + 1 ! convert from c to Fortran indexing icolput = icol + 1 if (debugmode) print "(3(a,i2),a,i8)",'DEBUG: Step ',i_current_step,' column ',icol,& ' type ',itypemap_falcon(itype),' -> '//trim(label(icolput)) ! check column is within array limits if (icolput.gt.size(dat(1,:,1)) .or. icolput.eq.0) then print "(a,i2,a)",' ERROR: column = ',icolput,' out of range in receive_data_fromc' return endif ! ensure no array overflows istart = ioffset(itypemap_falcon(itype),npartoftype(:,i_current_step)) + 1 iend = min(istart + npartoftypei - 1,size(dat(:,1,1))) nmax = iend - istart + 1 ! copy data into main splash array if (debugmode) print*,'DEBUG: COPYING TO ',istart,iend,' total = ',1,nmax ! this should never happen if (i_current_step < 1 .or. i_current_step > size(dat(1,1,:))) then print*,'INTERNAL ERROR in indexing during falcON read' return endif dat(istart:iend,icolput,i_current_step) = real(temparr(1:nmax),kind=kind(dat)) ! set particle type if (size(iamtype(:,1)).gt.1) then print*,' SETTING TYPES ',istart,iend do i=istart,iend iamtype(i,i_current_step) = int(itypemap_falcon(itype),kind=kind(iamtype)) enddo endif return end subroutine read_falcon_data_into_splash !------------------------------------------------------------ ! set labels for each column of data !------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,ix,ivx,ipmass, & ih,irho,iax,iutherm !ipr,iutherm use settings_data, only:ndim,ndimV,UseTypeInRenderings use geometry, only:labelcoord use falconhdf5read, only:blocklabel use asciiutils, only:lcase implicit none integer :: i,icol if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif ix = 0 iutherm = 0 do icol=1,size(blocklabel) select case(trim(lcase(blocklabel(icol)))) case('x') ix(1) = icol case('y') ix(2) = icol case('z') ix(3) = icol case('vx') ivx = icol case('ax') iax = icol case('h') ih = icol case('mass') ipmass = icol case('srho') irho = icol end select label(icol) = trim(blocklabel(icol)) enddo ! set labels of the quantities read in if (ix(1).gt.0) label(ix(1:ndim)) = labelcoord(1:ndim,1) if (irho.gt.0) label(irho) = 'density' !if (iutherm.gt.0) label(iutherm) = 'u' if (ipmass.gt.0) label(ipmass) = 'particle mass' ! set labels for vector quantities if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'_'//labelcoord(i,1) enddo endif if (iax.gt.0) then iamvec(iax:iax+ndimV-1) = iax labelvec(iax:iax+ndimV-1) = 'a' do i=1,ndimV label(iax+i-1) = trim(labelvec(iax))//'_'//labelcoord(i,1) enddo endif ! labels for each particle type already set UseTypeInRenderings(:) = .false. UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels subroutine set_splash_block_label(icol,name) bind(c) use, intrinsic :: iso_c_binding, only:c_int, c_char use falconhdf5read, only:blocklabel use asciiutils, only:fstring implicit none integer(kind=c_int), intent(in) :: icol character(kind=c_char), intent(in) :: name(256) blocklabel(icol+1) = trim(fstring(name)) !print*,icol,' name = ',trim(blocklabel(icol)) end subroutine set_splash_block_label subroutine set_splash_particle_label(itypec,name) bind(c) use, intrinsic :: iso_c_binding, only:c_int, c_char use asciiutils, only:fstring use labels, only:labeltype use falconhdf5read, only:itypemap_falcon implicit none integer(kind=c_int), intent(in) :: itypec character(kind=c_char), intent(in) :: name(256) !print*,' got type = ',itypec,' setting ',itypemap_falcon(itypec+1),'= ',trim(fstring(name)) labeltype(itypemap_falcon(itypec+1)) = trim(fstring(name)) end subroutine set_splash_particle_label splash/src/read_data_falcON_hdf5_utils.cc000644 000770 000000 00000061232 12567067742 021346 0ustar00dpricewheel000000 000000 // -*- C++ -*- //////////////////////////////////////////////////////////////////////////////// /// /// \file read_falcON_utils.cc /// /// \brief towards reading falcON HDF5 snapshots into splash /// \date 12-Aug-2015 // // Copyright (C) 2015 Walter Dehnen. // //////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////// // // PART 1: interfaces with C-linkage // this part may be used like a header file // //////////////////////////////////////////////////////////////////////////////// extern "C" { /// maximum number of particles types expected /// (actually falcON currently only supports 3 particle types) static constexpr int max_num_types = 6; // // 1.1 routines to be provided by SPLASH and called from PART 2 below // /// /// transfer data to splash /// /// \param[in] icol column of data /// \param[in] ndat number of data == number of particles of type /// \param[in] data array of ndat data /// \param[in] type index of particle type /// /// \note called by read_falcON_snapshot() void read_falcON_data_into_splash(const int*icol, const int*ndat, const double*data, const int*type); /// /// tell splash about the label of a data column /// /// \param[in] icol column of data /// \param[in] name label for this column /// /// \note called by read_falcON_snapshot() void set_splash_block_label(const int*icol, const char*name); /// /// tell splash about the label of a particle type /// /// \param[in] ityp column of data /// \param[in] name label for this column /// /// \note called by read_falcON_snapshot() void set_splash_particle_label(const int*ityp, const char*name); // // 1.2 routines provided here, but to be called from SPLASH // /// /// set debugging level /// /// \param[in] debug debugging level /// /// \note currently only debug=0,1,2,3 are distinguished. /// 0 means no output in case of an error, /// 1 means diagnostic output in case of error, /// 2 also prints errors from the HDF5 library /// 3 may print extra information (used in debugging this file) void set_falcON_debugging_level(const int*debug); /// /// opens a falcON HDF5 snapshot file /// /// \param[in] filename name of data file /// \param[out] ierr non-zero if file couldn't be opened /// /// \note precondition: none /// \note postcondition: open_falcON_snapshot() can be called /// \note We close any previously opened file (only one snapshot file can be /// open at any time with this implementation), but warn if the /// filename matches with the currently open file, if any. /// \note Use num_falcON_snapshots() for the number of snapshots in the file void open_falcON_file(const char*filename, int*ierr); /// /// queries whether a file is open /// int falcON_file_is_open(); /// /// closes the currently open (if any) falcON HDF5 snapshot file. /// /// \note precondition: none /// \note postcondition: falcON_file_is_open() will return false void close_falcON_file(); /// /// queries if there is another snapshot present the currently open file /// /// \note precondition: falcON_file_is_open() int have_falcON_snapshot(int*ierr); /// /// query the number of snapshots in the currently open file /// /// \note precondition: falcON_file_is_open() /// \note When using have_falcON_snapshot(), it may not be necessary to call /// this function, see main() in PART 3 below for an example. /// \note This function is trivial for falcON HDF5-based snapshot files, /// but non-trivial for NEMO snapshot files, which we may support in /// the future without changing this interface. int num_falcON_snapshots(int*ierr); /// /// opens the next falcON snapshot in the currently open file and /// reads its header /// /// \param[out] ntype number of particle types /// \param[out] npart number of particles per type /// \param[out] ncol number of splash columns /// \param[out] dimX number of spatial dimensions /// \param[out] dimV number of velocity dimensions /// \param[out] time simulation time of snapshot /// \param[out] hper if hper[d]!=0, dimension d is periodic with |x|= 5 // // The HDF5 library may have been compiled with another (older) GNU C++ ABI // than the one used in the rest of the falcON.2 code. Here, we must use the // same C++ ABI as used with the HDF5 C++ library. This is controlled by the // following macro, see also // // https://gcc.gnu.org/onlinedocs/libstdc++/manual/using_dual_abi.html // # define _GLIBCXX_USE_CXX11_ABI 0 #endif #if __cplusplus < 201103L # error requiring C++11 #endif #include #include #include #include #include #include #include #include /// /// 2.1 auxiliary functionality /// (symbols from the anonymous namespace have internal linkage /// namespace { /// simple struct with data for each set of particles struct Particles { std::unique_ptr group; ///< HDF5 group std::string name; ///< name: 'sink', 'gas', 'std' std::size_t number; ///< number of particles // (I couldn't figure out to avoid this via aggregate initialisation) Particles(H5::Group*g, std::string const&t, std::size_t n) : group(g), name(t), number(n) {} }; // using name_count_map = std::map; using name_and_count = name_count_map::value_type; // static data int Debug = 0; ///< debug level (0 or not 0) int IndexSnap = 0; ///< index of next snapshot int NumSnap = 0; ///< number of snapshots in file int SplashCol = 0; ///< column for splash data int NumCol = 0; ///< number of splash columns name_count_map Fields; ///< field:dims map of all fields std::vector Part; ///< data for particle sets std::vector Buffer; ///< data buffer for input std::unique_ptr File; ///< file std::string FileName; ///< name of currently open file const hsize_t k[1] = {3}; const H5::ArrayType VectorType ///< HDF5 data type for double[3] {H5::PredType::NATIVE_DOUBLE,1,k}; // closes a splash column inline void close_column(const char*name) { if(SplashCol >= NumCol) throw "number of columns exceeds expected " + std::to_string(NumCol); set_splash_block_label(&SplashCol,name); SplashCol++; } // closes a splash column inline void close_column(std::string const&name) { close_column(name.c_str()); } // closes currently open snapshot inline void close_snapshot() { SplashCol = 0; NumCol = 0; Part.clear(); Fields.clear(); } // select field for this particle type? // NOTE Without selecting, we would potentially read meaningless data. This // will not be necessary in future versions of falcON. inline bool select(std::string const&field, std::string const&ptype) { return (field=="spin" || field=="eabs" || field=="maxA")? (ptype=="sink") : (field=="snum" || field=="uin" || field=="entr" || field=="dlKt" || field=="dlKe" || field=="srho" || field=="alfa" || field=="divv" || field=="dlht" || field=="vsig" || field=="fact" || field=="csnd" || field=="pres" || field=="vort" || field=="dtdv" || field=="qmin" || field=="delE" || field=="coll")? (ptype=="gas") : (field=="krnH" || field=="maxR") ? (ptype=="sink" || ptype=="gas") : true; } // try to read a component of a falcON field into a splash column void read_column(std::string const&field, const hsize_t comp, const hsize_t dims) { bool read = false; // loop particle types for(int type=0; type!=int(Part.size()); ++type) { const auto&part = Part[std::size_t(type)]; if(!select(field,part.name)) continue; H5::DataSet data; try { data = part.group->openDataSet(field); } catch(...) { continue; // field not present: continue with next particle type } // obtain size of data set auto space = data.getSpace(); hsize_t count[2]; auto rank = space.getSimpleExtentDims(count); assert(part.number==count[0]); const int ndat = int(part.number); // read component Buffer.resize(part.number); switch(dims) { case 1: // scalar field assert(rank==1); data.read(Buffer.data(),H5::PredType::NATIVE_DOUBLE,space,space); // reduce smoothing length by factor 2 if(field=="krnH" && part.name=="gas") for(auto&x:Buffer) x*=0.5; if(Debug>2) std::clog<<"reading "<2) std::clog<<"reading "<(std::toupper(field[0])); name+= comp==0? "xx": comp==1? "xy": comp==2? "xz": comp==3? "yy": comp==4? "yz": "zz"; } else name=field; close_column(name); } } // read a field inline void read_field(name_and_count const&field) { for(hsize_t comp=0; comp!=field.second; ++comp) read_column(field.first, comp, field.second); } // try to read a falcON field inline void read_field(std::string const&field) { const auto field_iter = Fields.find(field); if(field_iter==Fields.end()) std::clog<<"WARNING: falcON field '"<openAttribute("falcON"); } catch(...) { if(Debug) std::clog<<"open_falcON_file(): file '"<openAttribute("num_snapshots"); attr.read(H5::PredType::NATIVE_UINT32,&NumSnap); } catch(H5::Exception const&exc) { // should never happen if(Debug) std::clog<<"open_falcON_file('"<= NumSnap) { if(Debug) std::clog<<"open_falcON_snapshot(): no more than " <openGroup(name); // read time and hper auto attr = snap.openAttribute("time"); attr.read(H5::PredType::NATIVE_DOUBLE,time); attr = snap.openAttribute("hper"); attr.read(VectorType,hper); // read npart[] and open particle sets std::array types = {{"sink","gas","std"}}; for(const auto&type:types) { name = "N"; name+= type; unsigned number; try { attr = snap.openAttribute(name); attr.read(H5::PredType::NATIVE_UINT32,&number); } catch(...) { // should never go here number = 0; } if(number) { // open HDF5 group for particles const auto part = snap.openGroup(type); Part.emplace_back(new H5::Group(part),type,number); npart[(*ntyp)++] = int(number); // collect (field:dims) pairs and count columns for(hsize_t fld=0; fld!=part.getNumObjs(); ++fld) { const auto field = part.getObjnameByIdx(fld); const auto have_field = Fields.count(field); if(have_field) { // field 'krnH' generates an extra column for each particle type if(field=="krnH") (*ncol)++; } else { hsize_t count[2]; const auto dims = 1==part.openDataSet(field).getSpace(). getSimpleExtentDims(count)? 1:count[1]; Fields[field] = dims; (*ncol)+= int(dims); } if(Debug>2) std::clog<<"counting columns: type="<" <<(*ncol)< PreferredOrder = {"pos", "key", "vel", "acc", "mass", "pot", "pex", "rung", "krnH", "srho", "uin", "entr", "divv", "dlKt", "dlKe", "alfa"}; try { auto FieldsToRead=Fields; // read some fields in preferred order for(const auto&field:PreferredOrder) if(FieldsToRead.erase(field)) read_field(field); // read remaining fields for(const auto&field:FieldsToRead) read_field(field); } catch(H5::Exception const&exc) { // catch any HDF5 error if(Debug) std::clog<<"read_falcON_snapshot(): HDF5 error: \"" < #include #include // // 3.1 implement interface 1.1 using C++ // namespace { struct data_per_particle_type { std::string name; std::size_t number; std::vector< std::vector > columns; }; std::vector particle_data; std::vector column_labels; } // void set_splash_block_label(const int*icol, const char*name) { column_labels.at(std::size_t(*icol)) = name; } // void set_splash_particle_label(const int*type, const char*name) { particle_data.at(std::size_t(*type)).name = name; } // void read_falcON_data_into_splash(const int*icol, const int*ndat, const double*from, const int*type) { auto&part = particle_data.at(std::size_t(*type)); assert(*ndat > 0); assert(part.number == std::size_t(*ndat)); part.columns.at(std::size_t(*icol)).resize(std::size_t(*ndat)); std::copy(from,from+*ndat,part.columns[std::size_t(*icol)].begin()); } // // 3.2 an executable that dumps a falcON file // int main(int argc, const char**argv) { // obtain program parameters if(argc<2) { std::clog<<"usage: '"<> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- module flash_hdf5read use, intrinsic :: iso_c_binding, only:c_int,c_float,c_char !interface to the c versions interface subroutine read_flash_hdf5_header(filename,time,npart,ncol,ierr) bind(c) import character(kind=c_char,len=1), intent(in) :: filename real(kind=c_float), intent(out) :: time integer(kind=c_int), intent(out) :: npart,ncol,ierr end subroutine read_flash_hdf5_header subroutine read_flash_hdf5_data(filename,npart,ncol,isrequired,ierr) bind(c) import character(kind=c_char,len=1), intent(in) :: filename integer(kind=c_int), intent(in) :: npart,ncol integer(kind=c_int), dimension(ncol), intent(in) :: isrequired integer(kind=c_int), intent(out) :: ierr end subroutine read_flash_hdf5_data end interface contains ! ! function which maps from the order in which columns ! are read from the HDF5 file to the order in which they ! are stored in SPLASH. Differs because there are a couple ! of useless arrays that we do not read/store (ie. first column ! is on/off tag, 5th column is particle ID which we use to order ! the particles) ! integer function icolshuffle(icol) implicit none integer, intent(in) :: icol select case(icol) case(1) icolshuffle = 4 case(2,3,4) icolshuffle = icol - 1 case(5) icolshuffle = 0 case default icolshuffle = icol end select end function icolshuffle end module flash_hdf5read subroutine read_data(dumpfile,indexstart,nstepsread) use particle_data, only:dat,npartoftype,masstype,time,gamma,maxpart,maxcol use params use settings_data, only:ndim,ndimV,ncolumns,ncalc,required,ipartialread,lowmemorymode use mem_allocation, only:alloc use flash_hdf5read use asciiutils, only:cstring use labels, only:ih,irho use system_utils, only:renvironment implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: dumpfile integer :: i,j,ncolstep,ilastrequired integer :: nprint,npart_max,nstep_max,ierr integer, dimension(0:maxplot) :: isrequired logical :: iexist real :: tread,hfact,totmass nstepsread = 0 nstep_max = 0 npart_max = maxpart ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions (0 means no particle coords) ! ndim = 3 ndimV = 3 j = indexstart nstepsread = 0 print "(a)",' reading FLASH tracer particles (HDF5) data format ' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) call read_flash_hdf5_header(cstring(dumpfile),tread,nprint,ncolstep,ierr) ncolstep = ncolstep - 1 ! subtract particle ID column print "(a,i10,a,es10.3,a,i2)",' npart = ',nprint,' time = ',tread call set_labels if (ih.gt.0 .and. required(ih)) required(irho) = .true. ! !--(re)allocate memory ! nstep_max = max(nstep_max,indexstart,1) if (.not.allocated(dat) .or. (nprint.gt.maxpart) .or. (ncolstep+ncalc).gt.maxcol) then npart_max = max(npart_max,nprint,maxpart) if (lowmemorymode) then ilastrequired = 0 do i=1,ncolstep+ncalc if (required(i)) ilastrequired = i enddo call alloc(npart_max,j,ilastrequired) else call alloc(npart_max,nstep_max,max(ncolstep+ncalc,maxcol)) endif endif ! !--set the necessary parameters ! ncolumns = ncolstep nstepsread = nstepsread + 1 npartoftype(:,j) = 0 npartoftype(1,j) = nprint totmass = renvironment('FSPLASH_TOTMASS',-1.0) if (totmass.gt.0.) then print "(a,1pe10.3)",' setting total mass for all particles using FSPLASH_TOTMASS=',totmass else print "(a)",' FSPLASH_TOTMASS not set, assuming total mass of all particles is 1.0' totmass = 1.0 endif masstype(1,j) = totmass/real(nprint) time(j) = tread gamma(j) = 5./3. ! !--map "required" array to integers ! also remap to the order read from the c data read ! isrequired(:) = 0 do i=1,ncolstep if (icolshuffle(i).ne.0 .and. required(icolshuffle(i))) then !print*,'required '//trim(label(icolshuffle(i)))//' so must read ',i isrequired(i) = 1 endif enddo if (.not.all(required(1:ncolstep))) then ipartialread = .true. else ipartialread = .false. endif ! !--now read the timestep data in the dumpfile ! (to avoid Fortran calling C with the array, we don't actually ! pass the dat array here - instead we get c to ! "call back" to fill the dat array, below) ! call read_flash_hdf5_data(cstring(dumpfile),nprint,ncolstep+1,isrequired(1:ncolstep+1),ierr) if (required(ih)) then hfact = 1.2 hfact = renvironment('FSPLASH_HFACT',1.2) print "(a,i2,a,f5.2,a)",' creating smoothing length in column ',ih,' using h =',hfact,'(m/rho)^(1/3)' dat(1:nprint,ih,j) = hfact*(masstype(1,j)/dat(1:nprint,irho,j))**(1./3.) endif return end subroutine read_data subroutine receive_data_fromc(icol,npart,temparr,id) bind(c) use, intrinsic :: iso_c_binding, only:c_int,c_double use particle_data, only:dat use flash_hdf5read, only:icolshuffle use labels, only:label implicit none integer(kind=c_int), intent(in) :: icol,npart real(kind=c_double), dimension(npart), intent(in) :: temparr integer(kind=c_int), dimension(npart), intent(in) :: id integer(kind=c_int) :: i,icolput icolput = icolshuffle(icol) if (icolput.gt.size(dat(1,:,1)) .or. icolput.eq.0) then print "(a,i2,a)",' ERROR: column = ',icolput,' out of range in receive_data_fromc' return endif print "(a,i2,a)",' reading column ',icol,' -> '//trim(label(icolput)) do i=1,npart if (id(i).lt.1 .or. id(i).gt.npart) then print*,' ERROR in particle id = ',id(i) else dat(id(i),icolput,1) = real(temparr(i)) endif enddo return end subroutine receive_data_fromc !!------------------------------------------------------------------- !! set labels for each column of data !! !! read these from a file called 'columns' in the current directory !! then take sensible guesses as to which quantities are which !! from the column labels !! !!------------------------------------------------------------------- subroutine set_labels use labels, only:label,labeltype,ix,irho,ipmass,ih,ivx,iamvec,labelvec use params use settings_data, only:ntypes,ndim,ndimV,UseTypeInRenderings,ncolumns use geometry, only:labelcoord implicit none integer :: i do i=1,ndim ix(i) = i label(i) = labelcoord(i,1) enddo ih = 5 ivx = 6 ipmass = 0 label(4) = 'density (from grid)' label(ih) = 'smoothing length' irho = 4 if (ncolumns.ge.9) then irho = 9 label(9) = 'density (on particles)' else irho = 4 endif if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 1 labeltype(1) = 'tracer' UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_flash_hdf5_utils.c000644 000770 000000 00000024267 11420302271 021115 0ustar00dpricewheel000000 000000 /* * This subroutine performs the calls to the HDF5 library for the FLASH * tracer particles data read * * Easier to do it this way and link with c than to try to link against * the Fortran interface (in the latter case the modules must * have been compiled with the *exact* compiler used to compile splash * which is a real pain). * */ #include #include #include #include void read_flash_hdf5_header(char *filename, float *time, int *npart, int *ncol, int *ierr) { hid_t file_id; hid_t dataset_id; hid_t dataspace_id; herr_t status; herr_t HDF5_error = -1; //printf(" opening %s \n",filename); file_id = H5Fopen(filename,H5F_ACC_RDONLY,H5P_DEFAULT); if (file_id == HDF5_error) { printf("ERROR opening %s \n",filename); *ierr = 1; return; } // READ NPART AND NCOL from file dataset_id = H5Dopen(file_id,"tracer particles"); if (dataset_id == HDF5_error) { printf("ERROR opening tracer particle data set \n"); *ierr = 2; return; } dataspace_id = H5Dget_space(dataset_id); // get dimensional information from dataspace hsize_t HDFxdims[4], HDFmaxdims[4]; int rank = H5Sget_simple_extent_dims(dataspace_id, HDFxdims, HDFmaxdims); if (rank > 4) { printf("RANK of dataset exceeds array bounds \n"); *ierr = 3; return; } // from the dimensional info, calculate the size of the buffer. *npart = HDFxdims[0]; *ncol = HDFxdims[1]; //printf(" number of particles %i \n",HDFxdims[0]); //printf(" number of columns = %i \n",HDFxdims[1]); status = H5Sclose(dataspace_id); if (status == HDF5_error) { printf("ERROR closing dataspace \n"); *ierr = 4; } status = H5Dclose(dataset_id); if (status == HDF5_error) { printf("ERROR closing dataset \n"); *ierr = 4; } /* * read the time from the file - this is * contained in a pointlessly complicated * compound structure that we have to replicate here * */ dataset_id = H5Dopen(file_id,"real scalars"); if (dataset_id == HDF5_error) { printf("ERROR opening real scalars data set for time \n"); *ierr = 5; return; } dataspace_id = H5Dget_space(dataset_id); rank = H5Sget_simple_extent_dims(dataspace_id, HDFxdims, HDFmaxdims); if (rank > 4) { printf("RANK of dataset exceeds array bounds \n"); *ierr = 3; return; } int lenheader = HDFxdims[0]; //printf(" header contains %i items \n",lenheader); typedef struct h_t { char name[80]; double value; } h_t; h_t header[lenheader]; hid_t strtype = H5Tcopy(H5T_C_S1); status = H5Tset_size (strtype, 80); hid_t compound_id = H5Tcreate(H5T_COMPOUND, sizeof(h_t)); H5Tinsert(compound_id,"name",HOFFSET(h_t, name), strtype); H5Tinsert(compound_id,"value",HOFFSET(h_t, value), H5T_NATIVE_DOUBLE); status = H5Dread(dataset_id,compound_id,H5S_ALL,H5S_ALL,H5P_DEFAULT,header); if (status == HDF5_error) { printf("ERROR reading header \n"); *ierr = 6; } *time = header[0].value; status = H5Sclose(dataspace_id); if (status == HDF5_error) { printf("ERROR closing dataspace \n"); *ierr = 4; } status = H5Dclose(dataset_id); if (status == HDF5_error) { printf("ERROR closing dataset \n"); *ierr = 4; } // Additionally check if an SPH_density data set is present if (checkfordataset(file_id,"SPH_density")==1) { printf(" file contains SPH-calculated densities \n"); *ncol += 1; } else { printf(" file does not contain SPH_density data set \n"); } status = H5Fclose( file_id ); if (status == HDF5_error) { printf("ERROR closing file \n"); *ierr = 7; } } void read_flash_hdf5_data(char *filename, int *npart, int *ncol, int *isrequired, int *ierr) { hid_t file_id; hid_t dataset_id, SPHdataset_id; hid_t dataspace_id, SPHdataspace_id; hid_t memspace_id; herr_t status; herr_t HDF5_error = -1; //printf(" re-opening %s \n",filename); file_id = H5Fopen(filename,H5F_ACC_RDONLY,H5P_DEFAULT); if (file_id == HDF5_error) { printf("ERROR re-opening %s \n",filename); *ierr = 1; return; } // re-open tracer particle dataspace dataset_id = H5Dopen(file_id,"tracer particles"); if (dataset_id == HDF5_error) { printf("ERROR opening tracer particle data set \n"); *ierr = 2; return; } dataspace_id = H5Dget_space(dataset_id); // Additionally check if an SPH_density data set is present int ncolloop; int gotSPHdata = checkfordataset(file_id,"SPH_density"); if (gotSPHdata==0) { //printf(" file does not contain SPH_density data set \n"); ncolloop = *ncol; } else { //printf(" file contains SPH-calculated densities \n"); ncolloop = *ncol - 1; } // make a temporary space to put each column as we read it hsize_t nparth[1]; nparth[0] = *npart; memspace_id = H5Screate_simple(1,nparth,NULL); // dynamically allocate a temporary double array to store one column double* temp = 0; temp = malloc(*npart*sizeof(double)); // read particle information into one column hsize_t offset[2], count[2]; int i; count[0] = *npart; count[1] = 1; /* * read particle IDs first so we can sort into ID order */ offset[0] = 0; offset[1] = 5; // ID in column 5: should check this but this is for the future status = H5Sselect_hyperslab(dataspace_id, H5S_SELECT_SET, offset, NULL, count, NULL); if (status == HDF5_error) { printf("ERROR creating hyperslab \n"); *ierr = 4; } if (!H5Sselect_valid(dataspace_id)) { printf("ERROR selecting hyperslab \n"); *ierr = 5; } // read ID H5Dread(dataset_id,H5T_NATIVE_DOUBLE,memspace_id,dataspace_id,H5P_DEFAULT,temp); int* tempid = 0; tempid = malloc(*npart*sizeof(int)); // convert temp (double) into integer array for (i=0;i<*npart;i++) { tempid[i] = (int)temp[i]; } /* * start loop from 1 because first array is a useless "tag" array that * we don't need to read. * */ for (i=1;i> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,npartoftype,time,gamma,maxpart,maxcol,maxstep use params use settings_data, only:ndim,ndimV,ncolumns,ncalc,required,ipartialread,xorigin use mem_allocation, only:alloc use system_utils, only:lenvironment use labels, only:ih implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,ierr,nerr,iunit,ncolstep integer :: nprint,npart_max,nstep_max,icol integer :: nmodel,nstar,ncolread logical :: iexist real :: tread,hmax,dtmin,tdg,hfac real, dimension(3) :: xptmass,yptmass,vxptmass,vyptmass character(len=len(rootname)+4) :: dumpfile nstepsread = 0 nstep_max = 0 npart_max = maxpart iunit = 15 ! logical unit number for input dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions (0 means no particle coords) ! ndim = 3 ndimV = 3 nstar = 2 j = indexstart nstepsread = 0 print "(a)",' Steve Foulkes/Carol Haswell/James Murray ascii data format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the file and read the number of particles ! open(unit=iunit,iostat=ierr,file=dumpfile,status='old',form='formatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return endif ! !--read header line, set time ! read(iunit,*,iostat=ierr) nmodel,nprint,hmax,tread,dtmin,tdg if (ierr /= 0) print "(a)",' WARNING: error(s) reading first header line' print "(a,1pe10.3,a,i10,a,i10)",' time = ',tread,' npart =',nprint,' model number = ',nmodel print "(3(a,1pe10.4))",' hmax = ',hmax,' dtmin = ',dtmin,' tdg = ',tdg ! !--determine how many columns we are going to read ! if (lenvironment('FSPLASH_READALL')) then ncolstep = 26 print "(a)",' reading all columns' else ncolstep = 15 print "(a,i2)",' reading only to column 15 (setenv FSPLASH_READALL ''yes'' to read all)' endif ! !--(re)allocate memory ! nstep_max = max(maxstep,nstep_max,indexstart,1) if (.not.allocated(dat) .or. (nprint.gt.maxpart) .or. (ncolstep+ncalc).gt.maxcol) then npart_max = max(npart_max,nprint+nstar,maxpart) !--allow extra room if reallocating if (allocated(dat)) npart_max = max(npart_max,INT(1.1*(nprint+nstar)),maxpart) call alloc(npart_max,nstep_max,max(ncolstep+ncalc,maxcol)) endif ! !--set the necessary parameters ! ncolumns = ncolstep nstepsread = nstepsread + 1 npartoftype(:,j) = 0 npartoftype(1,j) = nprint npartoftype(2,j) = nstar time(j) = tread gamma(j) = 5./3. ! !--now read the timestep data in the dumpfile ! nerr = 0 ! !--only read required columns ! ncolread = 0 do i=1,ncolstep if (required(i)) ncolread = i enddo if (ncolread.ne.ncolstep) then ipartialread = .true. print*,' reading only up to column ',ncolread endif do i=1,nprint read(iunit,*,iostat=ierr) (dat(i,icol,j),icol = 1,ncolread) if (ierr.ne.0) nerr = nerr + 1 enddo if (nerr > 0) print *,' ERRORS reading particle data on ',nerr,' lines' ! !--read point mass information ! read(iunit,*,iostat=ierr) xptmass(1),yptmass(1),xptmass(2),yptmass(2),hfac !--point mass velocities not read, though would put them here if they were vxptmass(1) = 0. vyptmass(1) = 0. vxptmass(2) = 0. vyptmass(2) = 0. if (ierr /= 0) print *,' ERROR reading primary and secondary positions' close(iunit) !--set labels to get ih for setting smoothing length of stars call set_labels !--copy star particle properties into main data array do i=nprint+1,nprint+nstar dat(i,1,j) = xptmass(i-nprint) dat(i,2,j) = yptmass(i-nprint) dat(i,3,j) = 0. dat(i,4,j) = vxptmass(i-nprint) dat(i,5,j) = vyptmass(i-nprint) dat(i,6,j) = 0. dat(i,7:ncolstep,j) = 0. if (ih.gt.0) dat(i,ih,j) = epsilon(0.) ! small but non-zero smoothing length enddo print "(' primary (x,y) = (',1pe10.2,',',1pe10.2,')')",xptmass(1),yptmass(1) print "(' secondary (x,y) = (',1pe10.2,',',1pe10.2,')')",xptmass(2),yptmass(2) print "(a)",' setting origin to primary position... ' xorigin(1) = xptmass(1) xorigin(2) = yptmass(1) xorigin(3) = 0. return end subroutine read_data !!------------------------------------------------------------------- !! set labels for each column of data !! !! read these from a file called 'columns' in the current directory !! then take sensible guesses as to which quantities are which !! from the column labels !! !!------------------------------------------------------------------- subroutine set_labels use labels, only:label,labeltype,ix,irho,ipmass,ih,ivx,iamvec,labelvec use params use settings_data, only:ntypes,ndim,ndimV,UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i,ifx do i=1,ndim ix(i) = i enddo ivx = ndim+1 ipmass = ivx+ndimV ifx = ipmass+1 irho = ifx+ndimV label(irho+1) = 'du/dt' label(irho+2) = 'C\d\s\u' label(irho+3) = 'alpha' ih = irho+4 label(irho+5) = 'kpc' label(irho+6) = 'schb' label(irho+7) = 'dtp' label(irho+8) = 'sigma' label(irho+9) = 'pdr2' label(irho+10) = 'av_sep' label(irho+11) = 'radius' label(irho+12) = 'viscosity flag' label(irho+13) = 'neighbour number' label(irho+14) = 'iwas' label(irho+15) = 'll' if (irho.gt.0) label(irho) = 'density' if (ih.gt.0) label(ih) = 'smoothing length' if (ipmass.gt.0) label(ipmass) = 'particle mass' if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo endif if (ifx.gt.0) then iamvec(ifx:ifx+ndimV-1) = ifx labelvec(ifx:ifx+ndimV-1) = 'f' do i=1,ndimV label(ifx+i-1) = 'f\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 2 labeltype(1) = 'gas' labeltype(2) = 'star' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_gadget.f90000644 000770 000000 00000141651 12370276252 017314 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR OUTPUT FROM THE GADGET CODE ! (works with GADGET v1.0, v2.0 and v3.0) ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! GSPLASH_FORMAT if = 2 then reads the block-labelled GADGET format ! rather than the default format. ! GSPLASH_USE_Z if 'YES' uses redshift in the legend instead of time ! GSPLASH_DARKMATTER_HSOFT if given a value > 0.0 will assign a ! smoothing length to dark matter particles which can then be ! used in the rendering ! GSPLASH_EXTRACOLS if set to a comma separated list of column labels, ! will attempt to read additional columns containing gas particle ! properties beyond the end of file ! GSPLASH_STARPARTCOLS if set to a comma separated list of column labels, ! will attempt to read additional columns containing star particle ! properties beyond the end of file ! GSPLASH_CHECKIDS if 'YES','yes','TRUE' or 'true' then reads and checks ! particle IDs for negative values and flags these as accreted particles ! GSPLASH_HSML_COLUMN if set to a positive integer, specifies the location ! of the smoothing length in the columns, overriding any default settings. ! GSPLASH_IGNORE_IFLAGCOOL if set to 'YES' or `TRUE', does not assume that ! extra columns are present even if the cooling flag is set in the header. ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Partial data read implemented Nov 2006 means that columns with ! the 'required' flag set to false are not read (read is therefore much faster) !------------------------------------------------------------------------- module gadgetread use params, only:maxplot implicit none real :: hsoft character(len=4), dimension(maxplot) :: blocklabelgas logical :: havewarned = .false. end module gadgetread subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,npartoftype,masstype,time,gamma,maxpart,maxcol,maxstep use params, only:doub_prec,sing_prec,maxparttypes use settings_data, only:ndim,ndimV,ncolumns,ncalc,iformat,required,ipartialread, & ntypes,debugmode,iverbose use settings_page, only:legendtext use mem_allocation, only:alloc use labels, only:ih,irho,ipmass,labeltype use system_utils, only:renvironment,lenvironment,ienvironment,envlist use gadgetread, only:hsoft,blocklabelgas,havewarned implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile,densfile,hfile character(len=4) :: blocklabel character(len=20) :: string integer, dimension(maxparttypes) :: npartoftypei,Nall integer, dimension(:), allocatable :: iamtemp integer :: i,j,k,n,itype,icol,ierr,ierrh,ierrrho,nhset,nvec,ifile integer :: index1,index2,indexstart,indexend,nmassesdumped,ntypesused integer :: ncolstep,npart_max,nstep_max,ntoti,nacc,ntotall,idot integer :: iFlagSfr,iFlagFeedback,iFlagCool,nfiles,istart,nhfac integer :: nextracols,nstarcols,i1,i2,i3,i4,lenblock,idumpformat integer, dimension(6) :: i0,i1all,i2all integer, parameter :: iunit = 11, iunitd = 102, iunith = 103 logical :: iexist,reallocate,checkids,usez,goterrors logical, dimension(6) :: ireadtype real(doub_prec) :: timetemp,ztemp real(doub_prec), dimension(6) :: massoftypei real(sing_prec), dimension(:), allocatable :: dattemp1 real(sing_prec), dimension(:,:), allocatable :: dattemp real :: hfact,hfactmean real, parameter :: pi = 3.1415926536 nstepsread = 0 goterrors = .false. if (maxparttypes.lt.6) then print*,' *** ERROR: not enough particle types for GADGET data read ***' print*,' *** you need to edit splash parameters and recompile ***' stop endif if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! inquire(file=datfile,exist=iexist) if (.not.iexist) then ! !--look for a file with .0 on the end for multiple-file reads ! datfile=trim(rootname)//'.0' inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(rootname)//': file not found ***' return endif endif ! !--set parameters which do not vary between timesteps ! ndim = 3 ndimV = 3 idumpformat = 0 idumpformat = ienvironment('GSPLASH_FORMAT') checkids = lenvironment('GSPLASH_CHECKIDS') usez = lenvironment('GSPLASH_USE_Z') ! !--read data from snapshots ! i = istepstart ! !--i0 is the offset used to read the data into the arrays ! (non-zero for read from multiple files) ! The offset is different for each particle type, somewhat ! complicating the data read -- we shuffle the particles from ! multiple files so that they are in type order. ! i0(:) = 0 ! !--loop over the number of files ! ifile = 0 ntotall = 0 over_files: do while(iexist) write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ifile = ifile + 1 ! !--open data file and read data ! open(iunit,iostat=ierr,file=datfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)", '*** ERROR OPENING FILE ***' return endif !if (any(i0.gt.0)) print*,'starting position for each type in data array: ',i0(:) ! !--read header for this timestep ! if (idumpformat.eq.2) then print "(a)",' >> reading block labelled Gadget format <<' read(iunit,iostat=ierr) blocklabel,lenblock !print*,ierr,blocklabel,lenblock if (ierr /= 0 .or. lenblock.ne.264) then print "(/,a,/)",'*** ERROR READING HEADER: wrong endian? or wrong format? ***' close(iunit) if (ifile.eq.1) then return else exit over_files endif endif else if (ifile.eq.1) print "(a)",' >> reading default Gadget format <<' endif npartoftypei(:) = 0 Nall(:) = 0 massoftypei(:) = 0. iFlagCool = 0 nfiles = 0 read(iunit,iostat=ierr) npartoftypei(1:6),massoftypei(1:6),timetemp,ztemp, & iFlagSfr,iFlagFeedback,Nall(1:6),iFlagCool,nfiles ntoti = int(sum(npartoftypei(1:6))) ! int here is unnecessary, but avoids compiler warnings if (nfiles.gt.1) then ntotall = int(sum(Nall(1:6))) else ntotall = ntoti endif if (debugmode) then print*,'DEBUG: ierr = ',ierr print*,'DEBUG: ntoti = ',ntoti,' ntotall = ',ntotall,' nfiles = ',nfiles print*,'DEBUG: npartoftype = ',npartoftypei(1:6),' Nall = ',Nall(1:6) print*,'DEBUG: iFlagSfr = ',iFlagSfr,' iFlagFeedback = ',iFlagFeedback,' iFlagCool = ',iFlagCool print*,'DEBUG: time = ',timetemp,' z = ',ztemp endif if (ierr /= 0 .or. ntoti.le.0 .or. ntotall.le.0 .or. any(npartoftypei.lt.0) .or. nfiles.lt.0 & .or. nfiles.gt.1e6) then print "(/,a)", '*** ERROR READING TIMESTEP HEADER: wrong endian? ***' print "(/,a)", ' (see splash userguide for compiler-dependent' print "(a)", ' ways to change endianness on the command line)' print "(/,a)", ' (set environment variable GSPLASH_FORMAT to 2 ' print "(a,/)", ' if you are using the block-labelled Gadget format)' close(iunit) if (ifile.eq.1) then return else exit over_files endif endif ! !--if we are reading from multiple files, ! check that the sequence starts from the correct file ! if (nfiles.gt.1) then idot = len_trim(datfile)-1 if (ifile.eq.1 .and. datfile(idot:idot+1).ne.'.0') then if (nfiles.lt.100) then string = "(/,a,i2,a,/,a,/)" else string = "(/,a,i7,a,/,a,/)" endif if (nfiles.gt.10000) then !--this is the most likely scenario here print "(a)",'*** ERROR reading timestep header: wrong endian? ***' else print string,' ERROR: read is from multiple files (nfiles = ',nfiles,')',& ' but this is not the first file (does not end in .0): skipping...' endif close(iunit) return endif endif if (idumpformat.eq.2) then ncolstep = 1 do while (ierr.eq.0) call read_blockheader(idumpformat,iunit,0,index2,blocklabelgas(ncolstep),lenblock,nvec) read(iunit,iostat=ierr) if ((ierr.eq.0 .and. index2.gt.0) .and. (index2.eq.ntoti & .or. index2.eq.npartoftypei(1) & .or. index2.eq.npartoftypei(2) & .or. index2.eq.npartoftypei(5) & .or. index2.eq.(npartoftypei(1)+npartoftypei(5)) & .or. index2.eq.(npartoftypei(1)+npartoftypei(2)))) then select case(blocklabelgas(ncolstep)) case('ID ') ! not a column case default ncolstep = ncolstep + nvec end select endif enddo ncolstep = ncolstep - 1 rewind(iunit) read(iunit,iostat=ierr) read(iunit,iostat=ierr) iformat = 2 nextracols = 0 nstarcols = 0 else iformat = 0 if (iFlagCool.eq.1 .and. .not.lenvironment('GSPLASH_IGNORE_IFLAGCOOL')) then iformat = 1 ncolstep = 12 ! 3 x pos, 3 x vel, pmass, utherm, rho, Ne, Nh, h if (ifile.eq.1) print "(a)",' cooling flag on : assuming Ne, Nh dumped before h' else iformat = 0 ncolstep = 10 ! 3 x pos, 3 x vel, pmass, utherm, rho, h endif if (iFlagSfr.eq.1) then if (ifile.eq.1) print "(a)",' star formation flag on: assuming star formation rate dumped ' ncolstep = ncolstep + 1 iformat = iformat + 10 endif call envlist('GSPLASH_EXTRACOLS',nextracols) if (nextracols.gt.0) then print "(a,i2,a)",' READING ',nextracols,' EXTRA COLUMNS ' ncolstep = ncolstep + nextracols endif call envlist('GSPLASH_STARPARTCOLS',nstarcols) if (nstarcols.gt.0) then print "(a,i2,a)",' READING ',nstarcols,' STAR PARTICLE COLUMN(S) ' ncolstep = ncolstep + nstarcols endif !call envlist('GSPLASH_EXTRAVECCOLS',nextraveccols) !if (nextraveccols.gt.0) then ! print "(a,i2,a)",' READING ',nextraveccols,' EXTRA COLUMNS ' ! ncolstep = ncolstep + nextraveccols !endif endif if (ifile.eq.1) then ncolumns = ncolstep ! !--call set labels to get ih, ipmass, irho for use in the read routine ! hsoft = 0. ! to avoid unset variable call set_labels endif if (ifile.eq.1) then print*,'time : ',timetemp if (usez) then print "(1x,a,f8.2,a)",'z (redshift) : ',ztemp,' (using in legend from GSPLASH_USE_Z setting)' else print "(1x,a,f8.2,a)",'z (redshift) : ',ztemp,' (set GSPLASH_USE_Z=yes to use in legend)' endif endif print*,'Npart (by type) : ',npartoftypei(1:6) if (ifile.eq.1) print*,'Mass (by type) : ',massoftypei(1:6) ! print "(10x,'|',6(1x,a12,'|'))", (labeltype(itype),itype=1,ntypes) ! print "(a10,'|',6(i11,2x,'|'))", 'Npart : ',npartoftypei ! print "(a10,'|',6(es11.3,2x,'|'))",'Mass : ',massoftypei print*,'N_gas : ',npartoftypei(1) print*,'N_total : ',ntoti if (ifile.eq.1) print*,'N data columns : ',ncolstep if (nfiles.gt.1 .and. ifile.eq.1) then print*,'Nall : ',Nall(1:6) endif if (nfiles.gt.1) then if (ifile.eq.1) print "(a,i4,a)",' reading from ',nfiles,' files' elseif (nfiles.lt.0) then print*,'*** ERROR: nfiles = ',nfiles,' in file header: aborting' return endif if (ifile.eq.1) then !--Softening lengths for Dark Matter Particles... hsoft = renvironment('GSPLASH_DARKMATTER_HSOFT') ! !--try to read dark matter and star particle smoothing lengths and/or density from a separate ! one column ascii file. If only density, use this to compute smoothing lengths. ! densfile = trim(rootname)//'.dens' hfile = trim(rootname)//'.hsml' hfact = 1.2 ! related to the analytic neighbour number (hfact=1.2 gives 58 neighbours in 3D) open(unit=iunitd,file=densfile,iostat=ierrrho,status='old',form='formatted') open(unit=iunith,file=hfile,iostat=ierrh,status='old',form='formatted') if (idumpformat.eq.2) then if (ih.eq.0 .and. (hsoft.gt.tiny(hsoft) .or. ierrrho.eq.0 .or. ierrh.eq.0)) then ncolumns = ncolumns + 1 blocklabelgas(ncolumns) = 'HSML' ih = ncolumns call set_labels endif if (irho.eq.0 .and. (hsoft.gt.tiny(hsoft) .or. ierrrho.eq.0 .or. ierrh.eq.0)) then ncolumns = ncolumns + 1 blocklabelgas(ncolumns) = 'RHO ' irho = ncolumns call set_labels endif endif ! !--if successfully read header, increment the nstepsread counter ! nstepsread = nstepsread + 1 endif ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if (ntoti.gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*ntotall) else ! if first time, save on memory npart_max = int(ntotall) endif endif if (i.ge.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol)) endif ! !--copy npartoftypei into allocated header arrays ! and set the offset position of particle types in the main data arrays ! if (nfiles.eq.1 .or. ifile.eq.1) then i0(1) = 0 do itype=2,ntypes if (nfiles.eq.1) then i0(itype) = sum(npartoftypei(1:itype-1)) ! this is avoid depending on Nall at all for single file read else i0(itype) = sum(Nall(1:itype-1)) endif enddo npartoftype(:,i) = npartoftypei else i0(1) = npartoftype(1,i) do itype=2,ntypes i0(itype) = sum(Nall(1:itype-1)) + npartoftype(itype,i) enddo npartoftype(:,i) = npartoftype(:,i) + npartoftypei endif if (debugmode) print*,'DEBUG: starting position for each type in data array: ',i0(:) ! !--set time to be used in the legend ! if (ifile.eq.1) then if (usez) then !--use this line for redshift legendtext = 'z=' time(i) = real(ztemp) else !--use this line for code time time(i) = real(timetemp) endif else if (usez) then if (abs(real(ztemp)-time(i)).gt.tiny(0.)) print*,'ERROR: redshift different between files in multiple-file read' else if (abs(real(timetemp)-time(i)).gt.tiny(0.)) print*,'ERROR: time different between files in multiple-file read' endif if (sum(Nall).ne.ntotall) then print*,' ERROR: Nall differs between files' goterrors = .true. endif endif ! !--read particle data ! got_particles: if (ntoti.gt.0) then ! !--read positions of all particles ! (note that errors on position read are fatal) ! call read_blockheader(idumpformat,iunit,ntoti,index2,blocklabel,lenblock,nvec) if (iformat.eq.2 .and. blocklabel.ne.'POS ') then print "(a)",' WARNING: expecting positions, got '//blocklabel//' in data read' endif if (any(required(1:3))) then print*,'positions ',index2 if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(3,ntoti)) read(iunit,iostat=ierr) (dattemp(:,j),j=1,index2) if (nfiles.gt.1) then ! !--read data into type order if multiple files are present: ! this means the offset position is different for each type ! if (sum(npartoftypei).ne.index2) print*,' ERROR: number of positions .ne. sum of types' n = 0 do itype=1,ntypes do j=i0(itype)+1,i0(itype)+npartoftypei(itype) n = n + 1 dat(j,1:3,i) = dattemp(1:3,n) enddo enddo !read (iunit, iostat=ierr) ((dat(j,1:3,i),j=i0(itype)+1,i0(itype)+npartoftypei(itype)),itype=1,ntypes) else do j=1,index2 dat(j,1:3,i) = dattemp(1:3,j) enddo ! read (iunit, iostat=ierr) (dat(j,1:3,i),j=1,index2) endif if (ierr /= 0) then print "(a)",'error encountered whilst reading positions ' deallocate(dattemp) return endif else read(iunit, iostat=ierr) if (ierr /= 0) then print "(a)",'error skipping positions ' return endif endif ! !--same for velocities ! call read_blockheader(idumpformat,iunit,ntoti,index2,blocklabel,lenblock,nvec) if (iformat.eq.2 .and. blocklabel.ne.'VEL ') then print "(a)",' WARNING: expecting velocity, got '//blocklabel//' in data read' endif if (any(required(4:6))) then print*,'velocities ',index2 if (.not.allocated(dattemp)) allocate(dattemp(3,ntoti)) read (iunit, iostat=ierr) (dattemp(:,j),j=1,index2) if (nfiles.gt.1) then !--see above re: type order if (sum(npartoftypei).ne.index2) print*,' ERROR: number of velocities .ne. sum of types' n = 0 do itype=1,ntypes do j=i0(itype)+1,i0(itype)+npartoftypei(itype) n = n + 1 dat(j,4:6,i) = dattemp(1:3,n) enddo enddo !read (iunit, iostat=ierr) ((dat(j,4:6,i),j=i0(itype)+1,i0(itype)+npartoftypei(itype)),itype=1,ntypes) else do j=1,index2 dat(j,4:6,i) = dattemp(1:3,j) enddo !read (iunit, iostat=ierr) (dat(j,4:6,i),j=1,index2) endif if (ierr /= 0) then print "(a)",'error encountered whilst reading velocities' goterrors = .true. endif else read(iunit, iostat=ierr) if (ierr /= 0) then print "(a)",'error skipping velocities ' if (allocated(dattemp)) deallocate(dattemp) return endif endif if (allocated(dattemp)) deallocate(dattemp) ! !--skip read of particle ID (only required if we sort the particles ! back into their correct order, which is not implemented at present) ! OR if using particle ID to flag dead particles ! ! For multiple files we only allocate and read the IDs for one file ! if (checkids) then print*,'particle ID ',ntoti if (allocated(iamtemp)) deallocate(iamtemp) allocate(iamtemp(ntoti)) endif call read_blockheader(idumpformat,iunit,ntoti,index2,blocklabel,lenblock,nvec) if (iformat.eq.2 .and. blocklabel.ne.'ID ') then print "(a)",' WARNING: expecting particle ID, got '//blocklabel//' in data read' endif if (index2.gt.0) then if (checkids .and. required(ih)) then !--particle IDs are currently only used to set h -ve for accreted particles ! so do not read if h not required read (iunit,iostat=ierr) iamtemp(1:index2) else read (iunit,iostat=ierr) ! skip this line endif if (ierr /= 0) then print "(a)",'error encountered whilst reading particle ID' goterrors = .true. endif endif ! !--read particle masses ! !--work out total number of masses dumped nmassesdumped = 0 do itype = 1,6 if (abs(massoftypei(itype)).lt.tiny(massoftypei)) then nmassesdumped = nmassesdumped + npartoftypei(itype) endif enddo if (ipmass.eq.0) then masstype(1:6,i) = real(massoftypei(1:6)) else if (required(ipmass)) then print*,'particle masses ',nmassesdumped !--read this number of entries if (nmassesdumped.gt.0) then if (allocated(dattemp1)) deallocate(dattemp1) allocate(dattemp1(nmassesdumped)) call read_blockheader(idumpformat,iunit,nmassesdumped,index2,blocklabel,lenblock,nvec) if (iformat.eq.2 .and. blocklabel.ne.'MASS') then print "(a)",' WARNING: expecting particle masses, got '//blocklabel//' in data read' endif else index2 = 0 endif if (index2.gt.0) then read(iunit,iostat=ierr) dattemp1(1:index2) endif if (ierr /= 0) then print "(a)",'error reading particle masses' goterrors = .true. endif !--now copy to the appropriate sections of the dat array indexstart = 1 !index1 = 1 do itype=1,6 if (npartoftypei(itype).ne.0) then !--work out the appropriate section of the dat array for this particle type index1 = i0(itype) + 1 index2 = i0(itype) + npartoftypei(itype) if (abs(massoftypei(itype)).lt.tiny(massoftypei)) then ! masses dumped indexend = indexstart + npartoftypei(itype) - 1 if (debugmode) & print*,' read ',npartoftypei(itype),' masses for '//trim(labeltype(itype))// & ' particles',index1,'->',index2,indexstart,'->',indexend dat(index1:index2,ipmass,i) = dattemp1(indexstart:indexend) indexstart = indexend + 1 else ! masses not dumped if (debugmode) print "(a,es10.3,i10,a,i10)",& ' setting masses for '//trim(labeltype(itype))//' particles = ', & real(massoftypei(itype)),index1,'->',index2 dat(index1:index2,ipmass,i) = real(massoftypei(itype)) endif !index1 = index2 + 1 endif enddo if (allocated(dattemp1)) deallocate(dattemp1) elseif (nmassesdumped.gt.0) then read(iunit,iostat=ierr) if (ierr /= 0) then print "(a)",'error reading particle masses' goterrors = .true. endif endif endif ! !--read other quantities for rest of particles ! print*,'gas properties ',npartoftypei(1) if (ipmass.eq.0) then istart = 7 else istart = 8 endif icol = istart-1 gas_properties: do while (icol.lt.ncolstep) !icol=istart,ncolstep !-nextraveccols !!print*,icol i3 = 0 i4 = 0 ireadtype(:) = .false. if (idumpformat.eq.2) then if (icol+1.le.ih) then call read_blockheader(idumpformat,iunit,npartoftypei(1),index2,blocklabel,lenblock,nvec) else call read_blockheader(idumpformat,iunit,0,index2,blocklabel,lenblock,nvec) endif icol = icol + nvec ! !--work out from the number of entries what mix of particle types ! the quantity is defined on ! if (index2.eq.ntoti) then i1 = i0(1) + 1 i2 = i1 + ntoti - 1 print*,blocklabel//' (',index2,': all particles)' ireadtype(:) = .true. elseif (index2.eq.npartoftypei(1)) then i1 = i0(1) + 1 i2 = i1 + index2 - 1 print*,blocklabel//' (',index2,': gas particles only)' ireadtype(1) = .true. elseif (index2.eq.npartoftypei(2)) then i1 = i0(2) + 1 i2 = i1 + index2 - 1 print*,blocklabel//' (',index2,': dark matter particles only)' ireadtype(2) = .true. elseif (index2.eq.npartoftypei(1)+npartoftypei(2)) then i1 = i0(1) + 1 i2 = i1 + index2 - 1 print*,blocklabel//' (',index2,': gas+dark matter particles only)' ireadtype(1:2) = .true. elseif (index2.eq.npartoftypei(5)) then i1 = i0(5) + 1 i2 = i1 + index2 - 1 print*,blocklabel//' (',index2,': star particles only)' ireadtype(5) = .true. elseif (index2.eq.npartoftypei(1)+npartoftypei(5)) then i1 = i0(1) + 1 i2 = i1 + npartoftypei(1) - 1 i3 = i0(5) + 1 i4 = i3 + npartoftypei(5) - 1 print*,blocklabel//' (',index2,': gas+star particles only)' ireadtype(1) = .true. ireadtype(5) = .true. else print*,blocklabel//': ERROR in block length/quantity defined on unknown mix of types n = (',index2,')' i1 = i0(1)+1 i2 = i0(1)+index2 endif else nvec = 1 icol = icol + nvec if (icol.gt.ncolstep-nstarcols) then i1 = i0(5) + 1 i2 = i1 + npartoftypei(5) - 1 print*,'star particle properties ',icol,i1,i2 ireadtype(5) = .true. else !--default is a quantity defined only on gas particles i1 = i0(1) + 1 i2 = i1 + npartoftypei(1) - 1 ireadtype(1) = .true. endif endif ! !--construct the array offsets required when reading from multiple files ! ntypesused = 0 do itype=1,6 if (ireadtype(itype) .and. npartoftypei(itype).gt.0) then ntypesused = ntypesused + 1 i1all(ntypesused) = i0(itype) + 1 i2all(ntypesused) = i0(itype) + npartoftypei(itype) endif enddo if (npartoftypei(1).gt.0) then if (required(icol)) then if (i3.gt.0) then if (nfiles.gt.1) then read (iunit,iostat=ierr) (dat(i1all(itype):i2all(itype),icol,i),itype=1,ntypesused) else read (iunit,iostat=ierr) dat(i1:i2,icol,i),dat(i3:i4,icol,i) endif else if (nvec.gt.1) then if (nfiles.gt.1) then read (iunit,iostat=ierr) & (((dat(k,j,i),j=icol-nvec+1,icol),k=i1all(itype),i2all(itype)),itype=1,ntypesused) else read (iunit,iostat=ierr) ((dat(k,j,i),j=icol-nvec+1,icol),k=i1,i2) endif else if (nfiles.gt.1) then read (iunit,iostat=ierr) (dat(i1all(itype):i2all(itype),icol,i),itype=1,ntypesused) else read (iunit,iostat=ierr) dat(i1:i2,icol,i) endif endif endif else read (iunit,iostat=ierr) endif if (ierr /= 0) then print "(1x,a,i3)",'ERROR READING PARTICLE DATA from column ',icol goterrors = .true. endif endif enddo gas_properties !if (nextraveccols.gt.0) then ! print*,'chemical species ',index2 ! read (iunit, iostat=ierr) (dat(j,4:6,i),j=1,index2) ! if (ierr /= 0) then ! print "(a)",'error encountered whilst reading velocities' ! endif !endif ! !--close data file now that we have finished reading data ! close(unit=iunit) ! !--DEAL WITH ACCRETED PARTICLES (in this file only) ! if particle ID is less than zero, treat this as an accreted particle ! (give it a negative smoothing length) ! if (checkids) then nacc = 0 !--only do this if the smoothing length is required in the data read if (required(ih)) then n = 0 !do itype=1,ntypes itype = 1 do j=1,npartoftypei(itype) n = n + 1 if (iamtemp(n) < 0) then !if (itype.gt.1) print*,' id -ve on non-gas particle ',itype,j dat(i0(itype)+j,ih,i) = -abs(dat(i0(itype)+j,ih,i)) nacc = nacc + 1 endif enddo !enddo if (nacc.gt.0) then print "(a,i10,a,/,a)",' marking ',nacc,' '//trim(labeltype(1))// & ' particles with negative ID as accreted/dead', & ' (giving them a negative smoothing length so they will be ignored in renderings)' else print "(a)",' no particles with negative ID (i.e. accreted particles) found' endif endif if (allocated(iamtemp)) deallocate(iamtemp) endif endif got_particles ! !--now memory has been allocated, set arrays which are constant for all time ! gamma = 5./3. ! !--set flag to indicate that only part of this file has been read ! if (.not.all(required(1:ncolstep))) ipartialread = .true. ! !--for read from multiple files, work out the next file in the sequence ! iexist = .false. if (nfiles.gt.1 .and. ifile.lt.nfiles) then !--see if the next file exists idot = index(datfile,'.',back=.true.) if (idot.le.0) then print "(a)",' ERROR: read from multiple files but could not determine next file in sequence' goterrors = .true. else write(string,*) ifile write(datfile,"(a,i1)") trim(datfile(1:idot))//trim(adjustl(string)) iexist = .false. inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' ERROR: read from multiple files '// & 'but could not find '//trim(datfile)//': next in sequence' goterrors = .true. endif endif endif enddo over_files ! !--for some reason the smoothing length output by GADGET is ! twice the usual SPH smoothing length ! (do this after we have read data from all of the files) ! if (required(ih) .and. ih.gt.0 .and. size(dat(1,:,:)).ge.ih .and. npartoftype(1,i).gt.0) then print "(a)",' converting GADGET smoothing length on gas particles to usual SPH definition (x 0.5)' dat(1:npartoftype(1,i),ih,i) = 0.5*dat(1:npartoftype(1,i),ih,i) endif if (nfiles.gt.1. .and. any(npartoftype(:,i).ne.Nall(:))) then print*,'ERROR: sum of Npart across multiple files .ne. Nall in data read ' print*,'Npart = ',npartoftype(:,i) print*,'Nall = ',Nall(:) goterrors = .true. endif ! !--look for dark matter smoothing length/density files ! if (ierrh.eq.0 .or. ierrrho.eq.0) then if (ierrh.eq.0) then print "(a)",' READING DARK MATTER SMOOTHING LENGTHS from '//trim(hfile) ierr = 0 index1 = npartoftype(1,i)+1 index2 = npartoftype(1,i)+sum(npartoftype(2:,i)) read(iunith,*,iostat=ierr) (dat(j,ih,i),j=index1,index2) close(unit=iunith) if (ierr.lt.0) then nhset = 0 do j=index1,index2 if (dat(j,ih,i).gt.0.) nhset = nhset + 1 enddo print "(a,i10,a,/)",' *** END-OF-FILE: GOT ',nhset,' SMOOTHING LENGTHS ***' elseif (ierr.gt.0) then print "(a)", ' *** ERROR reading smoothing lengths from file' goterrors = .true. else print "(a,i10,a)",' SMOOTHING LENGTHS READ OK for ',index2-index1+1,' dark matter / star particles ' endif hsoft = 1.0 ! just so dark matter rendering is allowed in set_labels routine endif if (ierrrho.eq.0) then print "(a)",' READING DARK MATTER DENSITIES FROM '//trim(densfile) ierr = 0 index1 = npartoftype(1,i)+1 index2 = npartoftype(1,i)+sum(npartoftype(2:,i)) read(iunitd,*,iostat=ierr) (dat(j,irho,i),j=index1,index2) close(iunitd) if (ierr.lt.0) then nhset = 0 do j=index1,index2 if (dat(j,irho,i).gt.0.) nhset = nhset + 1 enddo print "(a,i10,a,/)",' *** END-OF-FILE: GOT ',nhset,' DENSITIES ***' elseif (ierr.gt.0) then print "(a)", ' *** ERROR reading dark matter densities from file' goterrors = .true. else print "(a,i10,a)",' DENSITY READ OK for ',index2-index1+1,' dark matter / star particles ' endif if (ierrh.ne.0 .and. ipmass.gt.0) then where(dat(:,irho,i) > tiny(dat)) dat(:,ih,i) = hfact*(dat(:,ipmass,i)/dat(:,irho,i))**(1./3.) elsewhere dat(:,ih,i) = 0. end where print "(a,i10,a,f5.2,a)", & ' SMOOTHING LENGTHS SET for ',j-1-index1,' DM/star particles using h = ',hfact,'*(m/rho)**(1/3)' endif hsoft = 1.0 ! just so dark matter rendering is allowed in set_labels routine endif else ! !--if a value for the dark matter smoothing length is set ! via the environment variable GSPLASH_DARKMATTER_HSOFT, ! give dark matter particles this smoothing length ! and a density of 1 (so column density plots work) ! if (hsoft.gt.tiny(hsoft)) then if (required(ih)) then print "(a,1pe10.3,a)",' ASSIGNING SMOOTHING LENGTH of h = ',hsoft, & ' to dark matter particles' !print*,'ih = ',ih,' npartoftype = ',npartoftype(1:2,i), shape(dat) if (ih.gt.0) then dat(npartoftype(1,i)+1:npartoftype(1,i)+npartoftype(2,i),ih,i) = hsoft else print*,' ERROR: smoothing length not found in data arrays' goterrors = .true. endif endif if (required(irho)) then if (irho.gt.0) then dat(npartoftype(1,i)+1:npartoftype(1,i)+npartoftype(2,i),irho,i) = 1.0 else print*,' ERROR: place for density not found in data arrays' goterrors = .true. endif endif else if (npartoftype(1,i).le.0 .and. sum(npartoftype(:,i)).gt.0) then print "(66('*'),4(/,a),/)",'* NOTE!! For GADGET data using dark matter only, column density ',& '* plots can be produced by setting the GSPLASH_DARKMATTER_HSOFT ',& '* environment variable to give the dark matter smoothing length', & '* (for a fixed smoothing length)' hsoft = (maxval(dat(:,1,i)) - minval(dat(:,1,i)))/sum(npartoftype(2:,i))**(1./3.) print*,' suggested value for GSPLASH_DARKMATTER_HSOFT = ',hsoft hsoft = 0. print "(7(/,a),/)",'* Alternatively, and for best results, calculate a number density', & '* on dark matter particles, set individual smoothing lengths from', & '* this using h = hfact*(n)**(-1/3), with hfact=1.2 and either ', & '* dump the results back into the HSML array in the original dump ', & '* file (if using the block-labelled format), or create an ascii ',& '* file called '//trim(hfile)//' containing the smoothing length ',& '* values for the dark matter particles.' print "(2(/,a),/,66('*'),/)", '* Also make sure normalised interpolations are OFF when plotting ',& '* dark matter density ' endif endif endif ! !--pause with fatal errors ! if (goterrors .and. .not.lenvironment('GSPLASH_IGNORE_ERRORS')) then print "(/,a)",'*** ERRORS detected during data read: data will be corrupted' print "(a,/)",' Please REPORT this and/or fix your file ***' print "(a)",' (set GSPLASH_IGNORE_ERRORS=yes to skip this message)' if (iverbose.ge.1) then print "(a)",' > Press any key to bravely proceed anyway <' read* endif endif ! !--give a friendly warning about using too few or too many neighbours ! (only works with equal mass particles because otherwise we need the number density estimate) ! if (ih.gt.0 .and. required(ih) .and. ipmass.gt.0 .and. required(ipmass) & .and. abs(massoftypei(1)).lt.tiny(0.) .and. ndim.eq.3 .and. .not.havewarned) then nhfac = 100 if (npartoftype(1,i).gt.nhfac) then hfactmean = 0. do j=1,nhfac hfact = dat(j,ih,i)*(dat(j,irho,i)/(dat(j,ipmass,i)))**(1./ndim) hfactmean = hfactmean + hfact enddo hfact = hfactmean/real(nhfac) havewarned = .true. if (hfact.lt.1.125 .or. hfact.gt.1.45) then print "(/,a)",'** FRIENDLY NEIGHBOUR WARNING! **' print "(3x,a,f5.1,a,/,3x,a,f5.2,a,i1,a)", & 'It looks like you are using around ',4./3.*pi*(2.*hfact)**3,' neighbours,', & 'corresponding to h = ',hfact,'*(m/rho)^(1/',ndim,') in 3D:' if (hfact.lt.1.15) then print "(4(/,3x,a))",'This is a quite a low number of neighbours for the cubic spline and ', & 'may result in increased noise and inaccurate wave propagation speeds', & '(a cubic lattice is also an unstable initial configuration for the ',& ' particles in this regime -- see Morris 1996, Borve et al. 2004).' elseif (hfact.gt.1.45) then print "(4(/,3x,a))",'Using h >~ 1.5*(m/rho)^(1/3) with the cubic spline results in the', & 'particle pairing instability due to the first neighbour being placed under', & 'the hump in the kernel gradient. Whilst not fatal, it results in a', & 'loss of resolution so is a bit of a waste of cpu time.' print "(4(/,3x,a))",'If you are attempting to perform a "resolution study" by increasing the', & 'neighbour number, this is a *bad idea*, as you are also increasing h.', & '(a better way is to increase the smoothness of the integrals without changing h', & ' by adopting a smoother kernel such as the M5 Quintic that goes to 3h).' endif print "(/,3x,a,/,3x,a,/)", & 'A good default range is h = 1.2-1.3 (m/rho)^1/ndim ', & 'corresponding to around 58-75 neighbours in 3D.' else print "(/,1x,a,f5.1,a,/,1x,a,f5.2,a,i1,a,/)", & 'Simulations employ ',4./3.*pi*(2.*hfact)**3,' neighbours,', & 'corresponding to h = ',hfact,'*(m/rho)^(1/',ndim,') in 3D' endif endif else !print*,'not true' endif ! !--cover the special case where no particles have been read ! if (ntotall.le.0) then npartoftype(1,i) = 1 dat(:,:,i) = 0. endif if (nstepsread.gt.0) then print*,'>> last step ntot =',sum(npartoftype(:,istepstart+nstepsread-1)) endif return contains !!----------------------------------------------------------------- !! small utility to transparently handle block labelled data read !!----------------------------------------------------------------- subroutine read_blockheader(idumpfmt,lun,nexpected,ndumped,blklabel,lenblk,nvec) implicit none integer, intent(in) :: idumpfmt,lun,nexpected integer, intent(out) :: ndumped character(len=4), intent(out) :: blklabel integer, intent(out) :: lenblk integer, intent(out) :: nvec blklabel = ' ' if (idumpfmt.eq.2) then read(lun, iostat=ierr) blklabel,lenblk if (ierr /= 0) then ndumped = 0 return endif if (blklabel.eq.'POS ' .OR. blklabel.eq.'VEL ' .OR. blklabel.eq.'ACCE' .OR. blklabel.eq.'BFLD' .OR. & blklabel.eq.'BPOL' .OR. blklabel.eq.'BTOR') then ndumped = (lenblk-8)/12 nvec = 3 else ndumped = (lenblk-8)/4 nvec = 1 endif !print*,blklabel,lenblk,ndumped !if (nexpected.gt.0) then ! if (ndumped.ne.nexpected) then ! !print*,'warning: number of '//blklabel//' dumped (',ndumped,') /= expected (',nexpected,')' ! endif !endif else ndumped = nexpected endif return end subroutine read_blockheader end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,ix,ivx,ipmass, & ih,irho,ipr,iutherm,iBfirst,iBpol,iBtor,idivB,iax use params use settings_data, only:ndim,ndimV,ncolumns,ntypes,UseTypeInRenderings,iformat use geometry, only:labelcoord use system_utils, only:envlist,ienvironment use gadgetread, only:hsoft,blocklabelgas use asciiutils, only:lcase implicit none integer :: i,nextracols,nstarcols,icol,ihset character(len=30), dimension(10) :: labelextra if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif if (iformat.eq.2) then icol = 0 do i=1,size(blocklabelgas) icol = icol + 1 select case(blocklabelgas(i)) case('POS ') ix(1) = icol ix(2) = icol+1 ix(3) = icol+2 case('VEL ') ivx = icol case('ACCE') iax = icol case('BFLD') iBfirst = icol case('BPOL') iBpol = icol case('BTOR') iBtor = icol case('MASS') ipmass = icol case('U ') iutherm = icol case('RHO ') irho = icol case('NE ') label(icol) = 'N\de\u' case('NH ') label(icol) = 'N\dH\u' case('HSML') ih = icol case('NHP ') label(icol) = 'N\dH+\u' case('NHE ') label(icol) = 'N\dHe\u' case('NHEP') label(icol) = 'N\dHe+\u' case('elec') label(icol) = 'N\de\u' case('HI ') label(icol) = 'HI' case('HII ') label(icol) = 'HII' case('HeI ') label(icol) = 'HeI' case('HeII') label(icol) = 'HeII' case('H2I ') label(icol) = 'H\d2\uI' case('H2II') label(icol) = 'H\d2\uII' case('HM ') label(icol) = 'HM' case('SFR ') label(icol) = 'Star formation rate' case('TEMP') label(icol) = 'temperature' case('POT ') label(icol) = 'potential' case('AGE ') label(icol) = 'Stellar formation time' case('Z ') label(icol) = 'Metallicity' case('ENDT') label(icol) = 'd(Entropy)/dt' case('STRD') label(icol) = 'Stress (diagonal)' case('STRO') label(icol) = 'Stress (off-diagonal)' case('STRB') label(icol) = 'Stress (bulk)' case('SHCO') label(icol) = 'Shear coefficient' case('TSTP') label(icol) = 'Time step' case('DBDT') label(icol) = 'dB/dt' case('DIVB') label(icol) = 'div B' idivB = icol case('ABVC') label(icol) = 'alpha\dvisc\u' case('AMDC') label(icol) = 'alpha\dresist\u' case('PHI ') label(icol) = 'div B cleaning function' case('COOR') label(icol) = 'Cooling Rate' case('CONR') label(icol) = 'Conduction Rate' case('BFSM') label(icol) = 'B\dsmooth\u' case('DENN') label(icol) = 'Denn' case('CRC0') label(icol) = 'Cosmic Ray C0' case('CRP0') label(icol) = 'Cosmic Ray P0' case('CRE0') label(icol) = 'Cosmic Ray E0' case('CRn0') label(icol) = 'Cosmic Ray n0' case('CRco') label(icol) = 'Cosmic Ray Thermalization Time' case('CRdi') label(icol) = 'Cosmic Ray Dissipation Time' case('BHMA') label(icol) = 'Black hole mass' case('BHMD') label(icol) = 'black hole mass accretion rate' case('MACH') label(icol) = 'Mach number' case('DTEG') label(icol) = 'dt (energy)' case('PSDE') label(icol) = 'Pre-shock density' case('PSEN') label(icol) = 'Pre-shock energy' case('PSXC') label(icol) = 'Pre-shock X\d\u' case('DJMP') label(icol) = 'Density jump' case('EJMP') label(icol) = 'Energy jump' case('CRDE') label(icol) = 'Cosmic Ray injection' case('PRES') label(icol) = 'pressure' case('ID ') icol = icol - 1 case default label(icol) = trim(lcase(blocklabelgas(i))) end select enddo else do i=1,ndim ix(i) = i enddo ivx = 4 ipmass = 7 irho = 9 ! location of rho in data array ipr = 0 iutherm = 8 ! thermal energy if (iformat.eq.1 .or. iformat.eq.11 .and. ncolumns.gt.10) then label(10) = 'Ne' label(11) = 'Nh' ih = 12 ! smoothing length if (iformat.eq.11) label(13) = 'Star formation rate' else ih = 10 if (iformat.eq.1) label(11) = 'Star formation rate' endif ihset = ienvironment('GSPLASH_HSML_COLUMN',errval=-1) if (ihset.gt.0) ih = ihset ! !--deal with extra columns ! if (ncolumns.gt.ih) then call envlist('GSPLASH_EXTRACOLS',nextracols,labelextra) do i=ih+1,ih+nextracols label(i) = trim(labelextra(i-ih)) enddo call envlist('GSPLASH_STARPARTCOLS',nstarcols,labelextra) do i=ih+nextracols+1,ih+nextracols+nstarcols label(i) = trim(labelextra(i-ih-nextracols)) enddo endif endif ! !--set labels of the quantities read in ! if (ix(1).gt.0) label(ix(1:ndim)) = labelcoord(1:ndim,1) if (irho.gt.0) label(irho) = 'density' if (iutherm.gt.0) label(iutherm) = 'u' if (ipmass.gt.0) label(ipmass) = 'particle mass' if (ih.gt.0) label(ih) = 'h' ! !--set labels for vector quantities ! if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo endif if (iax.gt.0) then iamvec(iax:iax+ndimV-1) = iax labelvec(iax:iax+ndimV-1) = 'a' do i=1,ndimV label(iax+i-1) = trim(labelvec(iax))//'\d'//labelcoord(i,1) enddo endif if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'\d'//labelcoord(i,1) enddo endif if (iBpol.gt.0) then iamvec(iBpol:iBpol+ndimV-1) = iBpol labelvec(iBpol:iBpol+ndimV-1) = 'B\dpol' do i=1,ndimV label(iBpol+i-1) = trim(labelvec(iBpol))//'\d'//labelcoord(i,1) enddo endif if (iBtor.gt.0) then iamvec(iBtor:iBtor+ndimV-1) = iBtor labelvec(iBtor:iBtor+ndimV-1) = 'B\dtor' do i=1,ndimV label(iBtor+i-1) = trim(labelvec(iBtor))//'\d'//labelcoord(i,1) enddo endif !--set labels for each particle type ! ntypes = 6 labeltype(1) = 'gas' labeltype(2) = 'dark matter' labeltype(3) = 'boundary 1' labeltype(4) = 'boundary 2' labeltype(5) = 'star' labeltype(6) = 'sink / black hole' UseTypeInRenderings(1) = .true. ! !--dark matter particles are of non-SPH type (ie. cannot be used in renderings) ! unless they have had a smoothing length defined ! if (hsoft.gt.tiny(hsoft)) then UseTypeInRenderings(2) = .true. else UseTypeInRenderings(2) = .false. endif UseTypeInRenderings(3:6) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_gadget_hdf5.f90000644 000770 000000 00000101477 12036727771 020232 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR HDF5 OUTPUT FROM THE GADGET CODE ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! GSPLASH_USE_Z if 'YES' uses redshift in the legend instead of time ! GSPLASH_USE_IDS if 'YES' resorts particles according to their ParticleIDs ! GSPLASH_DARKMATTER_HSOFT if given a value > 0.0 will assign a ! smoothing length to dark matter particles which can then be ! used in the rendering ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Partial data read implemented Nov 2006 means that columns with ! the 'required' flag set to false are not read (read is therefore much faster) !------------------------------------------------------------------------- ! ! The module below contains interface routines to c functions ! that perform the actual calls to the HDF5 libs ! !------------------------------------------------------------------------- module gadgethdf5read use params, only:maxplot,doub_prec use labels, only:lenlabel use, intrinsic :: iso_c_binding, only:c_int,c_double,c_char implicit none real :: hsoft character(len=lenlabel), dimension(maxplot) :: blocklabelgas integer, dimension(maxplot) :: blocksize logical :: havewarned = .false. integer, parameter :: maxtypes = 6 interface subroutine read_gadget_hdf5_header(filename,maxtypes,npartoftypei,massoftypei,& timeh,zh,iFlagSfr,iFlagFeedback,Nall,iFlagCool, & igotids,ndim,ndimV,nfiles,ncol,ierr) bind(c) import implicit none character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(in), value :: maxtypes integer(kind=c_int), intent(out) :: iFlagSfr,iFlagFeedback,iFlagCool,igotids integer(kind=c_int), dimension(6), intent(out) :: npartoftypei,Nall real(kind=c_double), dimension(6), intent(out) :: massoftypei real(kind=c_double), intent(out) :: timeh,zh integer(kind=c_int), intent(out) :: ndim,ndimV,nfiles,ncol,ierr end subroutine read_gadget_hdf5_header subroutine read_gadget_hdf5_data(filename,maxtypes,npartoftypei,massoftypei,& ncol,isrequired,i0,ierr) bind(c) import implicit none character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(in), value :: maxtypes integer(kind=c_int), dimension(6), intent(in) :: npartoftypei real(kind=c_double), dimension(6), intent(in) :: massoftypei integer(kind=c_int), intent(in), value :: ncol integer(kind=c_int), intent(out) :: ierr integer(kind=c_int), dimension(ncol), intent(in) :: isrequired integer(kind=c_int), dimension(maxtypes), intent(in) :: i0 end subroutine read_gadget_hdf5_data end interface contains !--------------------------------------------------------------------------- ! ! function to safely convert a string from c format (ie. with a terminating ! ascii null character) back to a normal Fortran string ! !--------------------------------------------------------------------------- function fstring(array) implicit none character(kind=c_char), dimension(:), intent(in) :: array character(len=size(array)-1) :: fstring integer :: i fstring = '' do i=1,size(array) if (array(i).eq.achar(0)) exit fstring(i:i) = array(i) enddo end function fstring !--------------------------------------------------------------------------- ! ! function to reformat the HDF5 label into the splash column label ! by inserting a space whereever a capital letter occurs ! !--------------------------------------------------------------------------- function reformatlabel(label) implicit none character(len=*), intent(in) :: label character(len=2*len(label)) :: reformatlabel integer :: is,ia,ib,ip reformatlabel = label ip = 1 do is = 2, len_trim(label) ip = ip + 1 ia = iachar(reformatlabel(ip:ip)) ib = iachar(reformatlabel(ip-1:ip-1)) if ((ia >= iachar('A').and.ia <= iachar('Z')) .and. .not. & (ib >= iachar('A').and.ib <= iachar('Z'))) then reformatlabel = reformatlabel(1:ip-1)//' '//reformatlabel(ip:) ip = ip + 1 endif enddo end function reformatlabel end module gadgethdf5read !------------------------------------------------------------------------- ! ! The routine that reads the data into splash's internal arrays ! !------------------------------------------------------------------------- subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,npartoftype,masstype,time,gamma,maxpart,maxcol,maxstep use params, only:doub_prec,maxparttypes,maxplot use settings_data, only:ndim,ndimV,ncolumns,ncalc,iformat,required,ipartialread, & ntypes,debugmode,iverbose use settings_page, only:legendtext use mem_allocation, only:alloc use labels, only:ih,irho,ipmass,labeltype use system_utils, only:renvironment,lenvironment,ienvironment,envlist use asciiutils, only:cstring use gadgethdf5read, only:hsoft,blocklabelgas,havewarned,read_gadget_hdf5_header, & read_gadget_hdf5_data,maxtypes implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile,densfile,hfile character(len=20) :: string integer, dimension(maxparttypes) :: npartoftypei,Nall integer :: i,j,itype,ierr,ierrh,ierrrho,nhset,ifile integer :: index1,index2 integer :: ncolstep,npart_max,nstep_max,ntoti,ntotall,idot integer :: iFlagSfr,iFlagFeedback,iFlagCool,igotids,nfiles,nhfac integer, dimension(6) :: i0 integer, parameter :: iunit = 11, iunitd = 102, iunith = 103 logical :: iexist,reallocate,usez,debug,goterrors real(doub_prec) :: timetemp,ztemp real(doub_prec), dimension(6) :: massoftypei real :: hfact,hfactmean,pmassi real, parameter :: pi = 3.1415926536 integer, dimension(maxplot) :: isrequired nstepsread = 0 goterrors = .false. if (maxparttypes.lt.6) then print*,' *** ERROR: not enough particle types for GADGET data read ***' print*,' *** you need to edit splash parameters and recompile ***' stop endif if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! print "(1x,a)",'reading GADGET HDF5 format' inquire(file=datfile,exist=iexist) if (.not.iexist) then ! !--look for a file with .0 on the end for multiple-file reads ! datfile=trim(rootname)//'.0.hdf5' inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(rootname)//': file not found ***' return endif endif ! !--set parameters which do not vary between timesteps ! ndim = 0 ndimV = 0 ! idumpformat = ienvironment('GSPLASH_FORMAT') ! checkids = lenvironment('GSPLASH_CHECKIDS') usez = lenvironment('GSPLASH_USE_Z') debug = lenvironment('GSPLASH_DEBUG') .or. debugmode ! !--read data from snapshots ! i = istepstart ! !--i0 is the offset used to read the data into the arrays ! (non-zero for read from multiple files) ! The offset is different for each particle type, somewhat ! complicating the data read -- we shuffle the particles from ! multiple files so that they are in type order. ! i0(:) = 0 ! !--loop over the number of files ! ifile = 0 ntotall = 0 over_files: do while(iexist) write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ifile = ifile + 1 ! !--open file and read header information ! npartoftypei(:) = 0. Nall(:) = 0. massoftypei(:) = 0. if (debug) print*,'DEBUG: reading header...' call read_gadget_hdf5_header(cstring(datfile),maxtypes, & npartoftypei,massoftypei,timetemp,ztemp,iFlagSfr,iFlagFeedback,Nall,& iFlagCool,igotids,ndim,ndimV,nfiles,ncolstep,ierr) if (ierr /= 0) then print "(a)", '*** ERROR READING HEADER ***' return endif ! read(iunit,iostat=ierr) npartoftypei(1:6),massoftypei,timetemp,ztemp, & ! iFlagSfr,iFlagFeedback,Nall(1:6),iFlagCool,nfiles ntoti = int(sum(npartoftypei(1:6))) ! int here is unnecessary, but avoids compiler warnings if (nfiles.gt.1) then ntotall = int(sum(Nall(1:6))) else ntotall = ntoti endif ! !--if we are reading from multiple files, ! check that the sequence starts from the correct file ! if (nfiles.gt.1) then idot = index(datfile,'.hdf5') idot = index(datfile(1:idot-1),'.',back=.true.) if (ifile.eq.1 .and. datfile(idot:idot+1).ne.'.0') then if (nfiles.lt.100) then string = "(/,a,i2,a,/,a,/)" else string = "(/,a,i7,a,/,a,/)" endif print string,' ERROR: read is from multiple files (nfiles = ',nfiles,')',& ' but this is not the first file (does not end in .0.hdf5): skipping...' close(iunit) return endif endif if (ifile.eq.1) then ncolumns = ncolstep ! !--call set labels to get ih, ipmass, irho for use in the read routine ! hsoft = 0. ! to avoid unset variable call set_labels endif if (ifile.eq.1) then print*,'time : ',timetemp if (usez) then print "(1x,a,f8.2,a)",'z (redshift) : ',ztemp,' (using in legend from GSPLASH_USE_Z setting)' else print "(1x,a,f8.2,a)",'z (redshift) : ',ztemp,' (set GSPLASH_USE_Z=yes to use in legend)' endif endif print "(a,6(1x,i10))",' Npart (by type) : ',npartoftypei(1:6) if (any(massoftypei.gt.0.)) print "(a,6(1x,es10.3))",' Mass (by type) : ',massoftypei print "(a,6(1x,i10))",' N_gas : ',npartoftypei(1) print "(a,1x,i10)",' N_total : ',ntoti if (ifile.eq.1) print "(a,1x,i10)",' N data columns : ',ncolstep if (nfiles.gt.1 .and. ifile.eq.1) then print "(a,6(1x,i10))",' Nall : ',Nall(1:6) endif if (nfiles.gt.1) then if (ifile.eq.1) print "(a,i4,a)",' reading from ',nfiles,' files' elseif (nfiles.le.0) then print*,'*** ERROR: nfiles = ',nfiles,' in file header: aborting' return endif if (ifile.eq.1) then !--Softening lengths for Dark Matter Particles... hsoft = renvironment('GSPLASH_DARKMATTER_HSOFT') ! !--try to read dark matter and star particle smoothing lengths and/or density from a separate ! one column ascii file. If only density, use this to compute smoothing lengths. ! densfile = trim(rootname)//'.dens' hfile = trim(rootname)//'.hsml' hfact = 1.2 ! related to the analytic neighbour number (hfact=1.2 gives 58 neighbours in 3D) open(unit=iunitd,file=densfile,iostat=ierrrho,status='old',form='formatted') open(unit=iunith,file=hfile,iostat=ierrh,status='old',form='formatted') if (ih.eq.0 .and. (hsoft.gt.tiny(hsoft) .or. ierrrho.eq.0 .or. ierrh.eq.0)) then ncolumns = ncolumns + 1 blocklabelgas(ncolumns) = 'SmoothingLength' ih = ncolumns call set_labels endif if (irho.eq.0 .and. (hsoft.gt.tiny(hsoft) .or. ierrrho.eq.0 .or. ierrh.eq.0)) then ncolumns = ncolumns + 1 blocklabelgas(ncolumns) = 'Density' irho = ncolumns call set_labels endif ! !--if successfully read header, increment the nstepsread counter ! nstepsread = nstepsread + 1 endif ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if (ntoti.gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*ntotall) else ! if first time, save on memory npart_max = int(ntotall) endif endif if (i.ge.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then if (igotids.eq.1) then call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol),mixedtypes=.true.) else call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol)) endif endif masstype(1:6,i) = massoftypei(1:6) ! !--copy npartoftypei into allocated header arrays ! and set the offset position of particle types in the main data arrays ! if (nfiles.eq.1 .or. ifile.eq.1) then i0(1) = 0 do itype=2,ntypes if (nfiles.eq.1) then i0(itype) = sum(npartoftypei(1:itype-1)) ! this is avoid depending on Nall at all for single file read else i0(itype) = sum(Nall(1:itype-1)) endif enddo npartoftype(:,i) = npartoftypei else i0(1) = npartoftype(1,i) do itype=2,ntypes i0(itype) = sum(Nall(1:itype-1)) + npartoftype(itype,i) enddo npartoftype(:,i) = npartoftype(:,i) + npartoftypei endif if (debugmode) print*,'DEBUG: starting position for each type in data array: ',i0(:) ! !--set time to be used in the legend ! if (ifile.eq.1) then if (usez) then !--use this line for redshift legendtext = 'z=' time(i) = real(ztemp) else !--use this line for code time time(i) = real(timetemp) endif else if (usez) then if (abs(real(ztemp)-time(i)).gt.tiny(0.)) print*,'ERROR: redshift different between files in multiple-file read' else if (abs(real(timetemp)-time(i)).gt.tiny(0.)) print*,'ERROR: time different between files in multiple-file read ' endif if (sum(Nall).ne.ntotall) then print*,' ERROR: Nall differs between files' goterrors = .true. endif endif ! !--read particle data ! got_particles: if (ntoti.gt.0) then isrequired(:) = 0 where (required(1:ncolumns)) isrequired(1:ncolumns) = 1 call read_gadget_hdf5_data(cstring(datfile),maxtypes,npartoftypei,massoftypei,ncolumns,isrequired,i0,ierr) endif got_particles ! !--now memory has been allocated, set arrays which are constant for all time ! gamma = 5./3. ! !--set flag to indicate that only part of this file has been read ! if (.not.all(required(1:ncolstep))) ipartialread = .true. ! !--for read from multiple files, work out the next file in the sequence ! iexist = .false. if (nfiles.gt.1 .and. ifile.lt.nfiles) then !--see if the next file exists idot = index(datfile,'.hdf5') idot = index(datfile(1:idot-1),'.',back=.true.) if (idot.le.0) then print "(a)",' ERROR: read from multiple files but could not determine next file in sequence' goterrors = .true. else write(string,*) ifile if (ifile.lt.10) then write(datfile,"(a,i1)") trim(datfile(1:idot))//trim(adjustl(string))//'.hdf5' elseif (ifile.lt.100) then write(datfile,"(a,i2)") trim(datfile(1:idot))//trim(adjustl(string))//'.hdf5' else write(datfile,"(a,i3)") trim(datfile(1:idot))//trim(adjustl(string))//'.hdf5' endif iexist = .false. inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' ERROR: read from multiple files '// & 'but could not find '//trim(datfile)//': next in sequence' goterrors = .true. endif endif endif enddo over_files ! !--for some reason the smoothing length output by GADGET is ! twice the usual SPH smoothing length ! (do this after we have read data from all of the files) ! if (required(ih) .and. size(dat(1,:,:)).ge.ih .and. npartoftype(1,i).gt.0) then print "(a)",' converting GADGET smoothing length on gas particles to usual SPH definition (x 0.5)' dat(1:npartoftype(1,i),ih,i) = 0.5*dat(1:npartoftype(1,i),ih,i) endif if (nfiles.gt.1. .and. any(npartoftype(:,i).ne.Nall(:))) then print*,'ERROR: sum of Npart across multiple files .ne. Nall in data read ' print*,'Npart = ',npartoftype(:,i) print*,'Nall = ',Nall(:) goterrors = .true. endif ! !--look for dark matter smoothing length/density files ! if (ierrh.eq.0 .or. ierrrho.eq.0) then if (ierrh.eq.0) then print "(a)",' READING DARK MATTER SMOOTHING LENGTHS from '//trim(hfile) ierr = 0 index1 = npartoftype(1,i)+1 index2 = npartoftype(1,i)+sum(npartoftype(2:,i)) read(iunith,*,iostat=ierr) (dat(j,ih,i),j=index1,index2) close(unit=iunith) if (ierr.lt.0) then nhset = 0 do j=index1,index2 if (dat(j,ih,i).gt.0.) nhset = nhset + 1 enddo print "(a,i10,a,/)",' *** END-OF-FILE: GOT ',nhset,' SMOOTHING LENGTHS ***' elseif (ierr.gt.0) then print "(a)", ' *** ERROR reading smoothing lengths from file' goterrors = .true. else print "(a,i10,a)",' SMOOTHING LENGTHS READ OK for ',index2-index1+1,' dark matter / star particles ' endif hsoft = 1.0 ! just so dark matter rendering is allowed in set_labels routine endif if (ierrrho.eq.0) then print "(a)",' READING DARK MATTER DENSITIES FROM '//trim(densfile) ierr = 0 index1 = npartoftype(1,i)+1 index2 = npartoftype(1,i)+sum(npartoftype(2:,i)) read(iunitd,*,iostat=ierr) (dat(j,irho,i),j=index1,index2) close(iunitd) if (ierr.lt.0) then nhset = 0 do j=index1,index2 if (dat(j,irho,i).gt.0.) nhset = nhset + 1 enddo print "(a,i10,a,/)",' *** END-OF-FILE: GOT ',nhset,' DENSITIES ***' elseif (ierr.gt.0) then print "(a)", ' *** ERROR reading dark matter densities from file' goterrors = .true. else print "(a,i10,a)",' DENSITY READ OK for ',index2-index1+1,' dark matter / star particles ' endif if (ierrh.ne.0 .and. ipmass.gt.0) then where(dat(:,irho,i) > tiny(dat)) dat(:,ih,i) = hfact*(dat(:,ipmass,i)/dat(:,irho,i))**(1./3.) elsewhere dat(:,ih,i) = 0. end where print "(a,i10,a,f5.2,a)", & ' SMOOTHING LENGTHS SET for ',j-1-index1,' DM/star particles using h = ',hfact,'*(m/rho)**(1/3)' endif hsoft = 1.0 ! just so dark matter rendering is allowed in set_labels routine endif else ! !--if a value for the dark matter smoothing length is set ! via the environment variable GSPLASH_DARKMATTER_HSOFT, ! give dark matter particles this smoothing length ! and a density of 1 (so column density plots work) ! if (hsoft.gt.tiny(hsoft)) then if (required(ih)) then print "(a,1pe10.3,a)",' ASSIGNING SMOOTHING LENGTH of h = ',hsoft, & ' to dark matter particles' !print*,'ih = ',ih,' npartoftype = ',npartoftype(1:2,i), shape(dat) if (ih.gt.0) then dat(npartoftype(1,i)+1:npartoftype(1,i)+npartoftype(2,i),ih,i) = hsoft else print*,' ERROR: smoothing length not found in data arrays' goterrors = .true. endif endif if (required(irho)) then if (irho.gt.0) then dat(npartoftype(1,i)+1:npartoftype(1,i)+npartoftype(2,i),irho,i) = 1.0 else print*,' ERROR: place for density not found in data arrays' goterrors = .true. endif endif else if (npartoftype(1,i).le.0 .and. sum(npartoftype(:,i)).gt.0) then print "(66('*'),4(/,a),/)",'* NOTE!! For GADGET data using dark matter only, column density ',& '* plots can be produced by setting the GSPLASH_DARKMATTER_HSOFT ',& '* environment variable to give the dark matter smoothing length', & '* (for a fixed smoothing length)' hsoft = (maxval(dat(:,1,i)) - minval(dat(:,1,i)))/sum(npartoftype(2:,i))**(1./3.) print*,' suggested value for GSPLASH_DARKMATTER_HSOFT = ',hsoft hsoft = 0. print "(7(/,a),/)",'* Alternatively, and for best results, calculate a number density', & '* on dark matter particles, set individual smoothing lengths from', & '* this using h = hfact*(n)**(-1/3), with hfact=1.2 and either ', & '* dump the results back into the HSML array in the original dump ', & '* file (if using the block-labelled format), or create an ascii ',& '* file called '//trim(hfile)//' containing the smoothing length ',& '* values for the dark matter particles.' print "(2(/,a),/,66('*'),/)", '* Also make sure normalised interpolations are OFF when plotting ',& '* dark matter density ' endif endif endif ! !--pause with fatal errors ! if (goterrors .and. .not.lenvironment('GSPLASH_IGNORE_ERRORS')) then print "(/,a)",'*** ERRORS detected during data read: data will be corrupted' print "(a,/)",' Please REPORT this and/or fix your file ***' print "(a)",' (set GSPLASH_IGNORE_ERRORS=yes to skip this message)' if (iverbose.ge.1) then print "(a)",' > Press any key to bravely proceed anyway <' read* endif endif ! !--give a friendly warning about using too few or too many neighbours ! (only works with equal mass particles because otherwise we need the number density estimate) ! if (ih.gt.0 .and. required(ih) .and. ipmass.gt.0 .and. required(ipmass) & .and. abs(massoftypei(1)).lt.tiny(0.) .and. ndim.eq.3 .and. .not.havewarned) then nhfac = 100 if (npartoftype(1,i).gt.nhfac) then hfactmean = 0. do j=1,nhfac pmassi = dat(j,ipmass,i) if (pmassi.gt.0.) then pmassi = 1./pmassi else pmassi = 0. endif hfact = dat(j,ih,i)*(dat(j,irho,i)*pmassi)**(1./ndim) hfactmean = hfactmean + hfact enddo hfact = hfactmean/real(nhfac) havewarned = .true. if (hfact.lt.1.125 .or. hfact.gt.1.45) then print "(/,a)",'** FRIENDLY NEIGHBOUR WARNING! **' print "(3x,a,f5.1,a,/,3x,a,f4.2,a,i1,a)", & 'It looks like you are using around ',4./3.*pi*(2.*hfact)**3,' neighbours,', & 'corresponding to h = ',hfact,'*(m/rho)^(1/',ndim,') in 3D:' if (hfact.lt.1.15) then print "(4(/,3x,a))",'This is a quite a low number of neighbours for the cubic spline and ', & 'may result in increased noise and inaccurate wave propagation speeds', & '(a cubic lattice is also an unstable initial configuration for the ',& ' particles in this regime -- see Morris 1996, Borve et al. 2004).' elseif (hfact.gt.1.45) then print "(4(/,3x,a))",'Using h >~ 1.5*(m/rho)^(1/3) with the cubic spline results in the', & 'particle pairing instability due to the first neighbour being placed under', & 'the hump in the kernel gradient. Whilst not fatal, it results in a', & 'loss of resolution so is a bit of a waste of cpu time.' print "(4(/,3x,a))",'If you are attempting to perform a "resolution study" by increasing the', & 'neighbour number, this is a *bad idea*, as you are also increasing h.', & '(a better way is to increase the smoothness of the integrals without changing h', & ' by adopting a smoother kernel such as the M6 Quintic that goes to 3h).' endif print "(/,3x,a,/,3x,a,/)", & 'A good default is h = 1.2 (m/rho)^1/ndim ', & 'corresponding to around 58 neighbours in 3D.' else print "(/,1x,a,f5.1,a,/,1x,a,f4.2,a,i1,a,/)", & 'Simulations employ ',4./3.*pi*(2.*hfact)**3,' neighbours,', & 'corresponding to h = ',hfact,'*(m/rho)^(1/',ndim,') in 3D' endif endif else !print*,'not true' endif ! !--cover the special case where no particles have been read ! if (ntotall.le.0) then npartoftype(1,i) = 1 dat(:,:,i) = 0. endif if (nstepsread.gt.0) then print "(a,i10,a)",' >> read ',sum(npartoftype(:,istepstart+nstepsread-1)),' particles' endif return end subroutine read_data subroutine read_gadgethdf5_data_fromc(icol,npartoftypei,temparr,id,itype,i0) bind(c) use, intrinsic :: iso_c_binding, only:c_int,c_double use particle_data, only:dat,iamtype use settings_data, only:debugmode use labels, only:label,ih use system_utils, only:lenvironment implicit none integer(kind=c_int), intent(in) :: icol,npartoftypei,itype,i0 real(kind=c_double), dimension(npartoftypei), intent(in) :: temparr integer(kind=c_int), dimension(npartoftypei), intent(in) :: id integer(kind=c_int) :: i,icolput integer :: nmax,nerr,idi logical :: useids icolput = icol if (debugmode) print "(a,i2,a,i2,a,i8)",'DEBUG: reading column ',icol,' type ',itype,' -> '//trim(label(icolput))//', offset ',i0 if (icolput.gt.size(dat(1,:,1)) .or. icolput.eq.0) then print "(a,i2,a)",' ERROR: column = ',icolput,' out of range in receive_data_fromc' return endif nmax = size(dat(:,1,1)) useids = lenvironment('GSPLASH_USE_IDS') .or. lenvironment('GSPLASH_CHECKIDS') if (all(id.le.0) .or. size(iamtype(:,1)).le.1) useids = .false. if (debugmode) print*,'DEBUG: using particle IDs = ',useids,' max = ',nmax if (useids) then nerr = 0 !print*,' id range is ',minval(id),' to ',maxval(id),' type ',itype+1,' column = ',trim(label(icolput)) do i=1,npartoftypei if (id(i).lt.1 .or. id(i).gt.nmax) then idi = id(i) ! !--correct for particle IDs > 1e9 (used to represent recycled particles?) ! if (idi.gt.1000000000) then idi = idi - 1000000000 if (idi.le.nmax .or. idi.le.0) then dat(idi,icolput,1) = real(temparr(i)) iamtype(idi,1) = itype + 1 else nerr = nerr + 1 if (debugmode .and. nerr.le.10) print*,i,'fixed id = ',idi endif else nerr = nerr + 1 if (debugmode .and. nerr.le.10) print*,i,' id = ',idi,idi-1000000000 endif else dat(id(i),icolput,1) = real(temparr(i)) iamtype(id(i),1) = itype + 1 endif enddo if (nerr.gt.0) print*,'ERROR: got particle ids outside array dimensions ',nerr,' times' else if (i0.lt.0) then print*,'ERROR: i0 = ',i0,' but should be positive: SOMETHING IS VERY WRONG...' return elseif (i0+npartoftypei.gt.nmax) then print "(a,i8,a)",' ERROR: offset = ',i0,': read will exceed array dimensions in receive_data_fromc' nmax = nmax - i0 else nmax = npartoftypei endif do i=1,nmax dat(i0+i,icolput,1) = real(temparr(i)) enddo if (size(iamtype(:,1)).gt.1) then do i=1,nmax iamtype(i0+i,1) = itype + 1 enddo endif endif return end subroutine read_gadgethdf5_data_fromc !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,ix,ivx,ipmass, & ih,irho,ipr,iutherm,iBfirst,idivB,iax use params use settings_data, only:ndim,ndimV,ncolumns,ntypes,UseTypeInRenderings,iformat use geometry, only:labelcoord use system_utils, only:envlist,ienvironment use gadgethdf5read, only:hsoft,blocklabelgas,blocksize,reformatlabel use asciiutils, only:lcase implicit none integer :: i,j,icol,irank if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif icol = 1 ix = 0 do i=1,size(blocklabelgas) irank = blocksize(i) if (irank.gt.0 .and. (len_trim(blocklabelgas(i)).gt.0)) then select case(blocklabelgas(i)) case('Coordinates') ix(1) = icol ix(2) = icol + 1 if (irank.ge.3) ix(3) = icol + 2 case('Velocities','Velocity') ivx = icol case('SmoothingLength') ih = icol case('Masses','Mass') ipmass = icol case('InternalEnergy') iutherm = icol case('Density') irho = icol case('MagneticField') iBfirst = icol case default label(icol:icol+irank-1) = reformatlabel(blocklabelgas(i)) end select if (irank.eq.ndimV) then iamvec(icol:icol+ndimV-1) = icol labelvec(icol:icol+ndimV-1) = label(icol) do j=1,ndimV label(icol+j-1) = trim(labelvec(icol))//'\d'//labelcoord(j,1) enddo endif icol = icol + irank endif enddo ! !--set labels of the quantities read in ! if (ix(1).gt.0) label(ix(1:ndim)) = labelcoord(1:ndim,1) if (irho.gt.0) label(irho) = 'density' if (iutherm.gt.0) label(iutherm) = 'u' if (ipmass.gt.0) label(ipmass) = 'particle mass' if (ih.gt.0) label(ih) = 'h' ! !--set labels for vector quantities ! if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo endif if (iax.gt.0) then iamvec(iax:iax+ndimV-1) = iax labelvec(iax:iax+ndimV-1) = 'a' do i=1,ndimV label(iax+i-1) = trim(labelvec(iax))//'\d'//labelcoord(i,1) enddo endif if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'\d'//labelcoord(i,1) enddo endif !--set labels for each particle type ! ntypes = 6 labeltype(1) = 'gas' labeltype(2) = 'dark matter' labeltype(3) = 'boundary 1' labeltype(4) = 'boundary 2' labeltype(5) = 'star' labeltype(6) = 'sink / black hole' UseTypeInRenderings(1) = .true. ! !--dark matter particles are of non-SPH type (ie. cannot be used in renderings) ! unless they have had a smoothing length defined ! if (hsoft.gt.tiny(hsoft)) then UseTypeInRenderings(2) = .true. else UseTypeInRenderings(2) = .false. endif UseTypeInRenderings(3:6) = .false. !----------------------------------------------------------- return end subroutine set_labels subroutine set_blocklabel(icol,irank,name) bind(c) use, intrinsic :: iso_c_binding, only:c_int, c_char use gadgethdf5read, only:blocklabelgas,blocksize,fstring implicit none integer(kind=c_int), intent(in) :: icol,irank character(kind=c_char), dimension(256), intent(in) :: name blocklabelgas(icol+1) = fstring(name) blocksize(icol+1) = irank !print*,icol+1,' name = ',trim(blocklabelgas(icol+1)),' x ',irank end subroutine set_blocklabel splash/src/read_data_gadget_hdf5_utils.c000644 000770 000000 00000045061 12504246616 021264 0ustar00dpricewheel000000 000000 /* * This subroutine performs the calls to the HDF5 library for the * GADGET data read * * Easier to do it this way and link with c than to try to link against * the Fortran interface (in the latter case the modules must * have been compiled with the *exact* compiler used to compile splash * which is a real pain). * */ #include #include #include #include static int debug = 0; int checkfordataset(hid_t file_id, char *datasetname); int read_gadgethdf5_dataset(hid_t group_id, char *datasetname, int itype, int maxtypes, int npartoftype[maxtypes], int i0[maxtypes], int ncol, int isrequired[ncol], int *id, int *j); int get_rank(hid_t dataspace_id); int get_rank_by_name(hid_t group_id, char *name); void set_blocklabel(int *icol, int *irank, char *name); void read_gadgethdf5_data_fromc(int *icol, int *npartoftypei, double temparr[*npartoftypei], int id[*npartoftypei], int *itype, int *i0); void get_vel_info(hid_t group_id, char *name, int *ndimV); void get_mass_info(hid_t group_id, char *name, int *rank); void read_gadget_hdf5_header(char *filename, int maxtypes, int *npartoftype[maxtypes], double *massoftype[maxtypes], double *time, double *redshift, int *iFlagSfr, int *iFlagFeedback, int *Nall[maxtypes], int *iFlagCool, int *igotids, int *ndim, int *ndimV, int *nfiles, int *ncol, int *ierr) { hid_t file_id; hid_t group_id, dataset_id; hid_t attrib_id, dataspace_id; herr_t status; herr_t HDF5_error = -1; *ierr = 0; *igotids = 0; if (debug) printf("DEBUG: opening %s \n",filename); file_id = H5Fopen(filename,H5F_ACC_RDONLY,H5P_DEFAULT); if (file_id == HDF5_error) { printf("ERROR opening %s \n",filename); *ierr = 1; return; } /* * Open the "Header" dataset and read the header information * */ if (!checkfordataset(file_id,"Header")) { printf(" ERROR: \"Header\" dataset not found in GADGET HDF5 file\n"); *ierr = 2; return; } #if H5_VERSION_GE(1,8,0) group_id = H5Gopen2(file_id,"Header",H5P_DEFAULT); #else group_id = H5Gopen(file_id,"Header"); #endif if (group_id == HDF5_error) { printf("ERROR opening Header data set \n"); *ierr = 2; return; } int nattrib; int i; char name[256],maindataset[256]; char namevels[256],namemass[256]; nattrib = H5Aget_num_attrs(group_id); /* * Read through all of the attributes in the header, so we * can still spit out the values even if they are not used by SPLASH */ double BoxSize,HubbleParam,Omega0,OmegaLambda; int iFlagStellarAge,iFlagMetals; for(i=0; i < nattrib; i++) { attrib_id = H5Aopen_idx(group_id,i); ssize_t attr_status; attr_status = H5Aget_name(attrib_id, 256, name); hid_t type_id; type_id = H5Aget_type(attrib_id); /*type_class = H5Tget_native_type(type_id,H5T_DIR_ASCEND);*/ if (strcmp(name,"Time")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,time); } else if (strcmp(name,"MassTable")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,massoftype); /*printf(" Masses = %i %f \n",maxtypes,massoftype[1]);*/ } else if (strcmp(name,"NumPart_ThisFile")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,npartoftype); } else if (strcmp(name,"NumPart_Total")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,Nall); } else if (strcmp(name,"Redshift")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,redshift); } else if (strcmp(name,"NumFilesPerSnapshot")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,nfiles); } else if (strcmp(name,"Flag_Sfr")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,iFlagSfr); } else if (strcmp(name,"Flag_Cooling")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,iFlagCool); } else if (strcmp(name,"Flag_Feedback")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,iFlagFeedback); } else if (strcmp(name,"BoxSize")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,&BoxSize); } else if (strcmp(name,"HubbleParam")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,&HubbleParam); } else if (strcmp(name,"Omega0")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,&Omega0); } else if (strcmp(name,"OmegaLambda")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,&OmegaLambda); } else if (strcmp(name,"Flag_StellarAge")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,&iFlagStellarAge); } else if (strcmp(name,"Flag_Metals")==0) { status = H5Aread(attrib_id,H5T_NATIVE_INT,&iFlagMetals); } else if (strcmp(name,"Time_GYR")==0) { status = H5Aread(attrib_id,H5T_NATIVE_DOUBLE,time); } else { if (debug) printf("DEBUG: unknown attribute %s \n",name); } if (status==HDF5_error) { printf(" ERROR reading attribute %s \n",name); } status = H5Aclose(attrib_id); } status = H5Gclose(group_id); if (status == HDF5_error) { printf("ERROR closing Header data set \n"); *ierr = 3; return; } i = -1; int got = 0; while (!got && i < 5) { i++; sprintf(maindataset,"PartType%i",i); got = checkfordataset(file_id,maindataset); if (!got) { if (i==0) { printf(" WARNING: no gas particles found in GADGET HDF5 file\n"); } else { printf(" WARNING: \"%s\" dataset not found in GADGET HDF5 file\n",maindataset); } } } if (!got) { printf(" ERROR: No PartType dataset found in GADGET HDF5 file\n"); *ierr = 2; return; } if (debug) printf("DEBUG: main dataset= %s \n",maindataset); /* * Now we need to get the number of data columns in the file * (from the number of datasets in the "PartType0" group) */ #if H5_VERSION_GE(1,8,0) group_id = H5Gopen2(file_id,maindataset,H5P_DEFAULT); #else group_id = H5Gopen(file_id,maindataset); #endif if (group_id == HDF5_error) { printf("ERROR opening %s data set \n",maindataset); *ierr = 2; return; } hsize_t ndatasets; status = H5Gget_num_objs(group_id, &ndatasets); if (debug) printf("DEBUG: number of datasets = %i \n",(int)ndatasets); *ncol = 0; *ndim = 0; *ndimV = 0; int rank = 0; int j = 0; rank = get_rank_by_name(group_id,"ParticleIDs"); if (rank == 1) *igotids = 1; if (debug) printf("DEBUG: got IDs = %i\n",*igotids); strcpy(name,"Coordinates"); *ndim = get_rank_by_name(group_id,name); set_blocklabel(&j,ndim,name); *ncol = *ncol + *ndim; if (*ndim > 0) { j++; } else { printf("ERROR: %s dataset not found\n",name); *ierr = 3; return; } get_vel_info(group_id,namevels,ndimV); set_blocklabel(&j,ndimV,"Velocities"); *ncol = *ncol + *ndimV; if (*ndimV > 0) { j++; } else { printf("ERROR: Velocities not found in file\n"); *ierr = 3; return; } get_mass_info(group_id,namemass,&rank); if (rank == 0) { printf(" WARNING: Particle mass array not found in file\n"); } else { set_blocklabel(&j,&rank,"Masses"); *ncol = *ncol + rank; if (rank > 0) j++; } if (*ndim == 0 || *ndimV == 0) { printf("ERROR: got ndim = %i, ndimV = %i\n",*ndim,*ndimV); *ierr = 3; return; } int itype; for(i=0; i < (int)ndatasets; i++) { status = H5Gget_objname_by_idx(group_id, i, name, 256); itype = H5Gget_objtype_by_idx(group_id, i); /*if (debug) printf("DEBUG: checking %s\n",name);*/ /* Should not try to open it if object is not a dataset */ if (itype == H5G_DATASET) { #if H5_VERSION_GE(1,8,0) dataset_id = H5Dopen2(group_id,name,H5P_DEFAULT); #else dataset_id = H5Dopen(group_id,name); #endif dataspace_id = H5Dget_space(dataset_id); rank = get_rank(dataspace_id); if (strcmp(name,"ParticleIDs")&& strcmp(name,"Coordinates")&& strcmp(name,namevels)&& strcmp(name,namemass)) { if (debug) printf("DEBUG: storing %s x %i \n",name,rank); /* Send the dataset names back to Fortran * one by one, so they can be filled into * the array as appropriate */ set_blocklabel(&j,&rank,name); *ncol = *ncol + rank; if (rank > 0) j++; } else { if (debug) printf("DEBUG: ignoring %s \n",name); } status = H5Dclose(dataset_id); } else { if (debug) printf("DEBUG: skipping %s as it is not a dataset\n",name); } } status = H5Gclose(group_id); status = H5Fclose( file_id ); if (status == HDF5_error) { printf("ERROR closing file \n"); *ierr = 7; } if (debug) printf("DEBUG: finished header read \n"); } void read_gadget_hdf5_data(char *filename, int maxtypes, int npartoftype[maxtypes], double massoftype[maxtypes], int ncol, int isrequired[ncol], int i0[maxtypes], int *ierr) { hid_t file_id; hid_t group_id; herr_t status; herr_t HDF5_error = -1; char groupname[12]; char datasetname[256],namevels[256],namemass[256]; int i,ndimV,rank; int *id; if (debug) printf("DEBUG: re-opening %s \n",filename); file_id = H5Fopen(filename,H5F_ACC_RDONLY,H5P_DEFAULT); if (file_id == HDF5_error) { printf("ERROR re-opening %s \n",filename); *ierr = 1; return; } /* read dataset for each particle type present in dump file */ int itype,iobjtype; for (itype=0;itype 0) { /* If npartoftype[N] > 0 in header, look for dataset of the form PartTypeN */ sprintf(groupname,"PartType%i",itype); if (debug) printf("DEBUG: opening group %s\n",groupname); #if H5_VERSION_GE(1,8,0) group_id = H5Gopen2(file_id,groupname,H5P_DEFAULT); #else group_id = H5Gopen(file_id,groupname); #endif if (group_id == HDF5_error) { printf("ERROR opening %s group \n",groupname); *ierr = 2; } else { hsize_t ndatasets; status = H5Gget_num_objs(group_id, &ndatasets); if (debug) printf("DEBUG: number of datasets = %i \n",(int)ndatasets); /* get names of velocity and particle mass datasets */ get_vel_info(group_id,namevels,&ndimV); get_mass_info(group_id,namemass,&rank); /* read particle ID */ int k = 0; id = malloc(npartoftype[itype]*sizeof(int)); *ierr = read_gadgethdf5_dataset(group_id,"ParticleIDs",itype,maxtypes,npartoftype,i0,ncol,isrequired,id,&k); /* set all IDs to zero if not read */ if (*ierr != 0) printf("DEBUG: error from ID read = %i, rank = %i \n",*ierr,k); if (*ierr != 0 || k != 1) { for(k=0;k1) { rank = dims[1]; } else { rank = 1; } return rank; } /* * utility function to get dimensionality of a dataset */ int get_rank_by_name(hid_t group_id, char *name) { if (!checkfordataset(group_id,name)) { return 0; } herr_t HDF5_error = -1; #if H5_VERSION_GE(1,8,0) hid_t dataset_id = H5Dopen2(group_id,name,H5P_DEFAULT); #else hid_t dataset_id = H5Dopen(group_id,name); #endif if (dataset_id == HDF5_error) { printf("ERROR opening %s data set \n",name); return 0; } hid_t dataspace_id = H5Dget_space(dataset_id); int rank = get_rank(dataspace_id); H5Dclose(dataset_id); return rank; } /* * utility function to find velocity dataset and ndimV */ void get_vel_info(hid_t group_id, char *name, int *ndimV) { strcpy(name,"Velocities"); *ndimV = get_rank_by_name(group_id,name); /* If "Velocities" not found, try "Velocity" */ if (*ndimV <= 0) { strcpy(name,"Velocity"); *ndimV = get_rank_by_name(group_id,name); } return; } /* * utility function to find particle mass dataset and rank */ void get_mass_info(hid_t group_id, char *name, int *rank) { strcpy(name,"Masses"); *rank = get_rank_by_name(group_id,name); /* If "Masses" not found, try "Mass" */ if (*rank <= 0) { strcpy(name,"Mass"); *rank = get_rank_by_name(group_id,name); } return; } splash/src/read_data_gadget_jsb.f90000644 000770 000000 00000024113 11622211702 020127 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR OUTPUT FROM THE GADGET CODE ! AS MODIFIED BY JAMIE BOLTON ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,istart,nstepsread) use particle_data use params use labels use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation implicit none integer, intent(IN) :: istart integer, intent(OUT) :: nstepsread character(LEN=*), intent(IN) :: rootname character(LEN=LEN(rootname)+10) :: datfile integer, dimension(maxparttypes) :: npartoftypei integer, dimension(:), allocatable :: iamtemp integer :: i,itype,icol,ifile,idashpos,ierr integer :: index1,index2,indexstart,indexend,Nmassesdumped integer :: ncol_max,npart_max,nstep_max,ntoti logical :: iexist,reallocate real(doub_prec) :: timetemp real(doub_prec), dimension(6) :: Massoftype real, dimension(:), allocatable :: dattemp1 real, dimension(:,:), allocatable :: dattemp nstepsread = 0 if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: ',trim(datfile),' file not found ***' return endif ! !--set parameters which do not vary between timesteps ! ndim = 3 ndimV = 3 ncol_max = 15 ! 3 x pos, 3 x vel, utherm, rho, Ne, h, pmass ! !--read data from snapshots ! i = istart print "(1x,a)",'reading Jamie Bolton''s modified GADGET format' write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! open(11,ERR=81,file=datfile,status='old',form='unformatted') ! !--read header for this timestep ! read(11,ERR=70,end=80) npartoftypei,Massoftype,timetemp ntoti = int(sum(npartoftypei)) print*,'time : ',timetemp print*,'Npart (by type) : ',npartoftypei print*,'Mass (by type) : ',Massoftype print*,'N_gas : ',npartoftypei(1) print*,'N_total : ',ntoti ! !--if successfully read header, increment the nstepsread counter ! nstepsread = nstepsread + 1 ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if (ntoti.gt.maxpart) then reallocate = .true. npart_max = int(1.1*ntoti) endif if (i.ge.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncol_max+ncalc,maxcol)) endif ! !--copy header into header arrays ! npartoftype(:,i) = npartoftypei time(i) = real(timetemp) if (ntoti.gt.0) then if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(3,ntoti)) ! !--read positions of all particles ! print*,'positions ',ntoti read (11, iostat=ierr) dattemp(1:3,1:ntoti) if (ierr /= 0) then print "(a)",'error encountered whilst reading positions ' return else do icol=1,3 dat(1:ntoti,icol,i) = dattemp(icol,1:ntoti) enddo endif ! !--same for velocities ! print*,'velocities ',ntoti read (11, iostat=ierr) dattemp(1:3,1:ntoti) if (ierr /= 0) then print "(a)",'error encountered whilst reading velocities' else do icol=4,6 dat(1:ntoti,icol,i) = dattemp(icol-3,1:ntoti) enddo endif ! !--read particle ID ! print*,'particle ID ',ntoti if (allocated(iamtemp)) deallocate(iamtemp) allocate(iamtemp(npart_max)) read (11, end=66,ERR=73) iamtemp(1:ntoti) deallocate(iamtemp) ! !--read particle masses ! !--work out total number of masses dumped Nmassesdumped = 0 do itype = 1,6 if (abs(Massoftype(itype)).lt.1.e-8) then Nmassesdumped = Nmassesdumped + Npartoftype(itype,i) endif enddo print*,'particle masses ',Nmassesdumped !--read this number of entries if (allocated(dattemp1)) deallocate(dattemp1) allocate(dattemp1(Nmassesdumped)) if (Nmassesdumped.gt.0) then read(11,end=66,err=74) dattemp1(1:Nmassesdumped) endif !--now copy to the appropriate sections of the .dat array indexstart = 1 index1 = 1 do itype=1,6 if (Npartoftype(itype,i).ne.0) then index2 = index1 + Npartoftype(itype,i) -1 if (abs(Massoftype(itype)).lt.1.e-8) then ! masses dumped indexend = indexstart + Npartoftype(itype,i) - 1 print*,'read ',Npartoftype(itype,i),' masses for type ', & itype,index1,'->',index2,indexstart,'->',indexend dat(index1:index2,7,i) = dattemp1(indexstart:indexend) else ! masses not dumped print*,'setting masses for type ',itype,' = ', & real(Massoftype(itype)),index1,'->',index2 dat(index1:index2,7,i) = real(Massoftype(itype)) endif index1 = index2 + 1 indexstart = indexend + 1 endif enddo deallocate(dattemp1) ! !--read other quantities for rest of particles ! print*,'gas properties ',npartoftype(1,i) do icol=8,15 !!print*,icol read (11, end=66,ERR=78) dat(1:npartoftype(1,i),icol,i) ! !--for some reason the smoothing length output by GADGET is ! twice the usual SPH smoothing length ! if (icol.eq.15) then dat(1:npartoftype(1,i),icol,i) = 0.5*dat(1:npartoftype(1,i),icol,i) endif enddo else ntoti = 1 npartoftype(1,i) = 1 dat(:,:,i) = 0. endif !!ntot(i-1) = j-1 ! !--now memory has been allocated, set arrays which are constant for all time ! gamma = 5./3. goto 68 66 continue print*,'*** end of file reached in ',trim(datfile),' ***' ! timestep there but data incomplete goto 68 68 continue ! !--close data file and return ! close(unit=11) ncolumns = ncol_max print*,'ncolumns = ',ncolumns print*,'>> Finished reading: steps =',nstepsread-istart+1, & 'last step ntot =',sum(npartoftype(:,istart+nstepsread-1)) return ! !--errors ! 70 continue print*,' *** Error encountered while reading timestep header ***' print*,' Npartoftype = ',Npartoftype(:,i) print*,' Massoftype = ',Massoftype return 73 continue print*,' *** Error encountered while reading particle ID ***' return 74 continue print*,' *** Error encountered while reading particle masses ***' return 78 continue print*,' *** Error encountered while reading gas particle properties ***' return 80 continue print*,' *** data file empty, no steps read ***' return 81 continue print*,' *** Error: can''t open data file ***' return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ipmass = 7 irho = 9 ! location of rho in data array ipr = 0 iutherm = 8 ! thermal energy ih = 15 ! smoothing length ! !--set labels of the quantities read in ! label(ix(1:ndim)) = labelcoord(1:ndim,1) label(irho) = '\gr' label(iutherm) = 'u' label(10) = 'NHp' label(11) = 'NHep' label(12) = 'NHepp' label(13) = 'NH0' label(14) = 'NHe0' label(ih) = 'h' label(ipmass) = 'particle mass' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo !--set labels for each particle type ! ntypes = 6 labeltype(1) = 'gas' labeltype(2) = 'dark matter' labeltype(3) = 'boundary 1' labeltype(4) = 'boundary 2' labeltype(5) = 'star' labeltype(6) = 'sink / black hole' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2:6) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_h5part.f90000644 000770 000000 00000055653 11765511062 017270 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR DATA FORMATS WRITTEN WITH THE H5PART LIBRARY ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! H5SPLASH_NDIM=2 : number of spatial dimensions (overrides value inferred from data) ! H5SPLASH_HFAC=1.2 : factor to use in h= hfac*(m/rho)**(1/ndim) if h not present in data ! H5SPLASH_HSML=1.0 : value for global smoothing length if h not present in data ! H5SPLASH_TYPEID='MatID' : name of dataset containing the particle types ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- !--local module to store header information so we can later set the labels module h5partdataread use params use labels, only:lenlabel implicit none character(len=lenlabel), dimension(maxplot) :: datasetnames logical :: warn_labels = .true. end module h5partdataread subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,iamtype,npartoftype,time,gamma,maxpart,maxcol,maxstep use params use settings_data, only:ndim,ndimV,ncolumns,ncalc,debugmode,ntypes,iverbose use mem_allocation, only:alloc use iso_c_binding, only:c_double,c_int64_t use asciiutils, only:lcase use system_utils, only:renvironment use system_commands, only:get_environment use labels, only:ih,ipmass,irho,ix use h5part use h5partattrib, only:h5pt_readstepattrib,h5pt_getnstepattribs,h5pt_getstepattribinfo, & h5pt_readstepattrib_r8 use h5partdataread implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,ncolstep,nsteps,ncolsfile,icol,itypeidcol integer(kind=c_int64_t) :: nattrib,iattrib,nelem,idatasettype,k,icolsfile,ierr integer :: nprint,npart_max,nstep_max,maxcolsfile,itype integer, dimension(maxplot) :: iorder integer, dimension(maxparttypes) :: itypemap integer, dimension(:),allocatable :: itypefile logical :: iexist,typeiddefault integer(kind=c_int64_t) :: ifile,istep character(len=len(rootname)+5) :: dumpfile character(len=64) :: attribname character(len=lenlabel) :: datasetname,type_datasetname real(kind=doub_prec),dimension(1) :: dtime real :: hsmooth,hfac,dndim nstepsread = 0 nstep_max = 0 npart_max = maxpart dumpfile = trim(rootname) if (iverbose.ge.1) print "(1x,a)",'reading h5part format' print "(26('>'),1x,a,1x,26('<'))",trim(dumpfile) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions (0 means no particle coords) ! ndim = 0 ndimV = 0 j = indexstart nstepsread = 0 ! !--open the file and read the number of particles ! if (debugmode) print*,'DEBUG: opening '//trim(dumpfile) !ierr = h5pt_set_verbosity_level(6_8) ifile = h5pt_openr(trim(dumpfile)) if (ifile.le.0) then print "(a)",'*** ERROR opening '//trim(dumpfile)//' ***' return endif if (debugmode) print*,'DEBUG: file opened ok' ! !--get number of steps and particles in the file ! nsteps = int(h5pt_getnsteps(ifile)) if (debugmode) print*,'DEBUG: nsteps = ',nsteps ! !--read environment variable giving the name of the dataset ! containing the particle type ID ! give default value if this is not set ! call get_environment('H5SPLASH_TYPEID',type_datasetname) if (len_trim(type_datasetname).le.0) then typeiddefault = .true. type_datasetname = 'MatID' else typeiddefault = .false. endif ! !--read "header" information from all steps in file: ! get maximum number of particles for all steps in file ! and maximum number of columns (datasets) in file ! npart_max = 0 ncolstep = 0 maxcolsfile = 0 itypeidcol = 0 do istep=1,nsteps if (debugmode) print "(a,i2)",'DEBUG: setting step ',istep ierr = h5pt_setstep(ifile,istep) if (ierr.eq.0) then npart_max = max(npart_max,int(h5pt_getnpoints(ifile))) ncolsfile = int(h5pt_getndatasets(ifile)) icol = 0 if ((istep.eq.nsteps .and. ncolsfile.gt.0)) then do icolsfile=0,ncolsfile-1 !ierr = h5pt_getdatasetname(ifile,icol,datasetnames(icol+1)) if (debugmode) print*,'DEBUG: getting datasetinfo' ierr = h5pt_getdatasetinfo(ifile,icolsfile,datasetname,idatasettype,nelem) if (ierr.ne.0) then print "(a,i3)",' ERROR reading dataset name for column ',icolsfile+1 else ! !--read only columns which contain real or double precision data ! select case(idatasettype) case(H5PART_FLOAT32,H5PART_FLOAT64) icol = icol + 1 datasetnames(icol) = trim(adjustl(datasetname)) !print*,' data set info = ',icol,trim(datasetnames(icol)),idatasettype,nelem case(H5PART_INT32,H5PART_INT64) ! !--try to recognise the dataset giving the particle types ! if (trim(type_datasetname)==trim(datasetname) .or. trim(datasetname)=='Phase') then type_datasetname = trim(datasetname) if (itypeidcol.le.0) itypeidcol = int(icolsfile) + 1 if (iverbose.ge.1) print "(a)",' getting particle types from data set '//trim(type_datasetname) else if (iverbose.ge.1) print "(a)",' skipping data set '//trim(datasetname)// & ' of type '//h5part_type(int(idatasettype)) endif case default if (iverbose.ge.1) print "(a)",' skipping data set '//trim(datasetname)//& ' of type '//h5part_type(int(idatasettype)) end select endif enddo elseif (ncolsfile.le.0) then print*,'ERROR: number of datasets in step ',istep,' = ',ncolsfile endif ncolstep = max(ncolstep,icol) maxcolsfile = max(ncolsfile,maxcolsfile) else print "(a,i3)",' ERROR, could not choose step ',istep return endif enddo nprint = npart_max ! !--warn if no particle type data has been read ! if (itypeidcol.le.0) then if (typeiddefault) then if (iverbose.ge.1) print "(a)",' Particle type dataset not found in file: Use H5SPLASH_TYPEID to give dataset name' else print "(a)",' WARNING: Particle type dataset '//trim(type_datasetname)//' (from H5SPLASH_TYPEID) not found in file ' endif endif ! !--call the set_labels routine to get the initial location of coords, smoothing length etc. given dataset labels ! warn_labels = .false. call set_labels() warn_labels = .true. ! !--set default ordering of columns ! do i=1,size(iorder) iorder(i) = i enddo ! !--if coordinates are not in the first 3 columns, shift data so that they are ! if (ndim.gt.0 .and. ix(1).ne.1) then do i=1,ndim iorder(ix(i)) = i enddo !--preserve the order of things after the coordinates icol = ndim do i=ix(1)+1,ncolstep if (.not.any(ix(1:ndim).eq.i)) then icol = icol + 1 iorder(i) = icol endif enddo !--shuffle things before the coordinates to the end do i=1,ix(1)-1 if (.not.any(ix(1:ndim).eq.i)) then icol = icol + 1 iorder(i) = icol endif enddo endif if (debugmode) print*,'DEBUG: iorder = ',iorder ! !--if smoothing length has not been set, look for an environment variable ! giving the smoothing length value ! hsmooth = -1. if (ih.eq.0) then hsmooth = renvironment('H5SPLASH_HSML',errval=-1.) if (hsmooth.ge.0.) then ncolstep = ncolstep + 1 elseif (ipmass.gt.0. .and. irho.gt.0 .and. ndim.gt.0) then hfac = renvironment('H5SPLASH_HFAC',errval=-1.) if (hfac.gt.0.) then if (iverbose.ge.1) print "(/,a,f6.2,a,/)",' Setting smoothing length using h = ',hfac,& '*(m/rho)**(1/ndim) (from H5SPLASH_HFAC setting)' else hfac = 1.2 if (iverbose.ge.1) then print "(/,a)",' WARNING: Smoothing length not found in data: using h = hfac*(m/rho)**(1/ndim)' print "(a)", ' (hfac = 1.2 by default, set H5SPLASH_HFAC to change this)' print "(a,/)",' (set constant h with H5SPLASH_HSML to give a global value)' endif endif ncolstep = ncolstep + 1 else if (iverbose.ge.1) print "(/,a,/)",' WARNING: Smoothing length not found in data: Set H5SPLASH_HSML to give a global value' endif endif ncolumns = ncolstep ! !--allocate memory for all data in the file ! nstep_max = max(nsteps,indexstart,1,maxstep) npart_max = max(maxpart,npart_max) if (.not.allocated(dat) .or. (nprint.gt.maxpart) .or. (ncolstep+ncalc).gt.maxcol) then if (itypeidcol.gt.0) then call alloc(npart_max,nstep_max,ncolstep+ncalc,mixedtypes=.true.) else call alloc(npart_max,nstep_max,ncolstep+ncalc) endif endif ! !--now read the timestep data in the dumpfile (for all steps) ! istep = 0 do j=indexstart,indexstart+nsteps-1 istep = istep + 1 print "(a,i4,a,i10)",' step ',istep,': ntotal = ',nprint ierr = h5pt_setstep(ifile,istep) nprint = int(h5pt_getnpoints(ifile)) ! use int() to avoid compiler warning about type conversion ! !--get the time from the step attributes ! nattrib = h5pt_getnstepattribs(ifile) if (nattrib.gt.0) then do iattrib=0,nattrib-1 ! yes, it's written in C ierr = h5pt_getstepattribinfo(ifile,iattrib,attribname,nelem) !print*,' step attribute '//trim(attribname),' nelem = ',nelem if (ierr.eq.0) then ! !--match anything that looks vaguely like the time ! if (nelem.eq.1 .and. (index(lcase(attribname),'time').ne.0 & .or. index(lcase(attribname),'t ').ne.0)) then ierr = h5pt_readstepattrib_r8(ifile,attribname,dtime) if (ierr.eq.0) then time(j) = real(dtime(1)) print "(12x,a,es10.3,a)",'time = ',time(j),' (from '//trim(attribname)//')' else print "(a,i2,a)",' ERROR could not read time from step ',istep,' (from '//trim(attribname)//')' endif ! !--match gamma if possible ! elseif (nelem.eq.1 .and. (index(lcase(attribname),'gamma').ne.0 & .or. index(lcase(attribname),'gam ').ne.0)) then ierr = h5pt_readstepattrib_r8(ifile,attribname,dtime) if (ierr.eq.0) then gamma(j) = real(dtime(1)) print "(12x,a,es10.3,a)",'gamma = ',gamma(j),' (from '//trim(attribname)//')' else print "(a,i2,a)",' ERROR could not read gamma from step ',istep,' (from '//trim(attribname)//')' endif else print "(a)",' unknown attribute '//trim(attribname) endif else print "(a,i3,a,i2)",' ERROR reading attribute info for step ',istep,', attribute #',iattrib endif enddo endif ! !--now read the data for this step ! icol = 0 do k=0,maxcolsfile-1 ierr = h5pt_getdatasetinfo(ifile,k,datasetname,idatasettype,nelem) select case(idatasettype) case(H5PART_FLOAT32,H5PART_FLOAT64) icol = icol + 1 datasetnames(iorder(icol)) = trim(datasetname) if (debugmode) print "(a,i3,a,i3)",'DEBUG: reading data set ',icol,& ': '//trim(datasetnames(iorder(icol)))//' into column ',iorder(icol) ierr = h5pt_readdata(ifile,datasetnames(iorder(icol)),dat(:,iorder(icol),j)) if (ierr.ne.0) print "(a)",' ERROR reading dataset '//trim(datasetnames(iorder(icol))) case default if (debugmode) print "(a)",' skipping data set '//trim(datasetname)//' of type '//lcase(h5part_type(int(idatasettype))) end select enddo ! !--read the particle types for this step from the typeid dataset (specified from the type_datasetname setting) ! npartoftype(:,j) = 0 if (itypeidcol.gt.0 .and. size(iamtype(:,1)).gt.1) then if (debugmode) print "(a)",'DEBUG: reading particle types from '//trim(type_datasetname) ! !--allocate temporary memory ! if (allocated(itypefile)) deallocate(itypefile) allocate(itypefile(nprint),stat=ierr) if (ierr.ne.0) stop 'ERROR allocating temporary memory for particle types' ! !--read type array from file ! ierr = h5pt_readdata(ifile,trim(type_datasetname),itypefile(:)) if (ierr.ne.0) then print "(a)",' ERROR reading dataset '//trim(type_datasetname) else ! !--work out the number of unique particle types ! and map these into SPLASH particle types (1->maxtypes) ! if (j.eq.1 .and. istep.eq.1) then ntypes = 1 itypemap(1) = minval(itypefile) endif do i=1,nprint !--increase the number of particle types if a particle of new type is found if (.not.any(itypemap(1:ntypes).eq.itypefile(i))) then ntypes = ntypes + 1 if (ntypes.le.size(itypemap)) then itypemap(ntypes) = itypefile(i) npartoftype(ntypes,j) = npartoftype(ntypes,j) + 1 iamtype(i,j) = ntypes endif else do itype=1,ntypes if (itypefile(i).eq.itypemap(itype)) then npartoftype(itype,j) = npartoftype(itype,j) + 1 iamtype(i,j) = itype endif enddo endif enddo if (nprint.lt.1e6) then print "(12x,a,10(i5,1x))",'npart (by type) = ',npartoftype(1:ntypes,j) else print "(12x,a,10(i10,1x))",'npart (by type) = ',npartoftype(1:ntypes,j) endif ! !--warn if the number of types exceeds the current limit ! if (ntypes.gt.maxparttypes) & print "(/,2(a,i2),a/)", & ' WARNING: too many particle types in dataset '//trim(type_datasetname)// & ' (got ',ntypes,': maximum is currently ',maxparttypes,')' endif ! !--clean up ! if (allocated(itypefile)) deallocate(itypefile) else !--only one particle type ntypes = 1 npartoftype(1,j) = nprint endif ! !--reset the labels now that the columns have been read in the correct order ! if (j.eq.indexstart) then ! set labels based on the first step read from the file warn_labels = .false. call set_labels() warn_labels = .true. endif ! !--if smoothing length set via environment variable, fill the extra column with the smoothing length value ! if (ih.eq.0) then if (hsmooth.ge.0.) then datasetnames(ncolstep) = 'h' ih = ncolstep dat(:,ih,j) = hsmooth elseif (ipmass.gt.0 .and. irho.gt.0 .and. ndim.gt.0) then ih = ncolstep datasetnames(ncolstep) = 'h' dndim = 1./ndim where (dat(:,irho,j).gt.tiny(0.)) dat(:,ih,j) = hfac*(dat(:,ipmass,j)/dat(:,irho,j))**dndim elsewhere dat(:,ih,j) = 0. end where endif endif ! read(iunit,*,iostat=ierr) (dat(i,icol,j),icol = 1,ncolstep) nstepsread = nstepsread + 1 enddo ierr = h5pt_close(ifile) return end subroutine read_data !!------------------------------------------------------------------- !! set labels for each column of data !! !! read these from a file called 'columns' in the current directory !! then take sensible guesses as to which quantities are which !! from the column labels !! !!------------------------------------------------------------------- subroutine set_labels() use asciiutils, only:lcase use labels, only:label,ix,irho,ipmass,ih,iutherm, & ipr,ivx,iBfirst,iamvec,labelvec,lenlabel !,labeltype !use params, only:maxparttypes use settings_data, only:ndim,ndimV,UseTypeInRenderings,iverbose use geometry, only:labelcoord use system_utils, only:ienvironment use h5partdataread implicit none integer :: i,ndimset,ndim_max character(len=lenlabel) :: labeli ndim = 0 ndimV = 0 ndimset = ienvironment('H5SPLASH_NDIM',errval=-1) ndim_max = 3 if (ndimset.ge.0) ndim_max = ndimset irho = 0 ih = 0 ipmass = 0 do i=1,size(datasetnames) if (len_trim(datasetnames(i)).gt.0) then label(i) = trim(datasetnames(i)) else label(i) = ' ' endif !--now try to recognise the column based on the dataset name ! compare all strings in lower case, trimmed and with no preceding spaces ! labeli = trim(adjustl(lcase(label(i)))) if (index(labeli,'coords').ne.0 .and. index(labeli,'_').ne.0 .or. labeli(1:1).eq.'x') then if (ndim.lt.ndim_max) then ndim = ndim + 1 ix(ndim) = i label(ix(ndim)) = labelcoord(ndim,1) endif elseif (index(labeli,'vel_').ne.0 .and. (ivx.eq.0 .or. i.le.ivx+ndim)) then if (ndimV.lt.3) ndimV = ndimV + 1 if (index(labeli,'_0').ne.0) ivx = i elseif (index(labeli,'dens').ne.0 .and. irho.eq.0) then irho = i elseif (index(labeli,'mass').ne.0 .and. ipmass.eq.0) then ipmass = i elseif (ih.eq.0 .and. (index(labeli,'smoothing').ne.0 .or. labeli(1:1).eq.'h')) then ih = i elseif (labeli(1:1).eq.'u') then iutherm = i !--identify vector quantities based on _0, _1, _2 labelling elseif (index(labeli,'_0').ne.0) then !print*,'labelling ',labeli(1:index(labeli,'_0')-1),' as vector, column ',i iamvec(i) = i labelvec(i) = labeli(1:index(labeli,'_0')-1) elseif (index(labeli,'_1').ne.0 .and. i.gt.1 .and. ndim.ge.2) then if (iamvec(i-1).gt.0) then iamvec(i) = i-1 labelvec(i) = labelvec(i-1) endif elseif (index(labeli,'_2').ne.0 .and. i.gt.2 .and. ndim.ge.3) then if (iamvec(i-2).gt.0) then iamvec(i) = i-2 labelvec(i) = labelvec(i-2) endif endif enddo if (ndim.lt.1) ndimV = 0 if (ndimV.gt.ndim) ndimV = ndim if (warn_labels .and. iverbose.ge.1) then if (ndimset.gt.0) then if (ndim.ne.ndimset) then print "(2(a,i1))",' WARNING: ndim = ',ndimset, & ' from H5SPLASH_NDIM setting but coords not found in data: using ndim = ',ndim else print "(a,i1,a)",' Assuming number of dimensions = ',ndim,' from H5SPLASH_NDIM setting' endif else if (ndim.gt.0) print "(a,i1,a)",' Assuming number of dimensions = ',ndim,' (set H5SPLASH_NDIM to override)' endif if (ndimV.gt.0) print "(a,i1)",' Assuming vectors have dimension = ',ndimV if (irho.gt.0) print "(a,i2)",' Assuming density in column ',irho if (ipmass.gt.0) print "(a,i2)",' Assuming particle mass in column ',ipmass if (ih.gt.0) print "(a,i2)",' Assuming smoothing length in column ',ih if (iutherm.gt.0) print "(a,i2)",' Assuming thermal energy in column ',iutherm if (ipr.gt.0) print "(a,i2)",' Assuming pressure in column ',ipr if (ivx.gt.0) then if (ndimV.gt.1) then print "(a,i2,a,i2)",' Assuming velocity in columns ',ivx,' to ',ivx+ndimV-1 else print "(a,i2)",' Assuming velocity in column ',ivx endif endif if (ndim.eq.0 .or. irho.eq.0 .or. ipmass.eq.0 .or. ih.eq.0) then print "(4(/,a))",' NOTE: Rendering capabilities cannot be enabled', & ' until positions of density, smoothing length and particle', & ' mass are known (for the h5part read this means labelling ', & ' the dataset appropriately)' endif ! !--assign vectors (don't do this on the first call otherwise it will remain assigned to the wrong columns) ! if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' endif if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = ivx labelvec(iBfirst:iBfirst+ndimV-1) = 'B' endif ! !--set labels for vector quantities ! do i=1,size(datasetnames) if (iamvec(i).ne.0) then label(i) = trim(labelvec(iamvec(i)))//'_'//trim(labelcoord(i-iamvec(i)+1,1)) endif enddo endif ! !--set labels for each particle type ! (for h5part this is done in the read_data routine) ! !ntypes = 1 !!maxparttypes ! labeltype(1) = 'gas' ! labeltype(2) = 'gas' ! labeltype(3) = 'gas' ! labeltype(4) = 'gas' UseTypeInRenderings(:) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_jjm.f90000644 000770 000000 00000014326 12144100725 016625 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR JOE'S 2D SPH CODE ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! iam(maxpart,maxstep): integer identification of particle type ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns use mem_allocation implicit none integer, intent(IN) :: indexstart integer, intent(OUT) :: nstepsread character(LEN=*), intent(IN) :: rootname integer :: i,j,ifile,ierr integer :: istep,nprint,npart_max,nstep_max,icol logical :: iexist character(LEN=LEN(rootname)+4) :: dumpfile real :: timei,dti,hi nstepsread = 0 nstep_max = 0 npart_max = maxpart ifile = 1 dumpfile = trim(rootname) ! if (index(dumpfile,'.plt').eq.0) dumpfile = trim(rootname)//'.plt' ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: ',trim(dumpfile),' file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 2 ndimV = 2 ncolumns = 7 ! number of columns in file ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,2) j = indexstart nstepsread = 0 print "(1x,a)",'reading Joe Monaghan ascii format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='formatted') if (ierr /= 0) then print*,'*** ERROR OPENING ',trim(dumpfile),' ***' else ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,*,end=55,iostat=ierr) istep,nprint,timei,dti print*,'first time = ',timei,nprint if (.not.allocated(dat) .or. (nprint.gt.npart_max)) then npart_max = max(npart_max,INT(1.1*(nprint))) call alloc(npart_max,nstep_max,ncolumns) endif rewind(15) endif if (ierr /= 0) then print*,'*** ERROR READING TIMESTEP HEADER ***' else oversteps: do ! !--loop over the timesteps in this file ! npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,2*j,maxcol) endif ! !--now read the timestep data in the dumpfile ! read(15,*,end=55,iostat=ierr) istep,nprint,hi,time(j),dti do i=1,nprint read(15,*,end=55,iostat=ierr) (dat(i,icol,j),icol = 1,ncolumns) enddo masstype(1,j) = 1. if (ierr /= 0) then print "(a)",'|*** ERROR READING TIMESTEP ***' return else nstepsread = nstepsread + 1 endif npartoftype(:,j) = 0 npartoftype(1,j) = nprint print*,j,' time = ',time(j) gamma(j) = 1.666666666667 j = j + 1 enddo oversteps endif 55 continue ! !--reached end of file ! close(15) print*,'nstepsread = ',nstepsread print*,'>> end of dump file: nsteps =',j-1,'ntot = ',npartoftype(1,j-1),'nptmass=',npartoftype(2,j-1) return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo label(ix(1:ndim)) = labelcoord(1:ndim,1) ivx = ndim+1 ipr = ndim+ndimV+2 ih = ndim+ndimV+3 ! smoothing length label(ih) = 'h' irho = ndim+ndimV+1 ! location of rho in data array label(irho) = 'density' if (ipr.gt.0) label(ipr) = 'pressure' iutherm = 0 ! thermal energy ! label(iutherm) = 'u' ipmass = 0 ! particle mass ! label(ipmass) = 'particle mass' iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 1 !!maxparttypes labeltype(1) = 'gas' UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_jjm_multiphase.f90000644 000770 000000 00000016755 11622211702 021066 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR JOE'S 2D SPH CODE ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! iam(maxpart,maxstep): integer identification of particle type ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns use mem_allocation implicit none integer, intent(IN) :: indexstart integer, intent(OUT) :: nstepsread character(LEN=*), intent(IN) :: rootname integer :: i,j,ifile,ierr,npart,nweird,nbnd,nmud integer :: istep,nprint,npart_max,nstep_max,icol,ncolstep logical :: iexist character(LEN=LEN(rootname)+4) :: dumpfile real :: timei,dti,hi,pmass,totmass,rhozero nstepsread = 0 nstep_max = 0 npart_max = maxpart ifile = 1 dumpfile = trim(rootname) if (index(dumpfile,'.plt').eq.0) dumpfile = trim(rootname)//'.plt' ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: ',trim(dumpfile),' file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 2 ndimV = 2 ncolstep = 8 ncolumns = 8 ! number of columns in file ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,2) j = indexstart nstepsread = 0 print "(1x,a)",'reading Joe Monaghan''s multiphase code format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='formatted') if (ierr /= 0) then print*,'*** ERROR OPENING ',trim(dumpfile),' ***' else ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,*,end=55,iostat=ierr) istep,nprint,hi print*,'first time = ',hi,' npart = ',nprint if (.not.allocated(dat) .or. (nprint.gt.npart_max)) then npart_max = max(npart_max,INT(1.1*(nprint))) call alloc(npart_max,nstep_max,ncolumns,mixedtypes=.true.) endif rewind(15) endif if (ierr /= 0) then print*,'*** ERROR READING TIMESTEP HEADER ***' else oversteps: do ! !--loop over the timesteps in this file ! npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,2*j,maxcol,mixedtypes=.true.) endif ! !--now read the timestep data in the dumpfile ! read(15,*,end=55,iostat=ierr) istep,nprint,hi,timei,dti ! read(15,*) nbnd = 0 npart = 0 nweird = 0 nmud = 0 do i=1,nprint read(15,*,end=55,iostat=ierr) (dat(i,icol,j),icol = 1,ncolstep),iamtype(i,j) select case(iamtype(i,j)) case(0) nbnd = nbnd + 1 iamtype(i,j) = 3 case(1) npart = npart + 1 iamtype(i,j) = 1 case(2) nmud = nmud + 1 iamtype(i,j) = 2 case default nweird = nweird + 1 iamtype(i,j) = 4 end select !print*,i,(dat(i,icol,j),icol = 1,ncolstep),iamtype(i,j) !--make a fake column for mass enddo 600 format(2x,7(e12.5),1(i5)) time(j) = timei if (ierr /= 0) then print*,'got to ',i,' step ',j print "(a)",'|*** ERROR READING TIMESTEP ***' return else nstepsread = nstepsread + 1 endif npartoftype(:,j) = 0 npartoftype(1,j) = npart npartoftype(2,j) = nmud npartoftype(3,j) = nbnd npartoftype(4,j) = nweird print*,'nwater=',npart,' nmud=',nmud,' nbnd=',nbnd if (nweird.gt.0) print*,' WARNING: ',nweird,' particles of unknown type' print*,j,' time = ',time(j) gamma(j) = 1.666666666667 j = j + 1 enddo oversteps endif 55 continue ! !--reached end of file ! close(15) print*,'nstepsread = ',nstepsread print*,'>> end of dump file: nsteps =',j-1,'nfluid = ',npartoftype(1,j-1),'nbound=',npartoftype(2,j-1) return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo label(ix(1:ndim)) = labelcoord(1:ndim,1) ivx = ndim+1 ipr = ndim+ndimV+2 label(ipr) = 'pressure' ih = ndim+ndimV+3 ! smoothing length label(ih) = 'h' irho = ndim+ndimV+1 ! location of rho in data array label(irho) = 'density' iutherm = 0 ! thermal energy ! label(iutherm) = 'u' ipmass = 8 ! particle mass label(ipmass) = 'particle mass' iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 4 !!maxparttypes labeltype(1) = 'fluid' labeltype(2) = 'mud' labeltype(3) = 'boundary' labeltype(4) = 'unknown' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. UseTypeInRenderings(4) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_jules.f90000644 000770 000000 00000017614 12022224017 017166 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR JOE'S 2D SPH CODE ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! iam(maxpart,maxstep): integer identification of particle type ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns use mem_allocation implicit none integer, intent(IN) :: indexstart integer, intent(OUT) :: nstepsread character(LEN=*), intent(IN) :: rootname integer :: i,j,ifile,ierr,npart,nweird,nbnd,nother,n integer :: istep,nprint,npart_max,nstep_max,icol,ncolstep integer :: iambodi,iamskini,imovei logical :: iexist character(LEN=LEN(rootname)+4) :: dumpfile real :: timei,dti,hi,pmass,totmass,rhozero nstepsread = 0 nstep_max = 0 npart_max = maxpart ifile = 1 dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: ',trim(dumpfile),' file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 2 ndimV = 2 ncolstep = 17 ncolumns = 18 ! number of columns in file ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,2) j = indexstart nstepsread = 0 write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='formatted') if (ierr /= 0) then print*,'*** ERROR OPENING ',trim(dumpfile),' ***' else ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,*,end=55,iostat=ierr) timei,istep,n,nprint,hi,dti print*,'time = ',timei,' step = ',istep,' n = ',n,' ng = ',nprint print*,'first time = ',hi,' npart = ',nprint if (.not.allocated(dat) .or. (nprint.gt.npart_max)) then npart_max = max(npart_max,INT(1.1*(nprint))) call alloc(npart_max,nstep_max,ncolumns,mixedtypes=.true.) endif rewind(15) endif if (ierr /= 0) then print*,'*** ERROR READING TIMESTEP HEADER ***' else !oversteps: do ! !--loop over the timesteps in this file ! npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+1,maxcol,mixedtypes=.true.) endif ! !--now read the timestep data in the dumpfile ! read(15,*,end=55,iostat=ierr) timei,istep,n,nprint,hi,dti rhozero = 1000. totmass = 3.*4.8*rhozero pmass = totmass/real(nprint) print*,' assuming total mass = ',totmass,' (rhozero = ',rhozero,')' print*,' gives particle mass = ',pmass nbnd = 0 npart = 0 nother = 0 nweird = 0 do i=1,nprint read(15,*,end=55,iostat=ierr) (dat(i,icol,j),icol = 1,7) read(15,*,end=55,iostat=ierr) (dat(i,icol,j),icol = 8,13) read(15,*,end=55,iostat=ierr) iamtype(i,j),iambodi,iamskini,imovei read(15,*,end=55,iostat=ierr) (dat(i,icol,j),icol = 14,17) select case(iamtype(i,j)) case(0) nbnd = nbnd + 1 iamtype(i,j) = 2 case(1) npart = npart + 1 iamtype(i,j) = 1 case(2) nother = nother + 1 iamtype(i,j) = 3 case default print*,'iamtype = ',iamtype(i,j) nweird = nweird + 1 iamtype(i,j) = 4 end select !print*,i,(dat(i,icol,j),icol = 1,ncolstep),iamtype(i,j) !--make a fake column for mass dat(i,18,j) = pmass enddo time(j) = timei if (ierr /= 0) then print*,'got to ',i,' step ',j print "(a)",'|*** ERROR READING TIMESTEP ***' return else nstepsread = nstepsread + 1 endif npartoftype(:,j) = 0 npartoftype(1,j) = npart npartoftype(2,j) = nbnd npartoftype(3,j) = nother npartoftype(4,j) = nweird if (nweird.gt.0) print*,' WARNING: ',nweird,' particles of unknown type' print*,j,' time = ',time(j) gamma(j) = 1.666666666667 j = j + 1 !enddo oversteps endif 55 continue ! !--reached end of file ! close(15) print*,'nstepsread = ',nstepsread print*,'>> end of dump file: nsteps =',j-1,'nfluid = ',npartoftype(1,j-1),'nbound=',npartoftype(2,j-1) return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo label(ix(1:ndim)) = labelcoord(1:ndim,1) ivx = ndim+1 iamvec(5:6) = 5 labelvec(5:6) = 'f' irho = 7 label(7) = 'density' ipr = 8 label(8) = 'pressure' label(9) = 'vorticity' label(10) = 'pvisc' label(11) = 'div v' label(12) = 'hp' ih = 12 ! smoothing length label(13) = 'concentration' label(14) = 'diffc' label(15) = 'pmix' iamvec(16:17) = 16 labelvec(16:17) = 'vhat' ipmass = 18 ! particle mass label(ipmass) = 'particle mass' iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 4 !!maxparttypes labeltype(1) = 'fluid' labeltype(2) = 'boundary' labeltype(3) = 'other' labeltype(4) = 'unknown' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. UseTypeInRenderings(3) = .true. UseTypeInRenderings(4) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_kitp.f90000644 000770 000000 00000013137 11622211702 017011 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT IN KITP FORMAT ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,time,npartoftype,gamma,maxpart,maxcol use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation, only:alloc implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,ierr integer :: np integer :: ncol,nread,nstep_max logical :: iexist character(len=len(rootname)) :: dumpfile real :: wp,timei nstepsread = 0 nstep_max = 0 dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 !--number of columns to read from file ncol = 7 ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 print "(1x,a)",'reading KITP SPH format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,file=dumpfile,status='old',form='unformatted',iostat=ierr) if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return else ! !--read the number of particles in the header and allocate memory ! read(15,iostat=ierr) np,wp timei = 0. print "(a,f10.2,a,i10,a,f10.4)",' time: ',timei,' npart: ',np,' wp: ',wp !--barf if stupid values read if (np.le.0 .or. np.gt.1e10) then print "(a)",' *** ERRORS IN TIMESTEP HEADER: WRONG ENDIAN? ***' close(15) return elseif (ierr /= 0) then print "(a)",'*** WARNING: ERRORS READING HEADER ***' close(15) return endif ncolumns = ncol if (.not.allocated(dat) .or. np.gt.maxpart) then call alloc(np,nstep_max,ncol+ncalc) endif ! !--now read the timestep data in the dumpfile ! dat(:,:,j) = 0. time(j) = 0. nread = 0 do i=1,ncol read(15,end=44,iostat=ierr) dat(1:np,i,j) if (ierr /= 0) print*,' error reading column ',i nread = nread + 1 enddo 44 continue if (nread.lt.ncol) then print "(a)",' WARNING: END OF FILE: read to column ',nread endif nstepsread = nstepsread + 1 npartoftype(1,j) = np gamma(j) = 1.666666666667 j = j + 1 endif close(15) if (allocated(npartoftype)) then print*,'>> end of dump file: nsteps =',j-1,'ntot = ',sum(npartoftype(:,j-1)) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,labelvec,labeltype,iamvec,& ix,ivx,ih,irho,iutherm,ipmass use settings_data, only:ndim,ndimV,ntypes,UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 irho = 7 label(ix(1:ndim)) = labelcoord(1:ndim,1) if (ivx.ne.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = labelvec(ivx)//'\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 1 labeltype(1) = 'gas' UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_maddison.f90000644 000770 000000 00000023612 12240317516 017646 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! the data is stored in the global array dat ! ! THIS VERSION FOR SARAH MADDISON+MARK HUTCHISON'S DUSTY-SPH CODE ! -> Now automatically handles single/double precision ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:npartoftype,time,gamma,dat,maxpart,maxstep,maxcol,iamtype use params use filenames, only:nfiles use settings_data, only:ndim,ndimV,ncolumns,ncalc,iverbose,debugmode use mem_allocation, only:alloc use system_utils, only:lenvironment implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+4) :: datfile integer :: i,icol,ierr,iunit,ilen,j,ilast integer :: ncol_max,ndim_max,npart_max,ndimV_max,nstep_max integer :: ncolstep,np,istep,nstepsinfile logical :: reallocate,finished integer :: norigin,ncr,istart,iout,nmlmax,index,ratio integer :: dimsw,nfluid,ipart real(sing_prec) :: h,xlen,yzlen,xfact,hrej,rejfac real(sing_prec) :: gammai,alpha,beta,pspred real(sing_prec) :: gconst,zeta,amfac,frac,tin,vinit real(sing_prec) :: Cd,psep,kdrag,tcoeff,Rd real(sing_prec) :: a1,a2,a3,vdlfrac,vgrfrac,dustden,gasden,D2G_ratio real(sing_prec) :: csmax2,omega real(sing_prec) :: timei,dt real(sing_prec), dimension(:), allocatable :: dattemp integer, dimension(:), allocatable :: iam real :: dum iunit = 11 ! file unit number ndim_max = 1 ndimV_max = 1 nstepsread = 0 if (rootname(1:1).ne.' ') then datfile = trim(rootname) !print*,'rootname = ',rootname else print*,' **** no data read **** ' return endif if (iverbose.ge.1) print "(1x,a)",'reading Maddison/Hutchison format' write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! open(unit=iunit,iostat=ierr,file=datfile,status='old',form='unformatted') if (ierr /= 0) then print*,' *** Error opening '//trim(datfile)//' ***' return endif ! !--read first header line ! read(iunit,iostat=ierr,end=80) norigin,ncr,istart,iout,nmlmax,index,ratio read(iunit,iostat=ierr,end=80) h,xlen,yzlen,xfact,hrej,rejfac, & gammai,alpha,beta,pspred, & gconst,zeta,amfac,frac,tin,vinit, & Cd,psep,kdrag,tcoeff,Rd, & a1,a2,a3, & vdlfrac,vgrfrac, & dustden,gasden,D2G_ratio, & csmax2, omega read(iunit,iostat=ierr,end=80) ndim,nfluid print*,'dimsw = ',ndim,' nfluid = ',nfluid,' h/psep = ',h/psep ncolstep = 14 ! number of columns in the file ndimV = 3 ! always have 3 velocity components written to file print "(a,i2,a,f8.4)",' ncolumns: ',ncolstep,' gamma: ',gammai ! !--check for basic errors in first line ! if (ierr /= 0 .or. ncr < 0 .or. istart < 0 & .or. iout < 0 .or. nmlmax < 0 .or. index < 0 .or. ratio < 0) then print "(a)",' *** Error reading header ***' print*,' norigin = ',norigin,' ncr = ',ncr,' istart =',istart,' iout = ',iout print*,' nmlmax = ',nmlmax,' index = ',index,' ratio =',ratio close(iunit) return endif ! !--check for errors in 3rd line ! if (ndim > 3 .or. ndimV > 3) then print*,'*** error in header: ndim or ndimV in file > 3' ndim = 3 ndimV = 3 close(iunit) return endif nstepsinfile = nmlmax/iout nstep_max = max(nstepsinfile,maxstep) nstepsread = 0 npart_max = maxpart ncol_max = ncolstep ! !--read first step ! over_steps: do i = indexstart,indexstart + nstepsinfile - 1 ! !--read header line for this timestep ! read(iunit,iostat=ierr,end=80) np,dt,timei,ipart if (ierr /= 0 .or. np < 0 .or. np > 1.e9 .or. ipart > np) then print*,'n = ',np,' dt = ',dt,' time = ',timei,' i = ',ipart print*,'*** error reading timestep header ***' close(iunit) return endif ! !--allocate memory for data arrays ! nstep_max = max(nstep_max,nfiles,maxstep,indexstart) npart_max = max(np,maxpart) if (.not.allocated(dat) .or. np > maxpart & .or. nstep_max > maxstep .or. ncol_max > maxcol) then call alloc(npart_max,nstep_max,ncolstep+ncalc,mixedtypes=.true.) endif ! !--now that memory is allocated, put header quantities -> splash quantities ! time(i) = timei gamma(i) = gammai npartoftype(1,i) = np if (iverbose.ge.1) then print "(a,i5,a,f8.4,a,i8,a,f8.4)",' step:',i,' time:',time(i),' npart:',np,' dt:',dt else print "(a,i5,a,f8.4,a,i8,a,i8)",' step:',i,' time:',time(i),' npart:',np endif if (ncolstep.ne.ncol_max) then print*,'*** Warning number of columns not equal for timesteps' ncolumns = ncolstep if (iverbose.ge.1) print*,'ncolumns = ',ncolumns,ncol_max if (ncolumns.gt.ncol_max) ncol_max = ncolumns endif ncolumns = ncolstep nstepsread = nstepsread + 1 ! !--read data for this timestep ! if (kind(dat).ne.kind(dattemp)) then if (debugmode) print*,' converting kind from ',kind(dattemp),' to ',kind(dat) allocate(dattemp(np)) !--convert precision do icol=1,ncolstep-1 ! all columns except h read(iunit,iostat=ierr,end=80) dattemp(1:np) dat(1:np,icol,i) = real(dattemp) enddo deallocate(dattemp) else !--read directly into dat array if data types are the same do icol=1,ncolstep-1 ! all columns except h read(iunit,iostat=ierr,end=80) dat(1:np,icol,i) enddo endif !--add column for the smoothing length dat(1:np,ncolstep,i) = h npartoftype(:,i) = 0 allocate(iam(np)) read(iunit,iostat=ierr,end=80) iam(1:np) do j=1,np select case(iam(j)) case(1) npartoftype(1,i) = npartoftype(1,i) + 1 iamtype(j,i) = 1_int1 case(0) npartoftype(2,i) = npartoftype(2,i) + 1 iamtype(j,i) = 2_int1 case default ! unknown npartoftype(3,i) = npartoftype(3,i) + 1 iamtype(j,i) = 3_int1 end select enddo deallocate(iam) read(iunit,iostat=ierr,end=80) ! skip iwas if (np <= 0) then ! handle zero particle case just-in-case npartoftype(1,i) = 1 dat(:,:,i) = 0. endif enddo over_steps close(unit=11) ilast = indexstart+nstepsinfile - 1 ncolumns = ncol_max if (npartoftype(2,ilast).gt.0) then print*,' ngas = ',npartoftype(1,ilast),' ndust = ',npartoftype(2,ilast) if (npartoftype(3,ilast) > 0) print*,' nunknown = ',npartoftype(3,ilast) endif if (debugmode) print*,'DEBUG> Read steps ',indexstart,'->',indexstart + nstepsread - 1, & ' last step ntot = ',sum(npartoftype(:,indexstart+nstepsread-1)) return 80 continue print*,' *** data file empty : no timesteps ***' return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:ix,ivx,ih,irho,iutherm,ipmass,& iamvec,labelvec,label,labeltype use params use settings_data, only:ndim,ndimV,iformat,ntypes, & UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo !--2D means x-z if (ndim.eq.2) ix(2) = 3 ivx = 4 irho = 7 ! location of rho in data arra ipmass = 8 iutherm = 9 label(10) = 'Temp' iamvec(11:13) = 11 labelvec(11:13) = 'f' ! force (vector) ih = 14 ! smoothing length label(1:3) = labelcoord(1:3,1) ! !--label vector quantities (e.g. velocity) appropriately ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' label(irho) = 'density' label(iutherm) = 'u' label(ih) = 'h' label(ipmass) = 'particle mass' ! !--set labels for each type of particles ! ntypes = 3 labeltype(1) = 'gas' labeltype(2) = 'dust' labeltype(3) = 'unknown' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. UseTypeInRenderings(3) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_mbate.f90000644 000770 000000 00000030232 12303206656 017136 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM MATTHEW BATE'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use settings_units, only:units use labels, only:unitslabel use mem_allocation implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer, parameter :: maxptmass = 1000 real, parameter :: pi=3.141592653589 integer :: i,j,ifile,ierr,ipart integer :: npart_max,nstep_max,ncolstep,npart,nptmassi,nunknown logical :: iexist,doubleprec character(len=len(rootname)+10) :: dumpfile integer :: nprint, n1, n2, nptmass, nstepsalloc integer, dimension(:), allocatable :: isteps, iphase integer, dimension(maxptmass) :: listpm !--use these lines if dump is double precision real(doub_prec), dimension(:,:), allocatable :: dattemp real(doub_prec) :: udisti,umassi,utimei real(doub_prec) :: timei, gammai real(doub_prec) :: rhozero, RK2 real(doub_prec) :: escap,tkin,tgrav,tterm real(doub_prec) :: dtmax !--use these lines for single precision real, dimension(:,:), allocatable :: dattemps real :: timesi, gammasi real :: rhozeros, RK2s real :: escaps,tkins,tgravs,tterms real :: dtmaxs,tcomp nstepsread = 0 nstep_max = 0 npart_max = maxpart ifile = 1 dumpfile = trim(rootname) ! !--check if data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 ncolstep = 11 ! number of columns in file ncolumns = ncolstep ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 print "(1x,a)",'reading Matthew Bate''s/Willy Benz''s old SPH code format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' else ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,end=55,iostat=ierr) udisti,umassi,utimei,nprint,n1,n2,timei,gammai,rhozero,RK2 print*,'nprint = ',nprint doubleprec = .true. !--try single precision if non-sensible values for time, gamma etc. if (ierr.ne.0 .or. timei.lt.0. .or. timei.gt.1e30 & .or. gammai.lt.1. .or. gammai.gt.10. & .or. rhozero.lt.0. .or. RK2.lt.0. .or. RK2.gt.1.e10) then doubleprec = .false. endif nstepsalloc = 1 do while (ierr == 0) npart_max = max(npart_max,nprint) nstepsalloc = nstepsalloc + 1 read(15,iostat=ierr) udisti,umassi,utimei,nprint enddo ierr = 0 if (.not.allocated(dat) .or. nprint.gt.npart_max) then npart_max = max(npart_max,INT(1.1*nprint)) call alloc(npart_max,nstepsalloc,ncolstep+ncalc) endif rewind(15) endif if (ierr /= 0) then print "(a)",'*** ERROR READING TIMESTEP HEADER ***' else ! !--loop over the timesteps in this file ! over_steps_in_file: do !npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then !if (nstepsread.gt.2) then ! nstepsalloc = j + 2*nstepsread !else ! nstepsalloc = j !endif call alloc(maxpart,nstepsalloc,maxcol) endif ! !--allocate integer arrays required for data read ! if (allocated(isteps)) deallocate(isteps) allocate(isteps(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' if (allocated(iphase)) deallocate(iphase) allocate(iphase(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' ! !--now read the timestep data in the dumpfile ! write(*,"(a,i5,a)",advance="no") '| step ',j,': ' if (doubleprec) then print "(a)",'double precision dump' ! !--allocate a temporary array for (double precision) variables ! if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(npart_max,ncolstep),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' read(15,end=55,iostat=ierr) udisti, umassi, utimei, & nprint, n1, n2, timei, gammai, rhozero, RK2, & (dattemp(i,7), i=1, nprint),escap, tkin, tgrav, tterm, & (dattemp(i,1), i=1, nprint), (dattemp(i,2), i=1, nprint), & (dattemp(i,3), i=1, nprint), (dattemp(i,4), i=1, nprint), & (dattemp(i,5), i=1, nprint), (dattemp(i,6), i=1, nprint), & (dattemp(i,8), i=1, nprint), (dattemp(i,9), i=1, nprint), & (dattemp(i,10), i=1, nprint), (dattemp(i,11),i=1,nprint), & dtmax, (isteps(i), i=1,nprint), (iphase(i),i=1,nprint), & nptmass, (listpm(i), i=1,nptmass) else ! !--allocate a temporary array for (double precision) variables ! if (allocated(dattemps)) deallocate(dattemps) allocate(dattemps(npart_max,ncolstep),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' print "(a)",'single precision dump' read(15,end=55,iostat=ierr) udisti, umassi, utimei, & nprint, n1, n2, timesi, gammasi, rhozeros, RK2s, & (dattemps(i,7), i=1, nprint),escaps, tkins, tgravs, tterms, & (dattemps(i,1), i=1, nprint), (dattemps(i,2), i=1, nprint), & (dattemps(i,3), i=1, nprint), (dattemps(i,4), i=1, nprint), & (dattemps(i,5), i=1, nprint), (dattemps(i,6), i=1, nprint), & (dattemps(i,8), i=1, nprint), (dattemps(i,9), i=1, nprint), & (dattemps(i,10), i=1, nprint), (dattemps(i,11),i=1,nprint), & dtmaxs, (isteps(i), i=1,nprint), (iphase(i),i=1,nprint), & nptmass, (listpm(i), i=1,nptmass) endif ! !--set transformation factors between code units/real units ! units(1:3) = udisti unitslabel(1:3) = ' [cm]' units(4:6) = udisti/utimei unitslabel(4:6) = ' [cm/s]' units(7) = udisti unitslabel(7) = ' [cm]' units(8) = (udisti/utimei)**2 unitslabel(8) = ' [erg/g]' units(9) = umassi unitslabel(9) = ' [g]' units(10) = umassi/udisti**3 unitslabel(10) = ' [g/cm\u3\d]' ! !--convert to single precision and separate pt masses from normal particles ! ipart = 0 do i=1,nprint if (iphase(i).eq.0) then ipart = ipart + 1 if (doubleprec) then dat(ipart,1:ncolstep,j) = real(dattemp(i,1:ncolstep)) else dat(ipart,1:ncolstep,j) = dattemps(i,1:ncolstep) endif endif enddo npart = ipart ! !--place point masses after normal particles ! nptmassi = 0 do i=1,nprint if (iphase(i).ge.1) then ipart = ipart + 1 nptmassi = nptmassi + 1 if (doubleprec) then dat(ipart,1:ncolstep,j) = real(dattemp(i,1:ncolstep)) else dat(ipart,1:ncolstep,j) = dattemps(i,1:ncolstep) endif endif enddo if (nptmass.gt.0) print*,' Number of point masses = ',nptmass if (nptmassi.ne.nptmass) print *,'WARNING: nptmass from iphase =',nptmassi,'not equal to nptmass' ! !--put any others as unknown ! nunknown = 0 do i=1,nprint if (iphase(i).lt.0) then ipart = ipart + 1 nunknown = nunknown + 1 if (doubleprec) then dat(ipart,1:ncolstep,j) = real(dattemp(i,1:ncolstep)) else dat(ipart,1:ncolstep,j) = dattemps(i,1:ncolstep) endif endif enddo if (nunknown.gt.0) print *,nunknown,' particles of unknown type (probably dead)' if (allocated(dattemp)) deallocate(dattemp) if (allocated(dattemps)) deallocate(dattemps) if (allocated(isteps)) deallocate(isteps) if (allocated(iphase)) deallocate(iphase) npartoftype(1,j) = npart npartoftype(2,j) = nptmassi npartoftype(3,j) = nunknown if (doubleprec) then gamma(j) = real(gammai) time(j) = real(timei) else gamma(j) = gammasi time(j) = timesi endif print*,' time = ',time(j),' gamma = ',gamma(j) if (ierr /= 0) then print "(a)",'*** INCOMPLETE DATA ***' nstepsread = nstepsread + 1 exit over_steps_in_file else nstepsread = nstepsread + 1 endif j = j + 1 enddo over_steps_in_file endif 55 continue ! !--reached end of file ! close(15) if (j-1 .gt. 0) then print*,'>> end of dump file: nsteps =',j-1,'ntot = ', & sum(npartoftype(:,j-1)),'nghost=',npartoftype(2,j-1) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ih = 7 ! smoothing length iutherm = 8 ! thermal energy ipmass = 9 ! particle mass irho = 10 ! location of rho in data array if (ncolumns.gt.10) then label(11) = 'dgrav' endif label(ix(1:ndim)) = labelcoord(1:ndim,1) do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo label(irho) = 'density' label(iutherm) = 'u' label(ih) = 'h' label(ipmass) = 'particle mass' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 3 !!maxparttypes labeltype(1) = 'gas' labeltype(2) = 'sink' labeltype(3) = 'unknown' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. UseTypeInRenderings(3) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_mbate_hydro.f90000644 000770 000000 00000024306 11622211702 020337 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM MATTHEW BATE'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:maxparttypes,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer, parameter :: maxptmass = 1000 real, parameter :: pi=3.141592653589 integer :: i,j,ifile,ierr integer :: npart_max,nstep_max,ncolstep logical :: iexist character(len=3) :: fileno character(len=len(rootname)+10) :: dumpfile integer :: nprint, nghosti, n1, n2, nptmass integer, dimension(:), allocatable :: isteps, iphase integer, dimension(maxptmass) :: listpm !--use these lines if dump is double precision real(doub_prec), dimension(:,:), allocatable :: dattemp real(doub_prec), dimension(:), allocatable :: dummy real(doub_prec) :: udisti,umassi,utimei real(doub_prec) :: timei, gammai real(doub_prec) :: rhozero, RK2 real(doub_prec) :: escap,tkin,tgrav,tterm real(doub_prec) :: dtmax, tcomp !--use these lines for single precision !real, dimension(:,:), allocatable :: dattemp !real, dimension(:), allocatable :: dummy !real(doub_prec) :: udisti,umassi,utimei !real :: timei, gammai !real :: rhozero, RK2 !real :: escap,tkin,tgrav,tterm !real :: dtmax,tcomp nstepsread = 0 nstep_max = 0 npart_max = maxpart ifile = 1 ! !--for rootnames without the '00', read all files starting at #1 ! if (len_trim(rootname).lt.7) then ifile = 1 if (len_trim(rootname).eq.4) then write(fileno,"(i1,i1,i1)") ifile/100,mod(ifile,100)/10,mod(ifile,10) dumpfile = rootname(1:4)//fileno elseif (len_trim(rootname).eq.5) then write(fileno,"(i1,i1)") ifile/10,mod(ifile,10) dumpfile = rootname(1:5)//trim(fileno) endif else dumpfile = trim(rootname) endif ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 ncolstep = 12 ! number of columns in file ncolumns = ncolstep ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,4) j = indexstart nstepsread = 0 print "(1x,a)",'reading Matthew Bate''s/Willy Benz''s old SPH code format (hydro)' do while (iexist) write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' else ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,end=55,iostat=ierr) udisti,umassi,utimei,nprint if (.not.allocated(dat) .or. nprint.gt.npart_max) then npart_max = max(npart_max,INT(1.1*nprint)) call alloc(npart_max,nstep_max,ncolstep+ncalc) endif rewind(15) endif if (ierr /= 0) then print*,'*** ERROR READING TIMESTEP HEADER ***' else ! !--loop over the timesteps in this file ! over_steps_in_file: do npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+2*nstepsread,maxcol) endif ! !--allocate a temporary array for double precision variables ! if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(npart_max,ncolstep),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' ! !--allocate a dummy arrays for data I want to throw away ! if (allocated(dummy)) deallocate(dummy) allocate(dummy(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' if (allocated(isteps)) deallocate(isteps) allocate(isteps(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' if (allocated(iphase)) deallocate(iphase) allocate(iphase(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' ! !--now read the timestep data in the dumpfile ! write(*,"(a,i5,a)",advance="no") '| step ',j,': ' read(15,end=55,iostat=ierr) udisti, umassi, utimei, & nprint, nghosti, n1, n2, timei, gammai, rhozero, RK2, & (dattemp(i,7), i=1, nprint), (dattemp(i,8), i=1,nprint), & escap, tkin, tgrav, tterm, & (dattemp(i,1), i=1, nprint), (dattemp(i,2), i=1, nprint), & (dattemp(i,3), i=1, nprint), (dattemp(i,4), i=1, nprint), & (dattemp(i,5), i=1, nprint), (dattemp(i,6), i=1, nprint), & (dattemp(i,9), i=1, nprint), (dattemp(i,10), i=1, nprint), & (dattemp(i,11), i=1, nprint), (dattemp(i,12),i=1,nprint), & dtmax, (isteps(i), i=1,nprint), (iphase(i),i=1,nprint), & nptmass, (listpm(i), i=1,nptmass) if (ierr /= 0) then print "(a)",'*** INCOMPLETE DATA (CHECK PRECISION) ***' nstepsread = nstepsread + 1 exit over_steps_in_file else nstepsread = nstepsread + 1 endif ! !--convert to single precision ! print *,'t = ',timei,' ntotal = ',nprint print "(a)",'| converting to single precision... ' dat(1:nprint,1:ncolstep,j) = real(dattemp(1:nprint,1:ncolstep)) ! !--convert to physical units ! dat(1:nprint,11,j) = dat(1:nprint,11,j)*real(umassi/udisti**3) if (allocated(dattemp)) deallocate(dattemp) if (allocated(dummy)) deallocate(dummy) if (allocated(isteps)) deallocate(isteps) if (allocated(iphase)) deallocate(iphase) npartoftype(1,j) = nprint-nghosti npartoftype(2,j) = nghosti gamma(j) = real(gammai) tcomp = sqrt((3.*pi)/(32*rhozero)) time(j) = real(timei)/tcomp j = j + 1 enddo over_steps_in_file endif 55 continue ! !--reached end of file ! close(15) if (j-1 .gt. 0) then print*,'>> end of dump file: nsteps =',j-1,'ntot = ', & sum(npartoftype(:,j-1)),'nghost=',npartoftype(2,j-1) endif ! !--if just the rootname has been input, ! set next filename and see if it exists ! ifile = ifile + 1 if (len_trim(rootname).eq.4) then write(fileno,"(i1,i1,i1)") ifile/100,mod(ifile,100)/10,mod(ifile,10) dumpfile = rootname(1:4)//fileno inquire(file=dumpfile,exist=iexist) elseif (len_trim(rootname).eq.5) then write(fileno,"(i1,i1)") ifile/10,mod(ifile,10) dumpfile = rootname(1:5)//trim(fileno) inquire(file=dumpfile,exist=iexist) else iexist = .false. ! exit loop endif enddo return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ih = 7 ! smoothing length label(8) = 'alpha' iutherm = 9 ! thermal energy ipmass = 10 ! particle mass irho = 11 ! location of rho in data array if (ncolumns.gt.11) then label(12) = 'dgrav' endif label(ix(1:ndim)) = labelcoord(1:ndim,1) do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo label(irho) = 'density (g/cm\u3\d)' label(iutherm) = 'u' label(ih) = 'h ' label(ipmass) = 'particle mass' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 3 !!maxparttypes labeltype(1) = 'gas' labeltype(2) = 'ghost' labeltype(3) = 'sink' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_mbate_mhd.f90000644 000770 000000 00000025762 11622211702 017771 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM MATTHEW BATE'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer, parameter :: maxptmass = 1000 real, parameter :: pi=3.141592653589 integer :: i,j,ifile,ierr integer :: npart_max,nstep_max,ncolstep logical :: iexist character(len=3) :: fileno character(len=len(rootname)+10) :: dumpfile integer :: nprint, nghosti, n1, n2, nptmass integer, dimension(:), allocatable :: isteps, iphase integer, dimension(maxptmass) :: listpm ! real(doub_prec), dimension(:,:), allocatable :: dattemp ! real(doub_prec), dimension(:), allocatable :: dummy ! real(doub_prec) :: udisti,umassi,utimei, umagfdi ! real(doub_prec) :: timei, gammai ! real(doub_prec) :: rhozero, RK2, tcomp ! real(doub_prec) :: escap,tkin,tgrav,tterm,tmag ! real(doub_prec) :: dtmax real, dimension(:,:), allocatable :: dattemp real, dimension(:), allocatable :: dummy real(doub_prec) :: udisti,umassi,utimei, umagfdi real :: timei, gammai real :: rhozero, RK2, tcomp real :: escap,tkin,tgrav,tterm,tmag real :: dtmax nstepsread = 0 nstep_max = 0 npart_max = maxpart ifile = 1 ! !--for rootnames without the '00', read all files starting at #1 ! if (len_trim(rootname).lt.7) then ifile = 1 if (len_trim(rootname).eq.4) then write(fileno,"(i1,i1,i1)") ifile/100,mod(ifile,100)/10,mod(ifile,10) dumpfile = rootname(1:4)//fileno elseif (len_trim(rootname).eq.5) then write(fileno,"(i1,i1)") ifile/10,mod(ifile,10) dumpfile = rootname(1:5)//trim(fileno) endif else dumpfile = trim(rootname) endif ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 ncolstep = 19 ncolumns = ncolstep !!max(19,maxcol) ! number of columns in file ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 print "(1x,a)",'reading Matthew Bate''s/Willy Benz''s old SPH code format (MHD)' do while (iexist) write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' else ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,end=55,iostat=ierr) udisti,umassi,utimei,umagfdi,nprint if (.not.allocated(dat) .or. nprint.gt.npart_max) then npart_max = max(npart_max,INT(1.1*nprint)) call alloc(npart_max,nstep_max,ncolstep+ncalc) endif rewind(15) endif if (ierr /= 0) then print "(a)",'*** ERROR READING TIMESTEP HEADER ***' else ! !--loop over the timesteps in this file ! over_steps_in_file: do npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+1,maxcol) endif ! !--allocate a temporary array for double precision variables ! if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(npart_max,ncolumns),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' ! !--allocate a dummy arrays for data I want to throw away ! if (allocated(dummy)) deallocate(dummy) allocate(dummy(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' if (allocated(isteps)) deallocate(isteps) allocate(isteps(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' if (allocated(iphase)) deallocate(iphase) allocate(iphase(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' ! !--now read the timestep data in the dumpfile ! write(*,"(a,i5,a)",advance="no") '| step ',j,': ' read(15,end=55,iostat=ierr) udisti, umassi, utimei, umagfdi, & nprint, nghosti, n1, n2, timei, gammai, rhozero, RK2, & (dattemp(i,7), i=1, nprint), (dattemp(i,8), i=1,nprint), & escap, tkin, tgrav, tterm, tmag, & (dattemp(i,1), i=1, nprint), (dattemp(i,2), i=1, nprint), & (dattemp(i,3), i=1, nprint), (dattemp(i,4), i=1, nprint), & (dattemp(i,5), i=1, nprint), (dattemp(i,6), i=1, nprint), & (dattemp(i,9), i=1, nprint), (dattemp(i,10), i=1, nprint), & (dattemp(i,11), i=1, nprint), (dattemp(i,12), i=1, nprint), & (dattemp(i,13), i=1, nprint), (dattemp(i,14), i=1, nprint), & (dattemp(i,15), i=1, nprint), (dattemp(i,16), i=1, nprint), & (dattemp(i,17), i=1, nprint), (dattemp(i,18), i=1, nprint), & (dattemp(i,19), i=1, nprint), (dummy(i),i=1,nprint), & dtmax, (isteps(i), i=1,nprint), (iphase(i),i=1,nprint), & nptmass, (listpm(i), i=1,nptmass) if (ierr /= 0) then print "(a)",'*** INCOMPLETE DATA (CHECK PRECISION) ***' exit over_steps_in_file else nstepsread = nstepsread + 1 endif ! !--convert to single precision ! print "(a,i8)",'ntotal = ',nprint print "(a)",'| converting to single precision... ' dat(1:nprint,1:ncolumns,j) = real(dattemp(1:nprint,1:ncolumns)) if (allocated(dattemp)) deallocate(dattemp) if (allocated(dummy)) deallocate(dummy) if (allocated(isteps)) deallocate(isteps) if (allocated(iphase)) deallocate(iphase) npartoftype(1,j) = nprint-nghosti npartoftype(2,j) = nghosti gamma(j) = real(gammai) tcomp = sqrt((3.*pi)/(32*rhozero)) time(j) = real(timei)/tcomp j = j + 1 enddo over_steps_in_file endif 55 continue ! !--reached end of file ! close(15) print*,'>> end of dump file: nsteps =',j-1 if (j-1.gt.0) then print*,'ntot = ',sum(npartoftype(:,j-1)),'nghost=',npartoftype(2,j-1) endif ! !--if just the rootname has been input, ! set next filename and see if it exists ! ifile = ifile + 1 if (len_trim(rootname).eq.4) then write(fileno,"(i1,i1,i1)") ifile/100,mod(ifile,100)/10,mod(ifile,10) dumpfile = rootname(1:4)//fileno inquire(file=dumpfile,exist=iexist) elseif (len_trim(rootname).eq.5) then write(fileno,"(i1,i1)") ifile/10,mod(ifile,10) dumpfile = rootname(1:5)//trim(fileno) inquire(file=dumpfile,exist=iexist) else iexist = .false. ! exit loop endif enddo return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 irho = 18 ! location of rho in data array iutherm = 16 ! thermal energy ih = 7 ! smoothing length ipmass = 17 ! particle mass label(ix(1:ndim)) = labelcoord(1:ndim,1) do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo label(irho) = '\gr' label(iutherm) = 'u' label(ih) = 'h ' label(ipmass) = 'particle mass' label(8) = 'alpha' label(19) = 'psi' label(ndim + ndimV+5) = '\ga' if (ncolumns.gt.11) then iBfirst = 9 ! location of Bx do i=1,ndimV label(iBfirst + i-1) = 'B\d'//labelcoord(i,1) !' (x10\u-3\d)' !//'/rho' enddo idivB = 12 label(idivB) = 'div B' do i=1,ndimV label(13 + i-1) = 'J'//labelcoord(i,1) enddo else iBfirst = 0 endif ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo !--mag field if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'\d'//labelcoord(i,1) enddo endif !--current density iamvec(13:13+ndimV-1) = 13 labelvec(13:13+ndimV-1) = 'J' do i=1,ndimV label(13+i-1) = trim(labelvec(13))//'\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 3 !!maxparttypes labeltype(1) = 'gas' labeltype(2) = 'ghost' labeltype(3) = 'sink' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_ndspmhd.f90000644 000770 000000 00000042227 12611360563 017512 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! the data is stored in the global array dat ! ! THIS VERSION FOR DAN'S SPMHD CODE (BINARY DUMPS) ! -> Now automatically handles single/double precision ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use exact, only:hfact use particle_data, only:npartoftype,time,gamma,dat,maxpart,maxstep,maxcol,iamtype use params use filenames, only:nfiles use settings_data, only:ndim,ndimV,ncolumns,ncalc,icoords,iformat, & buffer_data,iverbose,debugmode use mem_allocation, only:alloc use geometry, only:labelcoordsys use system_utils, only:lenvironment use labels, only:labeltype,print_types implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+4) :: datfile integer :: i,icol,ierr,iunit,ilen,j,ilast integer :: ncol_max,ndim_max,npart_max,ndimV_max,nstep_max integer :: npartin,ntotin,ncolstep,nparti,ntoti integer, dimension(3) :: ibound logical :: reallocate, singleprecision real :: timein, gammain, hfactin real, dimension(3) :: xmin, xmax real(doub_prec) :: timeind,gammaind,hfactind real(doub_prec), dimension(3) :: xmind, xmaxd real(doub_prec), dimension(:), allocatable :: dattempd integer, dimension(:), allocatable :: itype character(len=20) :: geomfile iunit = 11 ! file unit number ndim_max = 1 ndimV_max = 1 nstepsread = 0 if (rootname(1:1).ne.' ') then datfile = trim(rootname) !print*,'rootname = ',rootname else print*,' **** no data read **** ' return endif if (iverbose.ge.1) print "(1x,a)",'reading ndspmhd format' write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! open(unit=iunit,iostat=ierr,file=datfile,status='old',form='unformatted') if (ierr /= 0) then print*,' *** Error opening '//trim(datfile)//' ***' return endif ! !--read first header line ! singleprecision = .false. read(iunit,iostat=ierr,end=80) timeind,npartin,ntotin,gammaind, & hfactind,ndim_max,ndimV_max,ncol_max,iformat ! print*,'time = ',timeind,' hfact = ',hfactind,' ndim=',ndim_max,'ncol=',ncol_max ! print*,'npart = ',npartin,ntotin,geomfile if (ierr /= 0 .or. ndim_max.le.0 .or. ndim_max.gt.3 & .or. ndimV_max.le.0 .or. ndimV_max.gt.3 & .or. ncol_max.le.0 .or. ncol_max.gt.100 & .or. npartin.le.0 .or. npartin.gt.1e7 .or. ntotin.le.0 .or. ntotin.gt.1e7 & .or. iformat.lt.0 .or. iformat.gt.10) then ! !--try single precision ! rewind(iunit) read(iunit,iostat=ierr,end=80) timein,npartin,ntotin,gammain, & hfactin,ndim_max,ndimV_max,ncol_max,iformat singleprecision = .true. if (ierr /= 0 .or. ndim_max.le.0 .or. ndim_max.gt.3 & .or. ndimV_max.le.0 .or. ndimV_max.gt.3 & .or. ncol_max.le.0 .or. ncol_max.gt.100 & .or. npartin.le.0 .or. npartin.gt.1e7 .or. ntotin.le.0 .or. ntotin.gt.1e7 & .or. iformat.lt.0 .or. iformat.gt.10) then print "(a)",' *** Error reading first header ***' print*,' time = ',timein,' hfact = ',hfactin,' ndim=',ndim_max,'ncol=',ncol_max close(iunit) return endif endif ! !--allocate memory for data arrays ! if (buffer_data) then nstep_max = max(nfiles,maxstep,indexstart) else nstep_max = max(1,maxstep,indexstart) endif npart_max = max(int(1.5*ntotin),maxpart) if (.not.allocated(dat) .or. ntotin.gt.maxpart & .or. nstep_max.gt.maxstep .or. ncol_max.gt.maxcol) then call alloc(npart_max,nstep_max,ncol_max+ncalc,mixedtypes=.true.) endif ! !--rewind file ! rewind(iunit) i = indexstart nstepsread = 0 reallocate = .false. npart_max = maxpart nstep_max = maxstep geomfile = ' ' ! !--read header line for this timestep ! if (singleprecision) then if (debugmode) print "(a)",'DEBUG: single precision dump' read(iunit,iostat=ierr) timein,nparti,ntoti,gammain, & hfactin,ndim,ndimV,ncolstep,iformat,ibound(1:ndim), & xmin(1:ndim),xmax(1:ndim),ilen,geomfile(1:ilen) else if (debugmode) print "(a)",'DEBUG: double precision dump' read(iunit,iostat=ierr) timeind,nparti,ntoti,gammaind, & hfactind,ndim,ndimV,ncolstep,iformat,ibound(1:ndim), & xmind(1:ndim),xmaxd(1:ndim),ilen,geomfile(1:ilen) timein = real(timeind) gammain = real(gammaind) hfactin = real(hfactind) xmin = real(xmind) xmax = real(xmaxd) endif if (ierr /= 0) then print*,'*** error reading timestep header ***' close(iunit) return else ! count this as a successfully read timestep, even if data is partial nstepsread = nstepsread + 1 endif time(i) = timein gamma(i) = gammain hfact = hfactin npartoftype(1,i) = nparti npartoftype(3,i) = ntoti - nparti if (iverbose.ge.1) then print "(a14,':',es10.3,a6,':',i8,a8,':',i8)",' time',time(i),'npart',nparti,'ntotal',ntoti print "(a14,':',i8,a8,':',f8.4,a8,':',f8.4)",' ncolumns',ncolstep,'gamma',gamma(i),'hfact',hfact print "(a14,':',i8,a8,':',i8)",'ndim',ndim,'ndimV',ndimV else print "(1x,a,':',es10.3,a8,':',i8,a8,':',i8)",'time',time(i),'npart',nparti,'ntotal',ntoti endif select case(geomfile(1:6)) case('cylrpz') icoords = 2 case('sphrpt') icoords = 3 case default icoords = 1 end select if (icoords.ne.1) print "(a14,a)",' geometry: ',trim(geomfile)//' ('//trim(labelcoordsys(icoords))//')' if (iverbose.ge.1 .and. any(ibound(1:ndim).ne.0)) then print "(a14,':',a15,' =',3(f8.4))",'boundaries','xmin',xmin(1:ndim) print "(15x,a15,' =',3(f8.4))",'xmax',xmax(1:ndim) endif ! !--check for errors in timestep header ! if (ndim.gt.3 .or. ndimV.gt.3) then print*,'*** error in header: ndim or ndimV in file> 3' nstepsread = nstepsread - 1 ndim = ndim_max ndimV = ndimV_max close(iunit) return endif if (ndim.gt.ndim_max) ndim_max = ndim if (ndimV.gt.ndimV_max) ndimV_max = ndimV if (ncolstep.ne.ncol_max) then print*,'*** Warning number of columns not equal for timesteps' ncolumns = ncolstep if (iverbose.ge.1) print*,'ncolumns = ',ncolumns,ncol_max if (ncolumns.gt.ncol_max) ncol_max = ncolumns endif if (ncolstep.gt.maxcol) then reallocate = .true. ncolumns = ncolstep ncol_max = ncolumns else ncolumns = ncolstep endif if (ntoti.gt.maxpart) then !print*, 'ntot greater than array limits!!' reallocate = .true. npart_max = int(1.5*ntoti) endif if (i.gt.maxstep) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate) then call alloc(npart_max,nstep_max,ncol_max+ncalc,mixedtypes=.true.) endif if (ntoti.gt.0) then if (.not.singleprecision) allocate(dattempd(ntoti)) do icol=1,ncolstep if (singleprecision) then read (iunit,iostat=ierr,end=67) dat(1:ntoti,icol,i) else read (iunit,iostat=ierr,end=67) dattempd(1:ntoti) dat(1:ntoti,icol,i) = real(dattempd(1:ntoti)) endif if (ierr /= 0) print "(a,i2,a)",'*** error reading column ',icol,' ***' enddo if (allocated(dattempd)) deallocate(dattempd) allocate(itype(ntoti)) read(iunit,iostat=ierr) itype(1:ntoti) if (ierr.ne.0) then if (debugmode) print "(a)",'DEBUG: itype not found in dump file' iamtype(1:nparti,i) = 1 iamtype(nparti+1:ntoti,i) = 3 else ! !--assign SPLASH types from ndspmhd types ! npartoftype(:,i) = 0 do j=1,ntoti if (j.gt.nparti) then iamtype(j,i) = 3 npartoftype(3,i) = npartoftype(3,i) + 1 elseif (itype(j).eq.2) then iamtype(j,i) = 2 npartoftype(2,i) = npartoftype(2,i) + 1 else iamtype(j,i) = 1 npartoftype(1,i) = npartoftype(1,i) + 1 endif enddo endif if (allocated(itype)) deallocate(itype) else npartoftype(1,i) = 1 npartoftype(2:3,i) = 0 dat(:,:,i) = 0. endif goto 68 67 continue print "(a)",' > end of file reached <' 68 continue ! !--close data file and return ! close(unit=11) ilast = i ! !--ONE FLUID DUST: FAKE IT AS IF IT IS TWO FLUIDS ! (copy the particles, then copy gas properties onto first lot, then dust properties onto second lot) ! ncolumns = ncol_max ndim = ndim_max ndimV = ndimV_max call set_labels if (iformat.eq.5 .and. .not.lenvironment('NSPLASH_BARYCENTRIC')) then call fake_twofluids iformat = 1 endif if (any(npartoftype(2:,ilast) > 0)) call print_types(npartoftype(:,ilast),labeltype) if (debugmode) print*,'DEBUG> Read steps ',indexstart,'->',indexstart + nstepsread - 1, & ' last step ntot = ',sum(npartoftype(:,indexstart+nstepsread-1)) return 80 continue print*,' *** data file empty : no timesteps ***' return contains subroutine fake_twofluids use labels, only:idustfrac,irho,ix,ih,ipmass,ivx,ideltav implicit none integer :: ndust,jdust real :: rhodust,rhogas,rhotot,dustfraci,pmassgas,pmassdust,pmassj real, dimension(ndimV) :: veli,vgas,vdust,deltav if (idustfrac.gt.0 .and. irho.gt.0) then do i=indexstart,indexstart+nstepsread-1 ntoti = sum(npartoftype(:,i)) if (.not.allocated(dat) .or. (ntoti + npartoftype(1,i)).gt.maxpart) then call alloc(ntoti + npartoftype(1,i),maxstep,maxcol,mixedtypes=.true.) endif ndust = 0 !--zero the properties of newly created dust particles dat(ntoti+1:ntoti+npartoftype(1,i),:,i) = 0. do j=1,ntoti if (iamtype(j,i).eq.1) then ndust = ndust + 1 ! one dust particle for every gas particle rhotot = dat(j,irho,i) dustfraci = dat(j,idustfrac,i) rhogas = rhotot*(1. - dustfraci) rhodust = rhotot*dustfraci !--replace global properties with gas-only stuff dat(j,irho,i) = rhogas !--copy x, smoothing length onto dust particle jdust = ntoti + ndust !--fill in dust properties if (ndim.gt.0) dat(jdust,ix(1:ndim),i) = dat(j,ix(1:ndim),i) if (ih.gt.0) dat(jdust,ih,i) = dat(j,ih,i) if (irho.gt.0) dat(jdust,irho,i) = rhodust iamtype(ntoti + ndust,i) = 2 !--particle masses if (ipmass.gt.0) then pmassj = dat(j,ipmass,i) pmassgas = pmassj*(1. - dustfraci) pmassdust = pmassj*dustfraci dat(j,ipmass,i) = pmassgas dat(jdust,ipmass,i) = pmassdust endif !--velocities if (ideltav.gt.0 .and. ivx.gt.0 .and. ndimV.gt.0) then veli(:) = dat(j,ivx:ivx+ndimV-1,i) deltav(:) = dat(j,ideltav:ideltav+ndimV-1,i) vgas(:) = veli(:) - rhodust/rhotot*deltav(:) vdust(:) = veli(:) + rhogas/rhotot*deltav(:) dat(j,ivx:ivx+ndimV-1,i) = vgas(:) dat(jdust,ivx:ivx+ndimV-1,i) = vdust(:) endif endif enddo if (iverbose.ge.1) then print "(a,i10,a)",' Creating ',ndust,' fictional dust particles...' print "(a)",' (set NSPLASH_BARYCENTRIC=yes to plot barycentric values)' endif npartoftype(2,i) = npartoftype(2,i) + ndust enddo else print "(a)",' ERROR: could not locate dust-to-gas ratio and/or density' endif end subroutine fake_twofluids end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:ix,ivx,ih,irho,iutherm,ipmass,ipr,iBfirst, & idivB,iJfirst,iamvec,labelvec,label,labeltype, & irhorestframe,idustfrac,ideltav use params use settings_data, only:ndim,ndimV,iformat,ntypes, & UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i,icol if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = ndim + 1 ih = ndim + ndimV + 1 ! smoothing length irho = ndim + ndimV + 2 ! location of rho in data array iutherm = ndim + ndimV + 3 ! thermal energy ipmass = ndim + ndimV + 4 ! particle mass label(ix(1:ndim)) = labelcoord(1:ndim,1) ! !--label vector quantities (e.g. velocity) appropriately ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' label(irho) = '\gr' label(iutherm) = 'u' label(ih) = 'h ' label(ipmass) = 'particle mass' label(ndim + ndimV+5) = '\ga' label(ndim + ndimV+6) = '\ga\du' icol = ndim+ndimV + 7 if (iformat.eq.2 .or. iformat.eq.4) then ! !--mag field (vector) ! label(icol) = '\ga\dB' iBfirst = icol+1 ! location of Bx iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' icol = icol + ndimV ! !--more scalars ! icol = icol + 1 label(icol) = 'psi' icol = icol + 1 ipr = icol ! pressure label(ipr) = 'P' icol = icol + 1 label(icol) = 'div v' icol = icol + 1 idivB = icol label(idivB) = 'div B' ! !--current density (vector) ! iJfirst = icol + 1 iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = 'J' icol = icol + ndimV icol = icol + 1 label(icol) = 'grad h' iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = 'force' icol = icol + ndimV iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = 'A' icol = icol + ndimV else ipr = icol ! pressure label(ipr) = 'P' icol = icol + 1 label(icol) = 'div v' icol = icol + 1 label(icol) = 'grad h' iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = 'force' icol = icol + ndimV iBfirst = 0 iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = 'del^{2} v' icol = icol + ndimV iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = 'grad (div {\bf v})' icol = icol + ndimV endif if (iformat.eq.5) then icol = icol + 1 label(icol) = 'Dust fraction' idustfrac = icol iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = '\Deltav' ideltav = icol + 1 icol = icol + ndimV elseif (iformat.gt.2) then irhorestframe = irho icol = icol + 1 irho = icol label(icol) = 'rho*' !irho = icol icol = icol + 1 label(icol) = 'sqrt g' iamvec(icol+1:icol+ndimV) = icol + 1 labelvec(icol+1:icol+ndimV) = 'pmom' icol = icol + ndimV endif ! !--set labels for each type of particles ! ntypes = 3 labeltype(1) = 'gas' labeltype(2) = 'dust' labeltype(3) = 'ghost' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_oilonwater.f90000644 000770 000000 00000030014 12303206656 020227 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM MATTHEW BATE'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- !--short module storing units information module oilonwaterread use params implicit none real(doub_prec) :: udisti,umassi,utimei end module oilonwaterread subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation use labels, only:ix,ivx,ih,irho,ipmass use oilonwaterread, only:udisti,umassi,utimei implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer, parameter :: maxptmass = 1000 real, parameter :: pi=3.141592653589 integer :: i,j,k,ifile,ierr,ipart integer :: npart_max,nstep_max,ncolstep,npart,nunknown logical :: iexist,doubleprec character(len=len(rootname)+10) :: dumpfile integer :: nprint, n1, n2, nptmass, nstepsalloc integer :: npartoil, npartwater integer, dimension(:), allocatable :: isteps, iphase !--use these lines if dump is double precision real(doub_prec), dimension(:,:), allocatable :: dattemp real(doub_prec) :: timei, gammai real(doub_prec) :: rhozero, RK2 real(doub_prec) :: escap,tkin,tgrav,tterm real(doub_prec) :: dtmax !--use these lines for single precision real :: timesi, gammasi real :: rhozeros, RK2s real :: escaps,tkins,tgravs,tterms real :: dtmaxs nstepsread = 0 nstep_max = 0 npart_max = maxpart ifile = 1 dumpfile = trim(rootname) ! !--check if data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 ncolstep = 18 ! number of columns in file ncolumns = ncolstep ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 doubleprec = .false. print "(1x,a)",'reading oil-on-water code format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' else ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,end=55,iostat=ierr) udisti,umassi,utimei,nprint,n1,n2,timei,gammai,rhozero,RK2 print*,'npart = ',nprint if (.not.allocated(dat) .or. nprint.gt.npart_max) then npart_max = max(npart_max,INT(1.1*nprint)) call alloc(npart_max,nstep_max,ncolstep+ncalc,mixedtypes=.true.) endif doubleprec = .true. !--try single precision if non-sensible values for time, gamma etc. if (ierr.ne.0 .or. timei.lt.0. .or. timei.gt.1e30 & .or. gammai.lt.1. .or. gammai.gt.10. & .or. rhozero.lt.0. .or. RK2.lt.0. .or. RK2.gt.1.e10) then doubleprec = .false. endif rewind(15) endif call set_labels if (ierr /= 0) then print "(a)",'*** ERROR READING TIMESTEP HEADER ***' else ! !--loop over the timesteps in this file ! over_steps_in_file: do npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then if (nstepsread.ge.2) then nstepsalloc = 2*nstepsread else nstepsalloc = j endif call alloc(maxpart,nstepsalloc,maxcol,mixedtypes=.true.) endif ! !--allocate integer arrays required for data read ! if (allocated(isteps)) deallocate(isteps) allocate(isteps(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' if (allocated(iphase)) deallocate(iphase) allocate(iphase(npart_max),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' ! !--now read the timestep data in the dumpfile ! write(*,"(a,i5,a)",advance="no") '| step ',j,': ' if (doubleprec) then print "(a)",'double precision dump' ! !--allocate a temporary array for (double precision) variables ! if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(npart_max,ncolstep),stat=ierr) if (ierr /= 0) print*,'not enough memory in read_data' read(15,end=55,iostat=ierr) udisti, umassi, utimei, & nprint, n1, n2, timei, gammai, rhozero, RK2, & (dattemp(i,ih), i=1, nprint),escap, tkin, tgrav, tterm, & ((dattemp(i,k), i=1, nprint),k=1,ih-1), & ((dattemp(i,k), i=1, nprint),k=ih+1,11), & dtmax, & (isteps(i), i=1,nprint), & ((dattemp(i,k), i=1, nprint),k=12,18), & nptmass, & ((dattemp(i,k), i=nprint+1,nprint+nptmass),k=1,6), & (dattemp(i,ipmass), i=nprint+1,nprint+nptmass), & (dattemp(i,ih), i=nprint+1,nprint+nptmass), & (isteps(i), i=nprint+1,nprint+nptmass), & (iphase(i), i=1,nprint) else print "(a)",'single precision dump' read(15,end=55,iostat=ierr) udisti, umassi, utimei, & nprint, n1, n2, timesi, gammasi, rhozeros, RK2s, & (dat(i,ih,j), i=1, nprint),escaps, tkins, tgravs, tterms, & ((dat(i,k,j), i=1, nprint),k=1,ih-1), & ((dat(i,k,j), i=1, nprint),k=ih+1,11), & dtmaxs, & (isteps(i),i=1, nprint), & ((dat(i,k,j), i=1, nprint),k=12,18), & nptmass, & ((dat(i,k,j), i=nprint+1,nprint+nptmass),k=1,6), & (dat(i,ipmass,j), i=nprint+1,nprint+nptmass), & (dat(i,ih,j), i=nprint+1,nprint+nptmass), & (isteps(i), i=nprint+1,nprint+nptmass), & (iphase(i), i=1,nprint) endif ! !--extract time and gamma ! if (doubleprec) then gamma(j) = real(gammai) time(j) = real(timei) else gamma(j) = gammasi time(j) = timesi endif print*,' time = ',time(j),' gamma = ',gamma(j) npart = nprint+nptmass ! !--convert to single precision if necessary ! if (doubleprec) then dat(1:npart,1:ncolstep,j) = real(dattemp(1:npart,1:ncolstep)) endif ! !--set particle types using iphase ! ipart = 0 npartoil = 0 npartwater = 0 nunknown = 0 do i=1,nprint select case(iphase(i)) case(0) npartoil = npartoil + 1 iamtype(i,j) = 1 case(1) npartwater = npartwater + 1 iamtype(i,j) = 2 case default nunknown = nunknown + 1 iamtype(i,j) = 4 end select enddo ! !--set particle type for point masses ! if (nptmass.gt.0) then iamtype(nprint+1:nprint+nptmass,j) = 3 endif if (nunknown.gt.0) print *,nunknown,' particles of unknown type (probably dead)' if (allocated(dattemp)) deallocate(dattemp) if (allocated(isteps)) deallocate(isteps) if (allocated(iphase)) deallocate(iphase) npartoftype(1,j) = npartoil npartoftype(2,j) = npartwater npartoftype(3,j) = nptmass npartoftype(4,j) = nunknown print "(1x,3(a,i10))",' n(oil) = ',npartoil,' n(water) = ',npartwater,' nptmass = ',nptmass if (ierr /= 0) then print "(a)",'*** INCOMPLETE DATA ***' nstepsread = nstepsread + 1 exit over_steps_in_file else nstepsread = nstepsread + 1 endif j = j + 1 enddo over_steps_in_file endif 55 continue ! !--reached end of file ! close(15) if (j-1 .gt. 0) then print*,'>> end of dump file: nsteps =',j-1 endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use physcon, only:solarrcgs,solarmcgs use settings_data use geometry, only:labelcoord use oilonwaterread, only:udisti,umassi,utimei use settings_units, only:units,unitzintegration implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ih = 7 ! smoothing length iutherm = 8 ! thermal energy ipmass = 9 ! particle mass irho = 10 ! location of rho in data array if (ncolumns.gt.10) then label(11) = 'dgrav' label(12) = 'torque t' label(13) = 'torque g' label(14) = 'torque p' label(15) = 'torque v' label(16) = 'torque c' label(17) = 'hecomp' label(18) = 'potential energy' endif label(ix(1:ndim)) = labelcoord(1:ndim,1) do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo label(irho) = 'density' label(iutherm) = 'u' label(ih) = 'h' label(ipmass) = 'particle mass' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo ! !--set transformation factors between code units/real units ! units(1:3) = udisti/solarrcgs unitslabel(1:3) = ' [R\d\(2281)\u]' units(4:6) = udisti/utimei unitslabel(4:6) = ' [cm/s]' units(ih) = units(1) unitslabel(ih) = unitslabel(1) units(iutherm) = (udisti/utimei)**2 unitslabel(iutherm) = ' [erg/g]' units(ipmass) = umassi/solarmcgs unitslabel(ipmass) = ' [M\d\(2281)\u]' units(irho) = umassi/udisti**3 unitslabel(irho) = ' [g/cm\u3\d]' !--unit for z integration - leave this as cm to get g/cm^2 in column density unitzintegration = udisti labelzintegration = ' [cm]' !--time units for legend units(0) = utimei/3.1536e7 unitslabel(0) = ' yrs' ! !--set labels for each particle type ! ntypes = 4 labeltype(1) = 'gas (oil)' labeltype(2) = 'gas (water)' labeltype(3) = 'point mass' labeltype(4) = 'unknown' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. UseTypeInRenderings(4) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_pbob.f90000644 000770 000000 00000026376 12611342532 017002 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR .PBOB FILES BY DAVID BROWN ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! !------------------------------------------------------------------------- ! ! The module below contains interface routines to c functions ! that perform the actual read of the .pbob file information ! !------------------------------------------------------------------------- module pbobread use params, only:maxplot,doub_prec use labels, only:lenlabel use, intrinsic :: iso_c_binding, only:c_int,c_double,c_char implicit none character(len=lenlabel), dimension(maxplot) :: blocklabel integer, parameter :: maxtypes = 6 interface subroutine read_pbob_header(filename,npart,ncol,nsteps,ndim,ndimV,time,ierr) bind(c) import character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(out) :: npart,ncol,nsteps,ndim,ndimV,ierr real(kind=c_double), intent(out) :: time end subroutine read_pbob_header subroutine read_pbob_data(filename,np,time_slice,time_val,ierr) bind(c) import implicit none character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(in), value :: np integer(kind=c_int), intent(in), value :: time_slice real(kind=c_double), intent(out) :: time_val integer(kind=c_int), intent(out) :: ierr end subroutine read_pbob_data end interface end module pbobread !------------------------------------------------------------------------- ! ! The routine that reads the data into splash's internal arrays ! !------------------------------------------------------------------------- subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,npartoftype,masstype,time,gamma,maxpart,maxcol,maxstep,iamtype use params, only:doub_prec use settings_data, only:ndim,ndimV,ncolumns,ncalc,ipartialread, & ntypes,debugmode !,iverbose use mem_allocation, only:alloc use labels, only:labeltype,print_types use asciiutils, only:cstring use pbobread, only:read_pbob_header,read_pbob_data implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile integer :: i,j,itype,ierr integer :: ncolstep,npart_max,nstep_max,ntoti logical :: iexist,reallocate,goterrors real(doub_prec) :: timetemp nstepsread = 0 goterrors = .false. if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! print "(1x,a)",'reading PBOB format' inquire(file=datfile,exist=iexist) if (.not.iexist) then ! !--append .silo on the end if not already present ! datfile=trim(rootname)//'.pbob' inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(rootname)//': file not found ***' return endif endif ! !--read data from snapshots ! i = istepstart write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open file and read header information ! if (debugmode) print*,'DEBUG: reading header...' call read_pbob_header(cstring(datfile),ntoti,ncolstep,nstep_max,ndim,ndimV,timetemp,ierr) if (ierr /= 0) then print "(a)", '*** ERROR READING HEADER ***' return endif ncolumns = ncolstep !if (iverbose >= 1) print "(a,1x,i10,a,es10.3)",' ndim: ',ndim,' time: ',timetemp !if (iverbose >= 1) print "(2(a,1x,i10))",' npart: ',ntoti,' ncolumns: ',ncolstep ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,nstep_max) if (ntoti.gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*ntoti) else ! if first time, save on memory npart_max = int(ntoti) endif endif if (i.ge.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol),mixedtypes=.true.) reallocate = .false. endif ! !--copy header data into allocated arrays ! npartoftype(1,i) = ntoti time(i) = real(timetemp) !print*,' time = ',timetemp masstype(:,i) = 0. ! all masses read from file ! !--read particle data ! got_particles: if (ntoti > 0) then do while(ierr == 0 .and. i <= nstep_max) if (i.gt.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate) call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol),mixedtypes=.true.) call read_pbob_data(cstring(datfile),ntoti,i,timetemp,ierr) if (ierr == 0) then print "(a,i3,a,es10.3)",' time slice #',i,' time = ',timetemp time(i) = real(timetemp) call set_labels ! sets ntypes and labeltype if (size(iamtype(:,i)).gt.1) then npartoftype(:,i) = 0 do j=1,ntoti itype = iamtype(j,i) if (itype > 0 .and. itype <= ntypes) then npartoftype(itype,i) = npartoftype(itype,i) + 1 else ! catch-all "unknown" type npartoftype(ntypes+1,i) = npartoftype(ntypes+1,i) + 1 endif enddo endif i = i + 1 nstepsread = nstepsread + 1 call print_types(npartoftype(:,i),labeltype) endif enddo endif got_particles ! !--now memory has been allocated, set arrays which are constant for all time ! gamma = 5./3. ipartialread = .false. ! !--cover the special case where no particles have been read ! if (ntoti.le.0) then npartoftype(1,i) = 1 dat(:,:,i) = 0. endif return end subroutine read_data subroutine read_pbob_data_fromc(icol,istep,np,temparr,itype,tag) bind(c) use, intrinsic :: iso_c_binding, only:c_int,c_double,c_char use particle_data, only:dat,iamtype use settings_data, only:debugmode use labels, only:label use asciiutils, only:fstring use pbobread, only:blocklabel integer(kind=c_int), intent(in),value :: icol,istep,np integer(kind=c_int), intent(in) :: itype(np) real(kind=c_double), intent(in) :: temparr(np) character(kind=c_char), intent(in) :: tag(256) integer(kind=c_int) :: i,icolput icolput = icol if (debugmode) print "(a,i2,a,i2,a)",'DEBUG: reading column ',icol,' -> '//trim(label(icolput)) ! check column is within array limits if (icolput.gt.size(dat(1,:,1)) .or. icolput.eq.0) then print "(a,i2,a)",' ERROR: column = ',icolput,' out of range in read_pbob_data_fromc' return endif if (istep > size(dat(1,1,:)) .or. istep <= 0) then print "(a,i2,a)",' ERROR: step = ',istep,' out of range in read_pbob_data_fromc' return endif blocklabel(icol) = trim(fstring(tag)) ! ensure no array overflows nmax = min(np,size(dat(:,1,1))) ! copy data into main splash array dat(1:nmax,icolput,istep) = real(temparr(1:nmax)) ! set particle type if (size(iamtype(:,1)).gt.1) then do i=1,nmax iamtype(i,istep) = int(itype(i),kind=kind(iamtype)) enddo endif return end subroutine read_pbob_data_fromc !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,ix,ivx,ipmass, & ih,irho,ipr,iutherm,iax!,iBfirst,idivB use params use settings_data, only:ndim,ndimV,ntypes,UseTypeInRenderings use geometry, only:labelcoord use system_utils, only:envlist,ienvironment use pbobread, only:blocklabel use asciiutils, only:lcase implicit none integer :: i,icol if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif ix = 0 iutherm = 0 do i=1,ndim ix(i) = i enddo do icol=1,size(blocklabel) select case(trim(lcase(blocklabel(icol)))) case('x') ix(1) = icol case('vx') ivx = icol case('ax') iax = icol case('h') ih = icol case('p') ipr = icol case('mass','m') ipmass = icol case('density','rho') irho = icol end select label(icol) = trim(blocklabel(icol)) enddo !! set labels of the quantities read in !if (ix(1).gt.0) label(ix(1:ndim)) = labelcoord(1:ndim,1) ! set labels for vector quantities if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'_'//labelcoord(i,1) enddo endif if (iax.gt.0) then iamvec(iax:iax+ndimV-1) = iax labelvec(iax:iax+ndimV-1) = 'a' do i=1,ndimV label(iax+i-1) = trim(labelvec(iax))//'_'//labelcoord(i,1) enddo endif ! set labels for each particle type ntypes = 3 labeltype(1) = 'interior' labeltype(2) = 'ghost' labeltype(3) = 'boundary' UseTypeInRenderings(:) = .false. UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_pbob_utils.c000644 000770 000000 00000011774 12611342532 020042 0ustar00dpricewheel000000 000000 /* * This subroutine performs the calls to the PBOB c routines * */ #include #include #include #include #include #include #include extern PBOB *ReadPBOB(char *file_name); extern PARTICLE *ReadParticle(char *file_name,int time_slice,int start_indx,int N); void set_blocklabel(int *icol, char *name); void read_pbob_data_fromc(int icol, int istep, int np, double temparr[np],int itype[np], char *tag); void read_pbob_header(char *filename, int *npart, int *ncol, int *nsteps, int *ndim, int *ndimV, double *time, int *ierr) { *npart = 0; *ierr = 0; *ncol = 0; *nsteps = 0; *time = 0.; *npart = 0; *ndim = 2; *ndimV = 2; *ncol = 15; /* hard wired */ PBOB *pbob = NULL; if ((pbob=ReadPBOB(filename))==NULL) { *ierr = 1; return; } /*printf(" cluster_size = %i \n",pbob->cluster_size); printf(" length_units = %s \n",pbob->length_units); printf(" mass_units = %s \n",pbob->mass_units); printf(" time_units = %s \n",pbob->time_units); printf(" energy_units = %s \n",pbob->internal_energy_units); */ printf(" short title = %s \n",pbob->short_title); printf(" total_particles = %llu \n",pbob->total_particles); printf(" nn_k = %i \n",pbob->nn_k); printf(" time slices = %i \n",pbob->number_of_time_slices); /* printf(" offset = %i \n",pbob->first_particle_byte_offset); printf(" length = %i \n",pbob->particle_length_bytes); */ printf(" endian = %s \n",pbob->endian_str); printf(" version = %s \n",pbob->pbob_version); *nsteps = pbob->number_of_time_slices; *npart = pbob->total_particles; *time = pbob->time; /* printf(" ascii_header: \n"); printf("%s\n",pbob.ascii_header); */ } void read_pbob_data(char *filename, int npart, int time_slice, double *timeval, int *ierr) { PARTICLE *particle = NULL; *ierr = 0; int start_indx = 0; int N = npart; int i; *timeval = -1.; /*printf(" time_slice = %i\n",time_slice);*/ if ((particle=ReadParticle(filename,time_slice,start_indx,N))==NULL) { *ierr = 2; return; } int species[npart]; for (i=0;i> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use exact, only:hfact use particle_data, only:npartoftype,time,gamma,dat,maxpart,maxstep,maxcol use params ! use labels use filenames, only:nfiles use settings_data, only:ndim,ndimV,ncolumns,ncalc,ntypes, & buffer_data use mem_allocation, only:alloc use geometry, only:labelcoordsys implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+4) :: datfile integer :: i,icol,ierr,iunit,isizeheader integer :: npart_max,nstep_max integer :: ntoti logical :: singleprecision integer*2, dimension(10) :: sheader integer, dimension(10) :: iheader integer*8, dimension(10):: lheader real, dimension(10) :: rheader real(doub_prec), dimension(10) :: dheader character(len=100) :: headerstring character(len=10), dimension(maxplot) :: cheader real, dimension(:,:), allocatable :: dattemp real(doub_prec), dimension(:,:), allocatable :: dattempd common /chead/ cheader iunit = 11 ! file unit number nstepsread = 0 if (rootname(1:1).ne.' ') then datfile = trim(rootname) !print*,'rootname = ',rootname else print*,' **** no data read **** ' return endif print "(1x,a)",'reading RSPH format' write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! open(unit=iunit,iostat=ierr,file=datfile,status='old',form='unformatted') if (ierr /= 0) then print*,'*** Error opening '//trim(datfile)//' ***' return endif i = indexstart ! !--read first header line ! read(iunit,iostat=ierr,end=80) headerstring print "(1x,a)",'header string="'//trim(headerstring)//'"' ! !--read other header lines (short/normal/long ints, reals, doubles) ! read(iunit,iostat=ierr,end=80) sheader(1:10) if (ierr /= 0) then print*,'WARNING: errors during sheader read' endif print "(1x,a,10(1x,i2))",'sheader = ',sheader(1:10) isizeheader = sheader(1) ndim = sheader(2) ndimV = sheader(3) ntypes = sheader(4) ncolumns = sheader(5) + ndim ! ncolumns in sheader + positions ! !--check for errors in sheader ! if (ndim.gt.3 .or. ndimV.gt.3 .or. ndim.le.0 .or. ndimV.le.0 .or. & ncolumns.le.0 ) then print*,'*** ERROR: header corrupted: ndim = ',ndim,' ndimV = ', ndimV ndim = 0 ndimV = 0 ntypes = 0 ncolumns = 0 close(iunit) return elseif (ncolumns.gt.maxplot) then print "(1x,a)",'*** WARNING: too many columns for array limits' ncolumns = maxplot print "(1x,a,i2,a)",' reading only first ',ncolumns,' columns' endif read(iunit,iostat=ierr,end=80) iheader(1:isizeheader) if (ierr /= 0) then print*,'WARNING: errors during iheader read' endif print "(1x,a,20(1x,i6))",'iheader = ',iheader(1:isizeheader) ntoti = sum(iheader(1:ntypes)) read(iunit,iostat=ierr,end=80) lheader(1:isizeheader) if (ierr /= 0) then print*,'WARNING: errors during lheader read' endif print "(1x,a,20(1x,i6))",'lheader = ',lheader(1:isizeheader) read(iunit,iostat=ierr,end=80) rheader(1:isizeheader) if (ierr /= 0) then print*,'WARNING: errors during rheader read' endif print "(1x,a,20(1x,f8.2))",'rheader = ',rheader read(iunit,iostat=ierr,end=80) dheader(1:isizeheader) if (ierr /= 0) then print*,'WARNING: errors during dheader read' endif print "(1x,a,20(1x,1pe8.2))",'dheader = ',dheader(1:isizeheader) do icol=1,ncolumns-ndim read(iunit,iostat=ierr,end=80) cheader(icol)(1:isizeheader) enddo ! print "(a)",(trim(cheader(icol)),icol=1,ncolumns-ndim) ! !--allocate/reallocate memory for data arrays ! if (buffer_data) then nstep_max = max(nfiles,maxstep,indexstart) else nstep_max = max(1,maxstep,indexstart) endif npart_max = max(int(2.0*ntoti),maxpart) if (.not.allocated(dat) .or. ntoti.gt.maxpart & .or. nstep_max.gt.maxstep .or. ncolumns.gt.maxcol) then call alloc(npart_max,nstep_max,ncolumns+ncalc) endif ! !--count this as a successful read ! nstepsread = nstepsread + 1 ! !--copy header data into now-allocated arrays ! npartoftype(1,i) = iheader(1) npartoftype(2,i) = iheader(2) npartoftype(3,i) = iheader(3) ntoti = sum(npartoftype(1:ntypes,i)) ! !--determine whether dump is single or double precision ! singleprecision = .true. if (all(abs(rheader(1:isizeheader)).lt.tiny(rheader))) then singleprecision = .false. print "(1x,a)",'double precision dump' time(i) = real(dheader(1)) print*,'particles per smoothing length = ',dheader(2) print*,'kernel range = ',dheader(3) gamma(i) = real(dheader(4)) else print "(1x,a)",'single precision dump' time(i) = rheader(1) print*,'particles per smoothing length = ',rheader(2) print*,'kernel range = ',rheader(3) gamma(i) = rheader(4) endif hfact = 0. print "(/a14,':',f8.4,a8,':',i8,a8,':',i8)",' time',time(i),'npart',npartoftype(1,i),'ntotal',ntoti print "(a14,':',i8,a8,':',f8.4,a8,':',f8.4)",' ncolumns',ncolumns,'gamma',gamma(i),'hfact',hfact print "(a14,':',i8,a8,':',i8)",'ndim',ndim,'ndimV',ndimV ! !--read data arrays ! if (singleprecision) then if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(ndim,ntoti)) ! !--read positions of all particles ! read(iunit,iostat=ierr) dattemp(1:ndim,1:ntoti) if (ierr /=0 ) then print "(a)",'error reading particle positions' else do icol=1,ndim dat(1:ntoti,icol,i) = dattemp(icol,1:ntoti) enddo endif ! !--read rest of data columns ! do icol=ndim+1,ncolumns read(iunit,iostat=ierr) dat(1:ntoti,icol,i) if (ierr /= 0) print "(a,i2)", 'error reading column ',icol enddo else if (allocated(dattempd)) deallocate(dattempd) allocate(dattempd(ndim,ntoti)) ! !--read positions of all particles ! read(iunit,iostat=ierr) dattempd(1:ndim,1:ntoti) if (ierr /=0 ) then print "(a)",'error reading particle positions' else do icol=1,ndim dat(1:ntoti,icol,i) = real(dattempd(icol,1:ntoti)) enddo endif ! !--read rest of data columns ! do icol=ndim+1,ncolumns read(iunit,iostat=ierr) dattempd(1,1:ntoti) if (ierr /= 0) print "(a,i2)", 'error reading column ',icol !--convert to single precision dat(1:ntoti,icol,i) = real(dattempd(1,1:ntoti)) enddo endif if (allocated(dattemp)) deallocate(dattemp) if (allocated(dattempd)) deallocate(dattempd) ! !--close data file and return ! close(unit=iunit) print "(a)",' finished data read ' return 80 continue print*,' *** data file empty : no timesteps ***' return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:ix,ivx,ih,irho,iutherm,ipmass,ipr,iBfirst, & iamvec,labelvec,label,labeltype use params use settings_data, only:ndim,ndimV,ncolumns,ntypes, & UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i,j character(len=10), dimension(maxplot) :: cheader common /chead/ cheader if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo do i=ndim+1,ncolumns label(i) = cheader(i-ndim) !--blank characters in c are ascii zero - correct these to spaces do j=1,len(label(i)) if (iachar(label(i)(j:j)).eq.0) label(i)(j:j) = ' ' enddo !--set positions of various quantities depending on labels if (label(i)(1:1)=='m' .or. label(i)(1:4)=='mass') then ipmass = i elseif (label(i)(1:3)=='rho' .or. label(i)(1:4)=='dens') then irho = i elseif (label(i)(1:1)=='h' .or. label(i)(1:6)=='smooth') then ih = i elseif (label(i)(1:2)=='u ' .or. label(i)(1:1)=='e') then iutherm = i elseif (label(i)(1:2)=='pr' .or. trim(label(i))=='P') then ipr = i elseif (label(i)(1:1)=='v') then if (ivx.eq.0 .or. i.lt.ivx) ivx = i elseif (label(i)(1:1)=='B') then if (iBfirst.eq.0 .or. i.lt.iBfirst) iBfirst = i endif enddo label(ix(1:ndim)) = labelcoord(1:ndim,1) ! !--label vector quantities (e.g. velocity) appropriately ! if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx+i-1))//'\d'//labelcoord(i,1) enddo endif if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' endif ! !--set labels for each type of particles ! labeltype(1) = 'gas' UseTypeInRenderings(1) = .true. if (ntypes.ge.2) then labeltype(2) = 'auxiliary' UseTypeInRenderings(2) = .true. endif if (ntypes.ge.3) then labeltype(3) = 'mirror' UseTypeInRenderings(3) = .true. endif !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_scw.f90000644 000770 000000 00000021740 11622211702 016635 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM MATTHEW BATE'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns use mem_allocation implicit none integer, intent(IN) :: indexstart integer, intent(OUT) :: nstepsread character(LEN=*), intent(IN) :: rootname integer, parameter :: maxptmass = 100 integer :: i,j,ifile,ierr integer :: npart_max, nstep_max logical :: iexist character(LEN=3) :: fileno character(LEN=LEN(rootname)+10) :: dumpfile integer :: nprint, n1, n2, nptmass integer, dimension(:), allocatable :: isteps, iphase integer, dimension(maxptmass) :: listpm real(doub_prec), dimension(:,:), allocatable :: dattemp real(doub_prec), dimension(:), allocatable :: dummy real(doub_prec) :: udisti,umassi,utimei, timei, gammai real(doub_prec) :: escap,tkin,tgrav,tterm,trad real(doub_prec) :: dtmax, rhozero, RK2 nstepsread = 0 ierr = 0 nstep_max = 0 npart_max = 0 ifile = 0 ! !--for rootnames without the '00', read all files starting at #1 ! if (len_trim(rootname).lt.7) then ifile = 1 if (len_trim(rootname).eq.4) then write(fileno,"(i1,i1,i1)") ifile/100,mod(ifile,100)/10,mod(ifile,10) dumpfile = rootname(1:4)//fileno elseif (len_trim(rootname).eq.5) then write(fileno,"(i1,i1)") ifile/10,mod(ifile,10) dumpfile = rootname(1:5)//trim(fileno) endif else dumpfile = trim(rootname) endif ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: ',trim(dumpfile),' file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 ncolumns = 15 ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 print "(1x,a)",'reading Stuart Whitehouse''s modified Bate-code format' do while (iexist) write(*,"(23('-'),1x,a,1x,23('-'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,file=dumpfile,status='old',form='unformatted') ! !--read the number of particles in the first step, ! allocate memory and rewind ! read(15,end=55,iostat=ierr) udisti,umassi,utimei,nprint if (ierr /= 0) then print "(a)",'*** ERROR reading timestep header ***' close(15) return endif print*,'nprint = ',nprint if (.not.allocated(dat) .or. nprint.gt.npart_max) then npart_max = max(npart_max,INT(1.1*nprint)) call alloc(npart_max,nstep_max,ncolumns) endif rewind(15) ! !--loop over the timesteps in this file ! over_steps_in_file: do npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+10,maxcol) endif ! !--allocate a temporary array for double precision variables ! if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(npart_max,ncolumns)) ! !--allocate a dummy arrays for data I want to throw away ! if (allocated(dummy)) deallocate(dummy) allocate(dummy(npart_max)) if (allocated(isteps)) deallocate(isteps) allocate(isteps(npart_max)) if (allocated(iphase)) deallocate(iphase) allocate(iphase(npart_max)) ! !--now read the timestep data in the dumpfile ! read(15,end=55,iostat=ierr) udisti, umassi, utimei, & nprint, n1, n2, timei, gammai, rhozero, RK2, & (dattemp(i,7), i=1, nprint), & escap, tkin, tgrav, tterm, trad, & (dattemp(i,1), i=1, nprint), (dattemp(i,2), i=1, nprint), & (dattemp(i,3), i=1, nprint), (dattemp(i,4), i=1, nprint), & (dattemp(i,5), i=1, nprint), (dattemp(i,6), i=1, nprint), & (dattemp(i,8), i=1, nprint), (dattemp(i,9), i=1, nprint), & (dattemp(i,10), i=1, nprint), (dattemp(i,11), i=1, nprint), & (dattemp(i,12), i=1, nprint), (dattemp(i,13), i=1, nprint), & (dattemp(i,14), i=1, nprint), (dattemp(i,15), i=1, nprint), & (dummy(i),i=1,nprint), & dtmax, (isteps(i), i=1,nprint), (iphase(i),i=1,nprint), & nptmass, (listpm(i), i=1,nptmass) if (ierr /= 0) then print "(a)",'*** ERROR READING TIMESTEP ***' cycle over_steps_in_file else nstepsread = nstepsread + 1 endif ! !--convert to single precision ! print *,'step ',j,': ntotal = ',nprint print "(a)",' converting to single precision... ' dat(1:nprint,1:ncolumns,j) = real(dattemp(1:nprint,1:ncolumns)) deallocate(dattemp) deallocate(dummy) deallocate(isteps) deallocate(iphase) npartoftype(1,j) = nprint npartoftype(2:maxparttypes,j) = 0 gamma(j) = real(gammai) time(j) = real(timei) j = j + 1 enddo over_steps_in_file 55 continue ! !--reached end of file ! close(15) print*,'>> end of dump file: nsteps =',j-1,'ntot = ',sum(npartoftype(:,j-1)) ! !--if just the rootname has been input, ! set next filename and see if it exists ! ifile = ifile + 1 if (len_trim(rootname).eq.4) then write(fileno,"(i1,i1,i1)") ifile/100,mod(ifile,100)/10,mod(ifile,10) dumpfile = rootname(1:4)//fileno inquire(file=dumpfile,exist=iexist) elseif (len_trim(rootname).eq.5) then write(fileno,"(i1,i1)") ifile/10,mod(ifile,10) dumpfile = rootname(1:5)//trim(fileno) inquire(file=dumpfile,exist=iexist) else iexist = .false. ! exit loop endif enddo return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ih = 7 ! smoothing length label(ih) = 'h' iutherm = 8 ! thermal energy label(iutherm) = 'u' label(9) = 'e' ipmass = 10 ! particle mass label(ipmass) = 'particle mass' label(11) = 'rkappa' label(12) = 'cv' irho = 13 ! location of rho in data array label(irho) = '\gr' label(14) = 'rlambda' label(15) = 'eddington factor' label(ix(1:ndim)) = labelcoord(1:ndim,1) do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 1 !!maxparttypes labeltype(1) = 'gas' labeltype(2) = 'ghost' labeltype(3) = 'sink' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_seren.f90000644 000770 000000 00000156503 12160267416 017176 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR OUTPUT FROM THE SEREN CODE ! HANDLES BOTH ASCII AND BINARY FILES ! ! THE FOLLOWING ENVIRONMENT VARIABLES AFFECT THIS FORMAT: ! ! DSPLASH_EXTRACOLS : set to number of extra columns to read (after itype) ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Partial data read implemented means that columns with ! the 'required' flag set to false are not read (read is therefore much faster) !------------------------------------------------------------------------- module seren_data_store implicit none integer :: seren_maxparttypes ! Number of types we are using character(len=20) :: format_id ! File format (for verification) integer :: nunits ! Number of units integer :: ndata ! Number of data entries integer :: ptot, stot ! Number of particles/sinks integer :: pboundary, picm, pgas ! Number of each type of particle integer :: pcdm, pdust, pion ! Number of each type of particle integer :: PR, NDIMtemp, VDIMtemp, BDIMtemp ! Important parameters integer :: dmdt_range ! DMDT_RANGE character(len=20) :: data_id(1:500) ! Char ids of arrays written character(len=20) :: unit_data(1:500) ! Unit data real :: unit_coeff(1:500) ! Unit multiplier integer :: typedata(1:5,1:500) ! type data header array integer :: itemp, iporig ! Since SPLASH does not have one integer :: iunknown(1:1000) ! For unknown data types character(len=20) :: r_unit ! length unit character(len=20) :: m_unit ! mass unit character(len=20) :: rho_unit ! density unit character(len=20) :: h_unit ! smoothing length unit integer, parameter :: DP = selected_real_kind(p=15) ! double precision integer, parameter :: SP = selected_real_kind(p=6) ! single precision integer, parameter :: ILP = selected_int_kind(r=15) ! Integer long precision ! Length units in metres real(kind=DP),parameter :: r_pc = 3.08568E16_DP ! parsec real(kind=DP),parameter :: r_au = 1.49597870E11_DP ! astronomical unit real(kind=DP),parameter :: r_sun = 6.96E8_DP ! solar radius real(kind=DP),parameter :: r_earth = 6.371E6_DP ! Earth radius ! Mass units in kilograms real(kind=DP),parameter :: m_sun = 1.98892E30_DP ! solar mass real(kind=DP),parameter :: m_jup = 1.8986E27_DP ! Jupiter mass real(kind=DP),parameter :: m_earth = 5.9736E24_DP ! Earth mass ! Time units in seconds real(kind=DP),parameter :: myr = 3.1556952E13_DP ! megayear real(kind=DP),parameter :: yr = 3.1556952E7_DP ! year real(kind=DP),parameter :: day = 8.64E4_DP ! day end module seren_data_store subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,iamtype,npartoftype,time,gamma,maxpart,maxcol,maxstep use params use settings_data, only:ndim,ndimV,ncolumns,ncalc,ipartialread,ntypes use settings_units, only:unitzintegration, unit_interp use mem_allocation, only:alloc use labels, only:labeltype,labelzintegration use system_utils, only:ienvironment use seren_data_store implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile integer, parameter :: iunit = 16 integer :: i,step,ierr,iambinaryfile,itype integer :: npart_max,nstep_max logical :: iexist,reallocate,doubleprec character(len=50) :: string integer :: idata(1:50) integer (kind=ILP) :: ilpdata(1:50) real :: rdata(1:50) real(doub_prec) :: rdata_dp(1:50) real(doub_prec) :: dpdata(1:50) real :: timetemp,gammatemp unit_coeff = 1. ! not yet used m_unit = "" rho_unit = "" h_unit = "" !iRescale = .TRUE. ipartialread = .false. ! we always read full data file seren_maxparttypes = min(maxparttypes,7) nstepsread = 0 if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(datfile)//': file not found ***' return endif ! !--read data from snapshots ! step = istepstart write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open data file and read data ! ! !--determine whether file is binary or ascii, open it and read the header ! ! Try binary first, then ascii open(unit=iunit,file=datfile,status='old',form='unformatted',iostat=ierr) if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(datfile)//' ***' return endif ! !--read the file header ! try binary format first, and if unsuccessful try ascii ! read (unit=iunit,iostat=ierr) format_id if (ierr /= 0 .OR. trim(adjustl(format_id)) /= "SERENBINARYDUMPV2") then ! Ascii format iambinaryfile = 0 close (unit=iunit) open(unit=iunit,file=datfile,status='old',form='formatted',iostat=ierr) if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(datfile)//' AS ASCII ***' return endif rewind(unit=iunit) read (unit=iunit,fmt=*,iostat=ierr) format_id if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(datfile)//' - UNKNOWN FILE FORMAT '//format_id//' ***' return endif if (trim(adjustl(format_id)) /= "SERENASCIIDUMPV2") then print "(a)",'*** ERROR OPENING '//trim(datfile)//' AS ASCII - WRONG FILE FORMAT ***' return end if else iambinaryfile = 1 end if if (iambinaryfile==1) then print "(a)",' reading binary seren v2 format ' read (iunit) PR read (iunit) NDIMtemp read (iunit) VDIMtemp read (iunit) BDIMtemp else print "(a)",' reading ascii seren v2 format ' read (iunit,*) PR read (iunit,*) NDIMtemp read (iunit,*) VDIMtemp read (iunit,*) BDIMtemp end if if (iambinaryfile==0) then ! Don't care about precision doubleprec = .FALSE. else if (PR == 8 .OR. PR == 2) then ! Double precision file print "(a)",' Double precision file' doubleprec = .TRUE. else if (PR == 4 .OR. PR == 1) then ! Single precision file print "(a)",' Single precision file' doubleprec = .FALSE. else print "(a)",'*** WARNING OPENING '//trim(datfile)//' - ASSUMING SINGLE PRECISION ***' doubleprec = .FALSE. end if typedata = 0 if (iambinaryfile.eq.1) then call read_serenheader_binary(iunit) else if (iambinaryfile.eq.0) then call read_serenheader_ascii(iunit) end if ! !--get values of quantities from the header ! ndim = NDIMtemp ndimv = VDIMtemp ptot = idata(1) stot = idata(2) pboundary = idata(3) picm = idata(4) pgas = idata(5) pcdm = idata(6) pdust = idata(7) pion = idata(8) dmdt_range = idata(30) !--check for errors in integer header (either from corrupt file or wrong endian) if (ptot+stot.le.0 .or. ptot+stot.gt.1.e10) then if (iambinaryfile.eq.1) then print "(a)",' ERROR reading binary file header: wrong endian? ' else print "(a)",' ERROR reading ascii file header ' endif close(unit=iunit) return endif timetemp = real(dpdata(1)) gammatemp = 1. ! Not saved in file print*,'time : ',timetemp print*,'gamma : ',gammatemp print*,'n_total : ',ptot call set_labels ! !--if successfully read header, increment the nstepsread counter ! nstepsread = nstepsread + 1 ! !-- now work out dimensionless weight unit and z integration unit ! call find_weights(unit_interp,unitzintegration,labelzintegration) ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if ((ptot+stot).gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*(ptot+stot)) else ! if first time, save on memory npart_max = int(ptot+stot) endif endif if (step.ge.maxstep .and. step.ne.1) then nstep_max = step + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol),mixedtypes=.true.) endif ! !--copy header into header arrays ! npartoftype(:,step) = 0 ! npartoftype(1,step) = ptot time(step) = timetemp gamma(step) = gammatemp ! !--read particle data ! if (ptot.gt.0) then ! if (iambinaryfile.eq.1) then ! call read_dragonbody_binary(iunit,ierr) ! else ! call read_dragonbody_ascii(iunit,ierr) ! endif call read_serenbody(iunit,ierr) else ptot = 0 ! npartoftype(1,step) = 0 ! npartoftype(:,step) = 0 dat(:,:,step) = 0. endif ! if (allocated(iamtype)) then ! !--relabel particle types call set_types(iamtype(:,step),ptot+stot,npartoftype(:,step)) ! endif if (any(npartoftype(2:,step).ne.0)) then do itype=1,ntypes if (npartoftype(itype,step).gt.0) then string = ' ' write(string,"(a)") 'n_'//trim(labeltype(itype)) write(string(18:len(string)),"(a)") ':' print*,trim(string),' ',npartoftype(itype,step) endif enddo endif ! ! ! !--set flag to indicate that only part of this file has been read ! ! ! if (.not.all(required(1:ncolumns))) ipartialread = .true. ! !--close data file and return ! close(unit=iunit) return contains !---------------------------------------------------- ! binary header read !---------------------------------------------------- subroutine read_serenheader_binary(iunitb) implicit none integer, intent(in) :: iunitb read (iunitb,end=55) idata read (iunitb,end=55) ilpdata if (doubleprec) then read (iunitb,end=55) rdata_dp else read (iunitb,end=55) rdata endif read (iunitb,end=55) dpdata ndata = idata(21) nunits = idata(20) if (nunits > 0) read (iunitb) unit_data(1:nunits) if (ndata > 0) read (iunitb) data_id(1:ndata) if (ndata > 0) read (iunitb) typedata(1:5,1:ndata) return 55 continue print "(a)",' ERROR: end of file in binary header read' stop !return end subroutine read_serenheader_binary !---------------------------------------------------- ! ascii header read !---------------------------------------------------- subroutine read_serenheader_ascii(iunita) implicit none integer, intent(in) :: iunita do i=1,size(idata) read (iunita,*,end=55) idata(i) end do do i=1,size(ilpdata) read (iunita,*,end=55) ilpdata(i) end do do i=1,size(rdata) read (iunita,*,end=55) rdata(i) end do do i=1,size(dpdata) read (iunita,*,end=55) dpdata(i) end do ndata = idata(21) nunits = idata(20) do i=1,nunits read (iunita,'(A)') unit_data(i) end do do i=1,ndata read (iunita,'(A)') data_id(i) end do do i=1,ndata read (iunita,*) typedata(1:5,i) end do return 55 continue print "(a)",' ERROR: end of file in ascii header read' stop !return end subroutine read_serenheader_ascii !---------------------------------------------------- ! body read !---------------------------------------------------- subroutine read_serenbody(iunit,ierr_out) use seren_data_store use labels, only:ix,ivx,ipmass,ih,irho,iBfirst,iutherm implicit none integer, intent(in) :: iunit integer, intent(out) :: ierr_out integer :: ierr, ierr1 integer :: j, k integer, dimension(:), allocatable :: dummy_int integer, dimension(:,:), allocatable :: dummy_int_2D real(kind=SP), dimension(:,:), allocatable :: dummy real(kind=DP), dimension(:,:), allocatable :: dummy_dp real(kind=SP), dimension(:), allocatable :: dummy_scalar real(kind=DP), dimension(:), allocatable :: dummy_dp_scalar integer(kind=ILP), dimension(:), allocatable :: dummy_ilp_int logical, dimension(:), allocatable :: dummy_logical integer(kind=ILP), dimension(:,:), allocatable :: dummy_ilp_int_2D logical, dimension(:,:), allocatable :: dummy_logical_2D logical :: ldummy(1:2) integer :: idummy2(1:2) real(kind=SP), allocatable :: raux(:) real(kind=DP), allocatable :: raux_dp(:) real, allocatable :: sink_dat_array(:,:,:) integer :: s integer :: unknown integer :: pfirst integer :: plast integer :: width integer :: typecode integer :: unit_id integer :: sink_data_length character(len=30) :: sink_format_string character(len=50) :: format_string integer :: nl,ni,nli,npr,ndp,nchar logical, allocatable :: l_data_st(:) integer, allocatable :: i_data_st(:) integer(kind=ILP), allocatable :: ilp_data_st(:) real(kind=SP), allocatable :: sp_data_st(:) real(kind=DP), allocatable :: dp_data_st(:) real(kind=DP), allocatable :: dp_data_st2(:) unknown = 0 if (stot>0) then sink_data_length = 11+NDIMtemp+VDIMtemp+2*dmdt_range allocate(raux(1:sink_data_length)) if (doubleprec) allocate(raux_dp(1:sink_data_length)) allocate(sink_dat_array(1:stot,1:ncolumns,1)) sink_dat_array = 0. write (sink_format_string,'(A,I0,A)') "(", sink_data_length, "E18.10)" end if ierr_out = 0 allocate(dummy_int(1:ptot),stat=ierr) if (ierr /= 0) then print *,' ERROR allocating memory' goto 56 endif if (doubleprec) allocate(dummy_dp_scalar(1:ptot),stat=ierr) if (ierr /= 0) then print *,' ERROR allocating memory' goto 56 endif allocate(dummy_scalar(1:ptot),stat=ierr) if (ierr /= 0) then print *,' ERROR allocating memory' goto 56 endif write (6,'(A,A)',ADVANCE="NO") "Loading: " do i=1,ndata if (i==1) then write (6,'(A)',ADVANCE="NO") trim(data_id(i)) else write (6,'(A,A)',ADVANCE="NO") ", ", trim(data_id(i)) end if select case (trim(data_id(i))) case ("porig") ! Original particle number ! Read through porig numbers pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) dummy_int(pfirst:plast) else do k=pfirst,plast read(iunit,fmt=*,end=55,iostat=ierr1) dummy_int(k) if (ierr1 /= 0) ierr = ierr1 end do end if if (ierr /= 0) then print*,' WARNING: errors reading through porig ' ierr_out = -1 end if do k=pfirst,plast dat(k,iporig,step) = real(dummy_int(k)) enddo if (ierr /= 0) then print*,' WARNING: errors reading unknown data type ', trim(data_id(i)) ierr_out = -1 end if case ("r") ! Position if (doubleprec) allocate(dummy_dp(1:NDIMtemp,1:ptot),stat=ierr) allocate(dummy(1:NDIMtemp,1:ptot),stat=ierr) pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp(1:NDIMtemp,pfirst:plast) dummy(1:NDIMtemp,pfirst:plast) = real(dummy_dp(1:NDIMtemp,pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy(1:NDIMtemp,pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy(1:NDIMtemp,k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,ix(1):ix(1)+NDIMtemp-1,step) = dummy(1:NDIMtemp,k) enddo if (ierr /= 0) then print*,' WARNING: errors reading positions ' ierr_out = -1 end if deallocate(dummy) if (doubleprec) deallocate(dummy_dp) case ("h") ! Smoothing lengths pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp_scalar(pfirst:plast) dummy_scalar(pfirst:plast) = real(dummy_dp_scalar(pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy_scalar(pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_scalar(k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,ih,step) = dummy_scalar(k) enddo if (ierr /= 0) then print*,' WARNING: errors reading smoothing lengths' ierr_out = -1 end if case ("m") ! Mass pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp_scalar(pfirst:plast) dummy_scalar(pfirst:plast) = real(dummy_dp_scalar(pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy_scalar(pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_scalar(k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,ipmass,step) = dummy_scalar(k) enddo if (ierr /= 0) then print*,' WARNING: errors reading masses' ierr_out = -1 end if case ("v") ! Velocities if (doubleprec) allocate(dummy_dp(1:VDIMtemp,1:ptot),stat=ierr) allocate(dummy(1:VDIMtemp,1:ptot),stat=ierr) pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp(1:VDIMtemp,pfirst:plast) dummy(1:VDIMtemp,pfirst:plast) = real(dummy_dp(1:VDIMtemp,pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy(1:VDIMtemp,pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy(1:VDIMtemp,k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,ivx:ivx+VDIMtemp-1,step) = dummy(1:VDIMtemp,k) enddo if (ierr /= 0) then print*,' WARNING: errors reading velocities ' ierr_out = -1 end if deallocate(dummy) if (doubleprec) deallocate(dummy_dp) case ("rho") ! Densities pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp_scalar(pfirst:plast) dummy_scalar(pfirst:plast) = real(dummy_dp_scalar(pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy_scalar(pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_scalar(k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,irho,step) = dummy_scalar(k) enddo if (ierr /= 0) then print*,' WARNING: errors reading densities' ierr_out = -1 end if case ("temp") ! Temperatures pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp_scalar(pfirst:plast) dummy_scalar(pfirst:plast) = real(dummy_dp_scalar(pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy_scalar(pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_scalar(k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,itemp,step) = dummy_scalar(k) enddo if (ierr /= 0) then print*,' WARNING: errors reading temperatures' ierr_out = -1 end if case ("u") ! Internal energy pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp_scalar(pfirst:plast) dummy_scalar(pfirst:plast) = real(dummy_dp_scalar(pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy_scalar(pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_scalar(k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,iutherm,step) = dummy_scalar(k) enddo if (ierr /= 0) then print*,' WARNING: errors reading internal energy' ierr_out = -1 end if case ("B") ! Magnetic fields if (doubleprec) allocate(dummy_dp(1:BDIMtemp,1:ptot),stat=ierr) allocate(dummy(1:BDIMtemp,1:ptot),stat=ierr) pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp(1:BDIMtemp,pfirst:plast) dummy(1:BDIMtemp,pfirst:plast) = real(dummy_dp(1:BDIMtemp,pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy(1:BDIMtemp,pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy(1:BDIMtemp,k) if (ierr1 /= 0) ierr = ierr1 end do end if do k=pfirst,plast dat(k,iBfirst:iBfirst+BDIMtemp-1,step) = dummy(1:BDIMtemp,k) enddo if (ierr /= 0) then print*,' WARNING: errors reading magnetic fields' ierr_out = -1 end if deallocate(dummy) if (doubleprec) deallocate(dummy_dp) case ("sink_v1") ! Load sinks in sink data storage, will add them later pfirst = typedata(2,i); plast = typedata(3,i) if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) nl,ni,nli,npr,ndp,nchar else read(iunit,fmt=*,end=55,iostat=ierr) nl,ni,nli,npr,ndp,nchar end if do s=pfirst,plast if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) ldummy read(iunit,end=55,iostat=ierr) idummy2 if (doubleprec) then read(iunit,end=55,iostat=ierr) raux_dp raux = real(raux_dp) else read(iunit,end=55,iostat=ierr) raux end if else read(iunit,'(2L1)',end=55,iostat=ierr) ldummy read(iunit,fmt=*,end=55,iostat=ierr) idummy2 read(iunit,sink_format_string) raux(1:sink_data_length) end if if (ix(1)/=0) sink_dat_array(s,ix(1):ix(NDIMtemp),1) = raux(2:NDIMtemp+1) if (ivx/=0) sink_dat_array(s,ivx:ivx+VDIMtemp-1,1) = raux(NDIMtemp+2:NDIMtemp+VDIMtemp+1) if (ipmass/=0) sink_dat_array(s,ipmass,1) = raux(NDIMtemp+VDIMtemp+2) if (ih/=0) sink_dat_array(s,ih,1) = raux(NDIMtemp+VDIMtemp+3) if (itemp/=0) sink_dat_array(s,itemp,1) = raux(NDIMtemp+VDIMtemp+11) end do case default !print*,' WARNING: unknown data type ', trim(data_id(i)) ! Assume this is an unknown data type !ierr_out = -4 width = typedata(1,i) pfirst = typedata(2,i); plast = typedata(3,i) typecode = typedata(4,i); unit_id = typedata(5,i) unknown = unknown + 1 if (typecode == 7) then ! Special data structure we don't understand; read and skip if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) nl,ni,nli,npr,ndp,nchar else read(iunit,fmt=*,end=55,iostat=ierr) nl,ni,nli,npr,ndp,nchar end if if (nchar > 0) stop "Fail! character data :(" if (nl > 0) allocate(l_data_st(1:nl)) if (ni > 0) allocate(i_data_st(1:ni)) if (nli > 0) allocate(ilp_data_st(1:nli)) if (npr > 0) then allocate(sp_data_st(1:npr)) if (doubleprec) allocate(dp_data_st(1:npr)) end if if (ndp > 0) allocate(dp_data_st2(1:ndp)) if (iambinaryfile==1) then do j=pfirst, plast if (nl > 0) read(iunit,end=55,iostat=ierr) l_data_st if (ni > 0) read(iunit,end=55,iostat=ierr) i_data_st if (nli > 0) read(iunit,end=55,iostat=ierr) ilp_data_st if (npr > 0) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dp_data_st else read(iunit,end=55,iostat=ierr) sp_data_st end if end if if (ndp > 0) read(iunit,end=55,iostat=ierr) dp_data_st2 end do else do j=pfirst, plast if (nl > 0) then write (format_string,'(A,I0,A)') "(",nl,"L1)" read(iunit,end=55,iostat=ierr,fmt=format_string) l_data_st end if if (ni > 0) then read(iunit,end=55,iostat=ierr,fmt=*) i_data_st end if if (nli > 0) then read(iunit,end=55,iostat=ierr,fmt=*) ilp_data_st end if if (npr > 0) then if (doubleprec) then read(iunit,end=55,iostat=ierr,fmt=*) dp_data_st else read(iunit,end=55,iostat=ierr,fmt=*) sp_data_st end if end if if (ndp > 0) then read(iunit,end=55,iostat=ierr,fmt=*) dp_data_st2 end if end do end if if (ierr /= 0) then print*,' WARNING: errors reading unknown data structure ', trim(data_id(i)) ierr_out = -1 end if if (allocated(i_data_st)) deallocate(i_data_st) if (allocated(ilp_data_st)) deallocate(ilp_data_st) if (allocated(sp_data_st)) deallocate(sp_data_st) if (allocated(dp_data_st)) deallocate(dp_data_st) if (allocated(dp_data_st2)) deallocate(dp_data_st2) else if (typecode == 6) then ! Character data; read and skip stop "Fail! character data :(" ! I have realised this was a silly idea ! If we work out how this should work, I can put it in else if (typecode >= 1 .AND. typecode <= 5) then ! 1 = logical, 2 = integer, 3 = long integer, 4 = PR, 5 = DP ! Normal data set; either scalar or vector if (width == 1) then ! Scalar data if (typecode==1) then ! Logical data array allocate(dummy_logical(1:ptot)) dummy_logical = .FALSE. if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) dummy_logical(pfirst:plast) else do k=pfirst,plast read(iunit,'(L1)',end=55,iostat=ierr1) dummy_logical(k) if (ierr1 /= 0) ierr = ierr1 end do end if where (dummy_logical) dummy_scalar=1.d0 elsewhere dummy_scalar=0.d0 end where deallocate(dummy_logical) else if (typecode==2) then ! Integer data array dummy_int = 0 if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) dummy_int(pfirst:plast) else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_int(k) if (ierr1 /= 0) ierr = ierr1 end do end if dummy_scalar(pfirst:plast) = real(dummy_int(pfirst:plast)) else if (typecode==3) then ! Long integer data array allocate(dummy_ilp_int(1:ptot)) dummy_ilp_int = 0 if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) dummy_ilp_int(pfirst:plast) else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_ilp_int(k) if (ierr1 /= 0) ierr = ierr1 end do end if dummy_scalar(pfirst:plast) = real(dummy_ilp_int(pfirst:plast)) deallocate(dummy_ilp_int) else if (typecode==4) then ! PR data array if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp_scalar(pfirst:plast) dummy_scalar(pfirst:plast) = real(dummy_dp_scalar(pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy_scalar(pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_scalar(k) if (ierr1 /= 0) ierr = ierr1 end do end if else if (typecode==5) then ! DP data array if (iambinaryfile==1) then if (.NOT.doubleprec) allocate(dummy_dp_scalar(pfirst:plast)) read(iunit,end=55,iostat=ierr) dummy_dp_scalar(pfirst:plast) dummy_scalar(pfirst:plast) = real(dummy_dp_scalar(pfirst:plast)) if (.NOT.doubleprec) deallocate(dummy_dp_scalar) else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_scalar(k) if (ierr1 /= 0) ierr = ierr1 end do end if end if do k=pfirst,plast dat(k,iunknown(unknown),step) = dummy_scalar(k) enddo if (ierr /= 0) then print*,' WARNING: errors reading unknown data type ', trim(data_id(i)) ierr_out = -1 end if else ! Vector data allocate(dummy(1:width,1:ptot),stat=ierr) if (typecode == 1) then ! Logical data array allocate(dummy_logical_2D(1:width,1:ptot)) dummy_logical_2D = .FALSE. if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) dummy_logical_2D(1:width,pfirst:plast) else write (format_string,'(A,I0,A)') "(",width,"L1)" do k=pfirst,plast read(iunit,fmt=format_string,end=55,iostat=ierr1) dummy_logical_2D(1:width,k) if (ierr1 /= 0) ierr = ierr1 end do end if where (dummy_logical_2D) dummy=1.d0 elsewhere dummy=0.d0 end where deallocate(dummy_logical_2D) else if (typecode == 2) then ! Integer data array allocate(dummy_int_2D(1:width,1:ptot)) dummy_int_2D = 0 if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) dummy_int_2D(1:width,pfirst:plast) else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_int_2D(1:width,k) if (ierr1 /= 0) ierr = ierr1 end do end if dummy(1:width,pfirst:plast) = real(dummy_int_2D(1:width,pfirst:plast)) deallocate(dummy_int_2D) else if (typecode == 3) then ! Long integer data array allocate(dummy_ilp_int_2D(1:width,1:ptot)) dummy_ilp_int_2D = 0 if (iambinaryfile==1) then read(iunit,end=55,iostat=ierr) dummy_ilp_int_2D(1:width,pfirst:plast) else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy_ilp_int_2D(1:width,k) if (ierr1 /= 0) ierr = ierr1 end do end if dummy(1:width,pfirst:plast) = real(dummy_ilp_int_2D(1:width,pfirst:plast)) deallocate(dummy_ilp_int_2D) else if (typecode == 4) then ! PR data array if (doubleprec) allocate(dummy_dp(1:width,1:ptot),stat=ierr) if (iambinaryfile==1) then if (doubleprec) then read(iunit,end=55,iostat=ierr) dummy_dp(1:width,pfirst:plast) dummy(1:width,pfirst:plast) = real(dummy_dp(1:width,pfirst:plast)) else read(iunit,end=55,iostat=ierr) dummy(1:width,pfirst:plast) end if else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy(1:width,k) if (ierr1 /= 0) ierr = ierr1 end do end if if (doubleprec) deallocate(dummy_dp) else if (typecode == 5) then ! DP data array if (iambinaryfile==1) then allocate(dummy_dp(1:width,1:ptot),stat=ierr) read(iunit,end=55,iostat=ierr) dummy_dp(1:width,pfirst:plast) dummy(1:width,pfirst:plast) = real(dummy_dp(1:width,pfirst:plast)) deallocate(dummy_dp) else do k=pfirst,plast read(iunit,*,end=55,iostat=ierr1) dummy(1:width,k) if (ierr1 /= 0) ierr = ierr1 end do end if end if do k=pfirst,plast dat(k,iunknown(unknown):iunknown(unknown)+width-1,step) = dummy(1:width,k) enddo if (ierr /= 0) then print*,' WARNING: errors reading unknown data type ', trim(data_id(i)) ierr_out = -1 end if deallocate(dummy) end if end if end select end do write (6,*) if (stot>0) then ! Load sink stuff into end of dat array dat(ptot+1:ptot+stot,1:ncolumns,step) = sink_dat_array(1:stot,1:ncolumns,1) end if return 55 continue if (iambinaryfile==1) print "(a)",' ERROR: end of file in binary read' if (iambinaryfile==0) print "(a)",' ERROR: end of file in ascii read' ierr_out = -3 return 56 continue ierr_out = -2 return end subroutine !---------------------------------------------------- ! translate types into order (for old dragon read) !---------------------------------------------------- subroutine set_types(itypei,ntotal,noftype) implicit none integer(kind=int1), dimension(:), intent(inout) :: itypei integer, intent(in) :: ntotal integer, dimension(:), intent(out) :: noftype integer :: noftype_temp(1:7) noftype = 0 noftype_temp(1) = pgas noftype_temp(2) = pboundary noftype_temp(3) = stot noftype_temp(4) = picm noftype_temp(5) = pcdm noftype_temp(6) = pdust noftype_temp(7) = pion if (sum(noftype_temp(1:7)).ne.ntotal) then print "(a)",' INTERNAL ERROR setting number in each type in dragon read' endif do i=1,7 if (i > seren_maxparttypes .AND. noftype_temp(i) > 0) then print*,' *** ERROR: not enough particle types for SEREN data read ***' print*,' *** you need to edit splash parameters and recompile ***' stop end if end do noftype(1:seren_maxparttypes) = noftype_temp(1:seren_maxparttypes) if (pboundary>0) itypei(1:pboundary) = 2 if (picm>0) itypei(pboundary+1:pboundary+picm) = 4 if (pgas>0) itypei(pboundary+picm+1:pboundary+picm+pgas) = 1 if (pcdm>0) itypei(pboundary+picm+pgas+1:pboundary+picm+pgas+pcdm) = 5 if (pdust>0) itypei(pboundary+picm+pgas+pcdm+1:pboundary+picm+pgas+pcdm+pdust) = 6 if (pion>0) itypei(pboundary+picm+pgas+pcdm+pdust+1:ptot) = 7 if (stot>0) itypei(ptot+1:ptot+stot) = 3 return end subroutine set_types end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,unitslabel,& &ix,ivx,ipmass,ih,irho,iBfirst,iutherm,lenlabel,lenunitslabel use params use settings_data, only:ndim,ndimV,ncolumns,ntypes,UseTypeInRenderings use geometry, only:labelcoord use settings_units, only:units use seren_data_store implicit none integer :: i, j, width, unit_no integer :: nunknown ! Number of unknown data types character(len=lenunitslabel) :: unit_base, unit_string character(len=lenlabel) :: type_names(1:7) logical :: type_use_render(1:7) if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif ! Calculate number of columns to read iporig = 0 ncolumns = 0 nunknown = 0 do i=1,ndata unit_no = typedata(5,i) !write (6,*) "i = ", i, "; data_id(i) = ", data_id(i) unit_base = "" unit_string = "" if (unit_no < 0 .OR. unit_no > nunits) then print*,'*** ERROR: unit_no = ',unit_no,' in set_labels ***' else if (unit_no /= 0) then unit_base = trim(adjustl(unit_data(unit_no))) unit_string = unit_base call translate_unit_names(unit_string) unit_string = ' ['//trim(adjustl(unit_string))//']' end if !write (6,*) "unit_base, unit_string = ", unit_base, unit_string select case (trim(data_id(i))) case ("porig") ! Original particle number iporig = -1 ! We always want this last case ("r") ! Position do j=1,NDIMtemp ix(j) = ncolumns + j units(ix(j)) = unit_coeff(ix(j)) unitslabel(ix(j)) = unit_string end do ! unitzintegration = units(ix(1)) ! labelzintegration = ' ['//trim(adjustl(unit_string))//']' label(ix(1:ndim)) = labelcoord(1:ndim,1) ncolumns = ncolumns + NDIMtemp r_unit = trim(adjustl(unit_base)) case ("h") ! Smoothing lengths ih = ncolumns + 1 units(ih) = unit_coeff(ih) unitslabel(ih) = unit_string label(ih) = 'h' ncolumns = ncolumns + 1 h_unit = trim(adjustl(unit_base)) case ("m") ! Mass ipmass = ncolumns + 1 units(ipmass) = unit_coeff(ipmass) unitslabel(ipmass) = unit_string label(ipmass) = 'particle mass' ncolumns = ncolumns + 1 m_unit = trim(adjustl(unit_base)) case ("v") ! Velocities ivx = ncolumns + 1 iamvec(ivx:ivx+VDIMtemp-1) = ivx labelvec(ivx:ivx+VDIMtemp-1) = 'v' do j=1,VDIMtemp label(ivx+j-1) = 'v\d'//labelcoord(j,1) units(ivx+j-1) = unit_coeff(ivx+j-1) unitslabel(ivx+j-1) = unit_string enddo ncolumns = ncolumns + VDIMtemp case ("rho") ! Densities irho = ncolumns + 1 units(irho) = unit_coeff(irho) unitslabel(irho) = unit_string label(irho) = 'density' ncolumns = ncolumns + 1 rho_unit = trim(adjustl(unit_base)) case ("temp") ! Temperatures itemp = ncolumns + 1 ! NOT A PROPER SPLASH i_quantity units(itemp) = unit_coeff(itemp) unitslabel(itemp) = unit_string label(ncolumns + 1) = 'temperature' ncolumns = ncolumns + 1 case ("u") ! Internal energy iutherm = ncolumns + 1 units(iutherm) = unit_coeff(iutherm) unitslabel(iutherm) = unit_string label(ncolumns + 1) = 'internal energy' ncolumns = ncolumns + 1 case ("B") ! Magnetic fields iBfirst = ncolumns + 1 iamvec(iBfirst:iBfirst+BDIMtemp-1) = iBfirst labelvec(iBfirst:iBfirst+BDIMtemp-1) = 'B' do j=1,BDIMtemp label(iBfirst+j-1) = 'B\d'//labelcoord(j,1) units(iBfirst+j-1) = unit_coeff(iBfirst+j-1) unitslabel(iBfirst+j-1) = unit_string enddo ncolumns = ncolumns + BDIMtemp case ("sink_v0") ! Do nothing yet, sinks are stored separately case ("sink_v1") ! Do nothing yet, sinks are stored separately case default print*,' WARNING reading file: unknown data type ', trim(data_id(i)) if (typedata(4,i) == 7) cycle ! Special data module we don't understand; ignore if (typedata(4,i) == 6) cycle ! Not a lot we can do with character data here! width = typedata(1,i) nunknown = nunknown + 1 iunknown(nunknown) = ncolumns + 1 ! NOT A PROPER SPLASH i_quantity if (width == 1) then label(iunknown(nunknown)) = trim(data_id(i)) units(iunknown(nunknown)) = unit_coeff(iunknown(nunknown)) unitslabel(iunknown(nunknown)) = unit_string else if (width <= NDIMtemp) then do j=1,width label(iunknown(nunknown)+j-1) = trim(data_id(i))//'\d'//labelcoord(j,1) units(iunknown(nunknown)+j-1) = unit_coeff(iunknown(nunknown)) unitslabel(iunknown(nunknown)+j-1) = unit_string end do else do j=1,width write(label(iunknown(nunknown)+j-1),'(A,A,I0)') trim(data_id(i)),'\d',j units(iunknown(nunknown)+j-1) = unit_coeff(iunknown(nunknown)) unitslabel(iunknown(nunknown)+j-1) = unit_string end do end if ncolumns = ncolumns + width ! Add width of data to ncolumns end select end do if (iporig == -1) then ! If there is porig, add as last column iporig = ncolumns + 1 ! NOT A PROPER SPLASH i_quantity label(ncolumns + 1) = 'particle id' ncolumns = ncolumns + 1 end if !--set labels for each particle type ! ntypes = seren_maxparttypes type_names = (/'gas ','boundary','sink ','icm ','cdm ','dust ','ion '/) type_use_render = (/.TRUE.,.TRUE.,.FALSE.,.TRUE.,.TRUE.,.TRUE.,.TRUE./) labeltype(1:ntypes) = type_names(1:ntypes) UseTypeInRenderings(1:ntypes) = type_use_render(1:ntypes) !----------------------------------------------------------- return end subroutine set_labels subroutine find_weights(out_unit_interp,out_unitzintegration,out_labelzintegration) use labels, only:lenunitslabel use params use seren_data_store implicit none real(doub_prec), intent(out) :: out_unit_interp real, intent(out) :: out_unitzintegration character(len=lenunitslabel), intent(out) :: out_labelzintegration real(doub_prec) :: dm_unit, dh_unit, drho_unit, dr_unit logical :: do_dimweight, do_zintegration character(len=lenunitslabel) :: rho_length_label real(doub_prec) :: rho_length out_unit_interp = 1.0 out_unitzintegration = 1.0 out_labelzintegration = "" do_dimweight = .TRUE. do_zintegration = .TRUE. if (m_unit=="") then print*,'No masses or no mass units!' print*,'Cannot create dimensionless weight (unnormalised rendered plots may be incorrect)' do_dimweight = .FALSE. end if if (h_unit=="") then print*,'No smoothing lengths or no smoothing length units!' print*,'Cannot create dimensionless weight (unnormalised rendered plots may be incorrect)' do_dimweight = .FALSE. end if if (rho_unit=="") then print*,'No densities or no density units!' print*,'Cannot create dimensionless weight (unnormalised rendered plots may be incorrect)' do_dimweight = .FALSE. print*,'Cannot set unitzintegration (column density plots may be incorrect)' do_zintegration = .FALSE. end if if (r_unit=="") then print*,'No positions or no position units!' print*,'Cannot set unitzintegration (column density plots may be incorrect)' do_zintegration = .FALSE. end if ! Length unit in S.I. units (m) if (r_unit=="pc") then dr_unit = r_pc else if (r_unit=="au") then dr_unit = r_au else if (r_unit=="r_sun") then dr_unit = r_sun else if (r_unit=="r_earth") then dr_unit = r_earth else if (r_unit=="km") then dr_unit = 1000.0_DP else if (r_unit=="m") then dr_unit = 1.0_DP else if (r_unit=="cm") then dr_unit = 0.01_DP else print*,'Unknown position unit ', r_unit, '!' print*,'Cannot set unitzintegration (column density plots may be incorrect)' do_zintegration = .FALSE. dr_unit = 1.0_DP end if ! Length unit in S.I. units (m) if (h_unit=="pc") then dh_unit = r_pc else if (h_unit=="au") then dh_unit = r_au else if (h_unit=="r_sun") then dh_unit = r_sun else if (h_unit=="r_earth") then dh_unit = r_earth else if (h_unit=="km") then dh_unit = 1000.0_DP else if (h_unit=="m") then dh_unit = 1.0_DP else if (h_unit=="cm") then dh_unit = 0.01_DP else print*,'Unknown smoothing length unit ', h_unit, '!' print*,'Cannot create dimensionless weight (unnormalised rendered plots may be incorrect)' do_dimweight = .FALSE. dh_unit = 1.0_DP end if ! Mass units in S.I. units (kg) if (m_unit=="m_sun") then dm_unit = m_sun else if (m_unit=="m_jup") then dm_unit = m_jup else if (m_unit=="m_earth") then dm_unit = m_earth else if (m_unit=="kg") then dm_unit = 1._DP else if (m_unit=="g") then dm_unit = 1.0E-3_DP else print*,'Unknown mass unit ', m_unit, '!' print*,'Cannot create dimensionless weight (unnormalised rendered plots may be incorrect)' do_dimweight = .FALSE. dm_unit = 1._DP end if ! Density units in S.I. units (i.e. kg/m^3) if (rho_unit=="m_sun_pc3") then drho_unit = m_sun / (r_pc**3) rho_length = r_pc rho_length_label = "pc" else if (rho_unit=="m_sun_pc2") then drho_unit = m_sun / (r_pc**2) rho_length = r_pc rho_length_label = "pc" else if (rho_unit=="kg_m3") then drho_unit = 1.0_DP rho_length = 1.0_DP rho_length_label = "m" else if (rho_unit=="kg_m2") then drho_unit = 1.0_DP rho_length = 1.0_DP rho_length_label = "m" else if (rho_unit=="g_cm3") then drho_unit = 1.0E3_DP rho_length = 0.01_DP rho_length_label = "cm" else if (rho_unit=="g_cm2") then drho_unit = 10.0_DP rho_length = 0.01_DP rho_length_label = "cm" else print*,'Unknown density unit ', rho_unit, '!' print*,'Cannot create dimensionless weight (unnormalised rendered plots may be incorrect)' do_dimweight = .FALSE. print*,'Cannot set unitzintegration (column density plots may be incorrect)' do_zintegration = .FALSE. rho_length = 1.0_DP end if if (do_dimweight) then out_unit_interp = dm_unit/(drho_unit*dh_unit**NDIMtemp) end if if (do_zintegration) then out_unitzintegration = dr_unit / rho_length out_labelzintegration = rho_length_label end if return end subroutine find_weights subroutine translate_unit_names(unit_name) implicit none character(len=*), intent(inout) :: unit_name select case (trim(unit_name)) case ("r_sun") unit_name = "r\dSun\u" case ("au") unit_name = "AU" case ("r_earth") unit_name = "r\dEarth\u" case ("m_sun") unit_name = "M\d\(2281)\u" case ("m_jup") unit_name = "M\dJupiter\u" case ("m_earth") unit_name = "M\dEarth\u" case ("myr") unit_name = "Myrs" case ("km_s") unit_name = "km s\u-1\d" case ("au_yr") unit_name = "AU / yr" case ("m_s") unit_name = "m s\u-1\d" case ("cm_s") unit_name = "cm s\u-1\d" case ("km_s2") unit_name = "km \u-2\d" case ("au_yr2") unit_name = "AU yr\u-2\d" case ("m_s2") unit_name = "m s\u-2\d" case ("cm_s2") unit_name = "cm s\u-2\d" case ("m_sun_pc3") unit_name = "M\d\(2281)\u pc\u-3\d" case ("kg_m_3") unit_name = "kg m\u-3\d" case ("g_cm_3") unit_name = "g cm\u-3\d" case ("m_sun_pc2") unit_name = "M\d\(2281)\u pc\u-2\d" case ("kg_m_2") unit_name = "kg m\u-2\d" case ("g_cm_2") unit_name = "g cm\u-2\d" case ("g_cms2") unit_name = "g cm\u-2\d" case ("10^40erg") unit_name = "\x 10\u40\d ergs" case ("m_sunkm_s") unit_name = "M\d\(2281)\u km s\u-1\d" case ("m_sunau_yr") unit_name = "M\d\(2281)\u AU yr\u-1\d" case ("kgm_s") unit_name = "kg m s\u-1\d" case ("gcm_s") unit_name = "g cm s\u-1\d" case ("m_sunkm2_s") unit_name = "M\d\(2281)\u km\u2\d s\u-1\d" case ("m_sunau2_yr") unit_name = "M\d\(2281)\u AU\u2\d yr\u-1\d" case ("kgm2_s") unit_name = "kg m\u2\d s\u-1\d" case ("gcm2_s") unit_name = "g cm\u2\d s\u-1\d" case ("rad_s") unit_name = "radians s\u-1\d" case ("m_sun_myr") unit_name = "M\d\(2281)\u Myr\u-1\d" case ("m_sun_yr") unit_name = "M\d\(2281)\u yr\u-1\d" case ("kg_s") unit_name = "kg s\u-1\d" case ("g_s") unit_name = "g s\u-1\d" case ("L_sun") unit_name = "Ld\(2281)\u" case ("J_s") unit_name = "J s\u-1\d" case ("ergs_s") unit_name = "ergs s\u-1\d" case ("m2_kg") unit_name = "m\u2\d kg\u-1\d" case ("cm2_g") unit_name = "cm\u2\d g\u-1\d" case ("tesla") unit_name = "Tesla" case ("gauss") unit_name = "Gauss" case ("C_s_m2") unit_name = "C s\u-1\d m\u-2\d" case ("J_kg") unit_name = "J kg\u-1\d" case ("erg_g") unit_name = "ergs g\u-1\d" case default unit_name = unit_name ! this could be improved end select return end subroutine translate_unit_names splash/src/read_data_silo.f90000644 000770 000000 00000026575 12505174327 017036 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR SILO FILES ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxpart,maxplot,maxstep) : main data array ! ! npartoftype(maxstep): number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! (used in calc_quantities for calculating the pressure) ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Columns with the 'required' flag set to false are not read !------------------------------------------------------------------------- ! ! The module below contains interface routines to c functions ! that perform the actual calls to the SILO libs ! !------------------------------------------------------------------------- module siloread use params, only:maxplot,doub_prec use labels, only:lenlabel use, intrinsic :: iso_c_binding, only:c_int,c_double,c_char implicit none character(len=lenlabel), dimension(maxplot) :: blocklabel logical :: havewarned = .false. integer, parameter :: maxtypes = 6 interface subroutine read_silo_header(filename,npart,ncol,ndim,ndimV,time,ierr) bind(c) import character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(out) :: npart,ncol,ndim,ndimV,ierr real(kind=c_double), intent(out) :: time end subroutine read_silo_header subroutine read_silo_data(filename,maxtypes,npartoftypei,& ncol,isrequired,ierr) bind(c) import implicit none character(kind=c_char), dimension(*), intent(in) :: filename integer(kind=c_int), intent(in), value :: maxtypes integer(kind=c_int), dimension(6), intent(in) :: npartoftypei integer(kind=c_int), intent(in), value :: ncol integer(kind=c_int), intent(out) :: ierr integer(kind=c_int), dimension(ncol), intent(in) :: isrequired end subroutine read_silo_data end interface end module siloread !------------------------------------------------------------------------- ! ! The routine that reads the data into splash's internal arrays ! !------------------------------------------------------------------------- subroutine read_data(rootname,istepstart,nstepsread) use particle_data, only:dat,npartoftype,masstype,time,gamma,maxpart,maxcol,maxstep use params, only:doub_prec,maxparttypes,maxplot use settings_data, only:ndim,ndimV,ncolumns,ncalc,iformat,required,ipartialread, & ntypes,debugmode,iverbose use settings_page, only:legendtext use mem_allocation, only:alloc use labels, only:ih,irho,ipmass,labeltype use system_utils, only:renvironment,lenvironment,ienvironment,envlist use asciiutils, only:cstring use siloread, only:blocklabel,havewarned,read_silo_header, & read_silo_data,maxtypes implicit none integer, intent(in) :: istepstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+10) :: datfile,densfile,hfile character(len=20) :: string integer :: i,j,itype,ierr integer :: index1,index2,nhfac integer :: ncolstep,npart_max,nstep_max,ntoti,ntotall,idot integer, parameter :: iunit = 11 logical :: iexist,reallocate,usez,debug,goterrors real(doub_prec) :: timetemp,ztemp real :: hfact,hfactmean,pmassi real, parameter :: pi = 3.1415926536 integer, dimension(maxplot) :: isrequired nstepsread = 0 goterrors = .false. if (len_trim(rootname).gt.0) then datfile = trim(rootname) else print*,' **** no data read **** ' return endif ! !--check if first data file exists ! print "(1x,a)",'reading SILO format' inquire(file=datfile,exist=iexist) if (.not.iexist) then ! !--append .silo on the end if not already present ! datfile=trim(rootname)//'.silo' inquire(file=datfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(rootname)//': file not found ***' return endif endif ! !--set parameters which do not vary between timesteps ! ndim = 3 ndimV = 3 ! !--read data from snapshots ! i = istepstart write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ! !--open file and read header information ! if (debug) print*,'DEBUG: reading header...' call read_silo_header(cstring(datfile),ntoti,ncolstep,ndim,ndimV,timetemp,ierr) if (ierr /= 0) then print "(a)", '*** ERROR READING HEADER ***' return endif ncolumns = ncolstep if (iverbose >= 1) print "(a,1x,i10,a,es10.3)",' ndim: ',ndim,' time: ',timetemp if (iverbose >= 1) print "(2(a,1x,i10))",' npart: ',ntoti,' ncolumns: ',ncolstep ! !--now read data ! reallocate = .false. npart_max = maxpart nstep_max = max(maxstep,1) if (ntoti.gt.maxpart) then reallocate = .true. if (maxpart.gt.0) then ! if we are reallocating, try not to do it again npart_max = int(1.1*ntotall) else ! if first time, save on memory npart_max = int(ntoti) endif endif if (i.ge.maxstep .and. i.ne.1) then nstep_max = i + max(10,INT(0.1*nstep_max)) reallocate = .true. endif ! !--reallocate memory for main data array ! if (reallocate .or. .not.(allocated(dat))) then call alloc(npart_max,nstep_max,max(ncolumns+ncalc,maxcol)) endif ! !--copy header data into allocated arrays ! ntypes = 1 npartoftype(1,i) = ntoti time(i) = real(timetemp) masstype(:,i) = 0. ! all masses read from file ! !--read particle data ! got_particles: if (ntoti > 0) then isrequired(:) = 0 where (required(1:ncolumns)) isrequired(1:ncolumns) = 1 call read_silo_data(cstring(datfile),ntypes,npartoftype(:,i),ncolumns,isrequired,ierr) nstepsread = 1 endif got_particles ! !--now memory has been allocated, set arrays which are constant for all time ! gamma = 5./3. ! !--set flag to indicate that only part of this file has been read ! if (.not.all(required(1:ncolstep))) ipartialread = .true. ! !--call set labels to identify location of smoothing length ! call set_labels ! !--cover the special case where no particles have been read ! if (ntoti.le.0) then npartoftype(1,i) = 1 dat(:,:,i) = 0. endif if (nstepsread.gt.0) then print "(a,i10,a)",' >> read ',sum(npartoftype(:,istepstart+nstepsread-1)),' particles' endif return end subroutine read_data subroutine read_silo_data_fromc(icol,npartoftypei,temparr,itype) bind(c) use, intrinsic :: iso_c_binding, only:c_int,c_double use particle_data, only:dat,iamtype use settings_data, only:debugmode use labels, only:label implicit none integer(kind=c_int), intent(in) :: icol,npartoftypei,itype real(kind=c_double), intent(in) :: temparr(npartoftypei) integer(kind=c_int) :: i,icolput integer :: nmax,nerr,idi logical :: useids icolput = icol if (debugmode) print "(a,i2,a,i2,a,i8)",'DEBUG: reading column ',icol,' type ',itype,' -> '//trim(label(icolput)) ! check column is within array limits if (icolput.gt.size(dat(1,:,1)) .or. icolput.eq.0) then print "(a,i2,a)",' ERROR: column = ',icolput,' out of range in receive_data_fromc' return endif ! ensure no array overflows nmax = min(npartoftypei,size(dat(:,1,1))) ! copy data into main splash array dat(1:nmax,icolput,1) = real(temparr(1:nmax)) ! set particle type if (size(iamtype(:,1)).gt.1) then do i=1,nmax iamtype(i,1) = itype + 1 enddo endif return end subroutine read_silo_data_fromc !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,iamvec,labelvec,labeltype,ix,ivx,ipmass, & ih,irho,ipr,iutherm,iBfirst,idivB,iax use params use settings_data, only:ndim,ndimV,ncolumns,ntypes,UseTypeInRenderings,iformat use geometry, only:labelcoord use system_utils, only:envlist,ienvironment use siloread, only:blocklabel use asciiutils, only:lcase implicit none integer :: i,j,icol,irank if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif ix = 0 iutherm = 0 do icol=1,size(blocklabel) select case(trim(lcase(blocklabel(icol)))) case('x') ix(1) = icol case('y') ix(2) = icol case('z') ix(3) = icol case('vx') ivx = icol case('ax') iax = icol case('h') ih = icol case('mass') ipmass = icol case('density') irho = icol end select label(icol) = trim(blocklabel(icol)) enddo ! set labels of the quantities read in if (ix(1).gt.0) label(ix(1:ndim)) = labelcoord(1:ndim,1) !if (irho.gt.0) label(irho) = 'density' !if (iutherm.gt.0) label(iutherm) = 'u' !if (ipmass.gt.0) label(ipmass) = 'particle mass' !if (ih.gt.0) label(ih) = 'h' ! set labels for vector quantities if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'_'//labelcoord(i,1) enddo endif if (iax.gt.0) then iamvec(iax:iax+ndimV-1) = iax labelvec(iax:iax+ndimV-1) = 'a' do i=1,ndimV label(iax+i-1) = trim(labelvec(iax))//'_'//labelcoord(i,1) enddo endif ! set labels for each particle type labeltype(1) = 'gas' UseTypeInRenderings(:) = .false. UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels subroutine set_blocklabel(icol,name) bind(c) use, intrinsic :: iso_c_binding, only:c_int, c_char use siloread, only:blocklabel use asciiutils, only:fstring implicit none integer(kind=c_int), intent(in) :: icol character(kind=c_char), intent(in) :: name(256) blocklabel(icol) = trim(fstring(name)) !print*,icol,' name = ',trim(blocklabel(icol)) end subroutine set_blocklabel splash/src/read_data_silo_utils.c000644 000770 000000 00000015362 12505175173 020072 0ustar00dpricewheel000000 000000 /* * This subroutine performs the calls to the SILO library for the * SILO data read * * We have to do it this way as the SILO read interface for Fortran * is incomplete * */ #include #include #include #include static int debug = 0; void set_blocklabel(int *icol, char *name); void read_silo_data_fromc(int *icol, int *npartoftypei, double temparr[*npartoftypei],int *itype); void read_silo_header(const char *filename, int *npart, int *ncol, int *ndim, int *ndimV, double *time, int *ierr) { *npart = 0; *ierr = 0; *ncol = 0; *time = 0.; *npart = 0; DBfile *silofile = DBOpen(filename, DB_UNKNOWN, DB_READ); if (!silofile) { *ierr = 1; return; } if (!DBVersionGEFileVersion(silofile)) { const char *siloversion = DBFileVersion(silofile); printf(" WARNING! File was created with newer version (v%s) of silo library\n",siloversion); } if (!DBInqFileHasObjects(silofile)) { printf(" ERROR: silo file %s does not appear to contain any objects\n",filename); *ierr = 2; return; } DBtoc *toc = DBGetToc(silofile); if (debug) { printf(" DEBUG: File contains:\n %i curves\n %i multimesh\n %i nmultimeshadj\n %i multivar\n", \ toc->ncurve,toc->nmultimesh,toc->nmultimeshadj,toc->nmultivar); printf(" %i multimat\n %i multimatspecies\n %i csgmesh\n %i csgvar\n", \ toc->nmultimat,toc->nmultimatspecies,toc->ncsgmesh,toc->ncsgvar); printf(" %i defvars\n %i qmesh\n %i qvar\n %i ucdmesh\n %i ucdvar\n", \ toc->ndefvars,toc->nqmesh,toc->nqvar,toc->nucdmesh,toc->nucdvar); printf(" %i ptmesh\n %i ptvar\n %i mat\n %i matspecies\n %i var\n %i obj\n", \ toc->nptmesh,toc->nptvar,toc->nmat,toc->nmatspecies,toc->nvar,toc->nobj); printf(" %i dir\n %i array\n %i mrgtree\n %i groupelmap\n %i mrgvar\n", \ toc->ndir,toc->narray,toc->nmrgtree,toc->ngroupelmap,toc->nmrgvar); } int nptmesh = toc->nptmesh; if (nptmesh <= 0) { printf(" ERROR: silo file %s does not appear to contain any point meshes\n",filename); *ierr = 3; return; } int i; for (i=0;i 0) { printf(" WARNING: IGNORNING ptmesh #%i (%s)\n",i+1,toc->ptmesh_names[i]); } } /* open the first point mesh and get info */ DBpointmesh *my_ptmesh = DBGetPointmesh(silofile,toc->ptmesh_names[0]); if (!my_ptmesh) { printf(" ERROR reading point mesh %s\n",toc->ptmesh_names[0]); *ierr = 4; return; } else { printf(" Reading point mesh %s\n",toc->ptmesh_names[0]); *time = my_ptmesh->dtime; *npart = my_ptmesh->nels; *ndim = my_ptmesh->ndims; *ndimV = *ndim; if (debug) { printf(" Got labels = %s %s %s \n",\ my_ptmesh->labels[0],my_ptmesh->labels[1],my_ptmesh->labels[2]); printf(" Got title = %s \n",my_ptmesh->title); printf(" Got units = %s %s %s \n",\ my_ptmesh->units[0],my_ptmesh->units[1],my_ptmesh->units[2]); printf(" max_extents = %f %f %f\n",\ my_ptmesh->max_extents[0],my_ptmesh->max_extents[1],my_ptmesh->max_extents[2]); } DBFreePointmesh(my_ptmesh); } /* Read the other point variables */ int nptvar = toc->nptvar; if (nptvar <= 0) { printf(" WARNING: silo file %s does not appear to contain any point variables\n",filename); } *ncol = *ndim + nptvar; if (*ncol <= 0) { *ierr = 4; printf(" ERROR: ncol <= 0 from silo header\n"); return; } DBClose(silofile); } void read_silo_data(char *filename, int maxtypes, int npartoftype[maxtypes], int ncol, int isrequired[ncol], int *ierr) { DBfile *silofile = DBOpen(filename, DB_UNKNOWN, DB_READ); if (!silofile) { *ierr = 1; return; } DBtoc *toc = DBGetToc(silofile); DBpointmesh *my_ptmesh = DBGetPointmesh(silofile,toc->ptmesh_names[0]); if (!my_ptmesh) { printf(" ERROR reading point mesh %s\n",toc->ptmesh_names[0]); DBClose(silofile); *ierr = 4; return; } else { if (debug) printf(" DEBUG: Reading data from point mesh %s\n",toc->ptmesh_names[0]); int ndim = my_ptmesh->ndims; /*int nels = my_ptmesh->nels;*/ int i; int np = npartoftype[0]; int idim; int particle_type = 1; /* read in float */ float *x = 0; x = malloc(np*sizeof(float)); /* must send double to splash */ double *tmp_dbl = 0; tmp_dbl = malloc(np*sizeof(double)); /* read each coordinate in turn */ int icol = 0; for (idim=0;idimcoords[idim]; for (i=0;inptvar; for (i=0;iptvar_names[i]); DBmeshvar *my_ptvar = DBGetPointvar(silofile,toc->ptvar_names[i]); if (debug) { printf(" Associated with mesh %s\n",my_ptvar->meshname); printf(" label = %s\n",my_ptvar->label); printf(" Nels,nvals,nspace,ndims = %i %i %i %i\n",\ my_ptvar->nels,my_ptvar->nvals,my_ptvar->nspace,my_ptvar->ndims); } icol = icol + 1; x = my_ptvar->vals[0]; for (i=0;iname); /*DBFreeMeshvar(my_ptvar);*/ } free(x); free(tmp_dbl); DBFreePointmesh(my_ptmesh); } DBClose(silofile); } splash/src/read_data_snsph.f90000644 000770 000000 00000012052 11622211702 017170 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM THE SNSPH CODE ! USING THE SELF-DESCRIBING FORMAT ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: j,ierr,ntoti,getcol integer :: npart_max,nstep_max,ncolstep real :: timei, gammai logical :: iexist character(len=len(rootname)+10) :: dumpfile nstepsread = 0 npart_max = maxpart dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: ',trim(dumpfile),' file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 ! !--allocate memory initially ! nstep_max = max(indexstart,1) j = indexstart nstepsread = 0 print "(1x,a)",'reading SNSPH format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--read number of columns and number of particles ! ncolstep = getcol() call getdata(dumpfile,len_trim(dumpfile),npart_max,timei,gammai) ! !--get number of particles from header and allocate memory ! ntoti = npart_max ncolumns = ncolstep if (.not.allocated(dat) .or. ntoti.gt.npart_max) then npart_max = max(npart_max,INT(1.1*ntoti)) call alloc(npart_max,nstep_max,ncolstep+ncalc) endif npart_max = max(npart_max,ntoti) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+2*nstepsread,maxcol) endif ! !--now read the timestep data in the dumpfile ! time(j) = timei print "(a,i5,a,f10.3,a,i8)",'| step ',j,': t = ',time(j),' ntotal = ',ntoti nstepsread = nstepsread + 1 ! !--set particle numbers ! npartoftype(:,j) = 0 npartoftype(1,j) = ntoti ! !--now read data ! call readsdf(dumpfile,len_trim(dumpfile),dat(:,:,j),maxpart,maxcol,ierr) if (nstepsread .gt. 0 .and. j.gt.0) then print*,'>> end of dump file: ntotal = ',sum(npartoftype(:,j)) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ih = 10 ! smoothing length iutherm = 8 ! thermal energy ipmass = 7 ! particle mass irho = 9 ! location of rho in data array label(ix(1:ndim)) = labelcoord(1:ndim,1) label(irho) = 'density' label(iutherm) = 'temperature' label(ih) = 'h' label(ipmass) = 'particle mass' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 1 labeltype(1) = 'gas' !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_snsph_utils.c000644 000770 000000 00000005127 11343562731 020254 0ustar00dpricewheel000000 000000 #include #include #include #include #include #include #include typedef struct { double x, y, z; float vx, vy, vz; float mass; float u; float rho; float h; } body; void readsdf_(char *filename, int *len, float *dat, int *maxpart, int *maxcol, int *ierr) { int xconf, yconf, zconf, vxconf, vyconf, vzconf, mconf, uconf, rhoconf, hconf; int gnobj, nobj, i; body *p; SDF *sdfp; char fname[128]; strncpy(fname, filename, *len); fname[*len] = '\0'; if ( (sdfp = SDFopen(NULL, fname)) == NULL ) { fprintf(stderr, "%s: %s", fname, SDFerrstring); exit(2); } SDFread(sdfp, (void **)(&p), &gnobj, &nobj, sizeof(body), "x", offsetof(body, x), &xconf, "y", offsetof(body, y), &yconf, "z", offsetof(body, z), &zconf, "vx", offsetof(body, vx), &vxconf, "vy", offsetof(body, vy), &vyconf, "vz", offsetof(body, vz), &vzconf, "mass", offsetof(body, mass), &mconf, "u", offsetof(body, u), &uconf, "rho", offsetof(body, rho), &rhoconf, "h", offsetof(body, h), &hconf, NULL); SDFclose(sdfp); if (!xconf || !yconf || !zconf || !vxconf || !vyconf || !vzconf || !mconf || !uconf || !rhoconf || !hconf) { fprintf(stderr, "No %s%s%s%s%s%s%s%s%s%s in %s\n", (xconf==0)? "x " : "", (yconf==0)? "y " : "", (zconf==0)? "z " : "", (vxconf==0)? "vx " : "", (vyconf==0)? "vy " : "", (vzconf==0)? "vz " : "", (mconf==0)? "m " : "", (uconf==0)? "u " : "", (rhoconf==0)? "rho " : "", (hconf==0)? "h " : "", fname); exit(3); } printf("nobj = %d\n", nobj); for(i = 0; i < nobj; ++i) { dat[i] = p[i].x; dat[(*maxpart)+i] = p[i].y; dat[2* (*maxpart)+i] = p[i].z; dat[3* (*maxpart)+i] = p[i].vx; dat[4* (*maxpart)+i] = p[i].vy; dat[5* (*maxpart)+i] = p[i].vz; dat[6* (*maxpart)+i] = p[i].mass; dat[7* (*maxpart)+i] = p[i].u; dat[8* (*maxpart)+i] = p[i].rho; dat[9* (*maxpart)+i] = p[i].h; } Free(p); *ierr = xconf || yconf || zconf || vxconf || vyconf || vzconf || mconf || uconf || rhoconf || hconf; } int getcol_() { return 10; } void getdata_(char *filename, int *len, int *nobj, float *tpos, float *gamma) { SDF *sdfp; char fname[128]; strncpy(fname, filename, *len); fname[*len] = '\0'; if ( (sdfp = SDFopen(NULL, fname)) == NULL ) { fprintf(stderr, "%s: %s", fname, SDFerrstring); exit(2); } SDFgetintOrDie(sdfp, "npart", nobj); SDFgetfloatOrDie(sdfp, "tpos", tpos); SDFgetfloatOrDie(sdfp, "gamma", gamma); SDFclose(sdfp); } splash/src/read_data_sphNG.f90000644 000770 000000 00000252236 12607331163 017076 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM ! THE NEXT GENERATION SPH CODE (sphNG) ! ! (also my Phantom SPH code which uses a similar format) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! SSPLASH_RESET_CM if 'YES' then centre of mass is reset to origin ! SSPLASH_OMEGA if non-zero subtracts corotating velocities with omega as set ! SSPLASH_OMEGAT if non-zero subtracts corotating positions and velocities with omega as set ! SSPLASH_TIMEUNITS sets default time units, either 's','min','hrs','yrs' or 'tfreefall' ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' ! ! Partial data read implemented Nov 2006 means that columns with ! the 'required' flag set to false are not read (read is therefore much faster) !------------------------------------------------------------------------- module sphNGread use params implicit none real(doub_prec) :: udist,umass,utime,umagfd real :: tfreefall integer :: istartmhd,istartrt,nmhd,idivvcol,icurlvxcol,icurlvycol,icurlvzcol integer :: nhydroreal4,istart_extra_real4 integer :: nhydroarrays,nmhdarrays logical :: phantomdump,smalldump,mhddump,rtdump,usingvecp,igotmass,h2chem,rt_in_header logical :: usingeulr,cleaning logical :: batcode,tagged,debug integer, parameter :: maxarrsizes = 10 integer, parameter :: maxinblock = 128 ! max allowed in each block integer, parameter :: lentag = 16 character(len=lentag) :: tagarr(maxplot) integer, parameter :: itypemap_sink_phantom = 3 integer, parameter :: itypemap_dust_phantom = 2 integer, parameter :: itypemap_unknown_phantom = 8 !------------------------------------------ ! generic interface to utilities for tagged ! dump format !------------------------------------------ interface extract module procedure extract_int, extract_real4, extract_real8, & extract_intarr, extract_real4arr, extract_real8arr end interface extract contains !------------------------------------------------------------------- ! function mapping iphase setting in sphNG to splash particle types !------------------------------------------------------------------- elemental integer function itypemap_sphNG(iphase) integer*1, intent(in) :: iphase select case(int(iphase)) case(0) itypemap_sphNG = 1 case(1:9) itypemap_sphNG = 3 case(10:) itypemap_sphNG = 4 case default itypemap_sphNG = 5 end select end function itypemap_sphNG !--------------------------------------------------------------------- ! function mapping iphase setting in Phantom to splash particle types !--------------------------------------------------------------------- elemental integer function itypemap_phantom(iphase) integer*1, intent(in) :: iphase select case(int(iphase)) case(1:2) itypemap_phantom = iphase case(3:6) ! put sinks as type 3, everything else shifted by one itypemap_phantom = iphase + 1 case(-3) ! sink particles, either from external_binary or read from dump itypemap_phantom = itypemap_sink_phantom case default itypemap_phantom = itypemap_unknown_phantom end select end function itypemap_phantom !------------------------------------------ ! extraction of single integer variables !------------------------------------------ subroutine extract_int(tag,ival,intarr,tags,ntags,ierr) character(len=*), intent(in) :: tag integer, intent(out) :: ival integer, intent(in) :: ntags,intarr(:) character(len=lentag), intent(in) :: tags(:) integer, intent(out) :: ierr logical :: matched integer :: i ierr = 1 matched = .false. ival = 0 ! default if not found over_tags: do i=1,min(ntags,size(tags)) if (trim(tags(i))==trim(adjustl(tag))) then if (size(intarr) >= i) then ival = intarr(i) matched = .true. endif exit over_tags ! only match first occurrence endif enddo over_tags if (matched) ierr = 0 if (ierr /= 0) print "(a)",' ERROR: could not find '//trim(adjustl(tag))//' in header' end subroutine extract_int !------------------------------------------ ! extraction of single real*8 variables !------------------------------------------ subroutine extract_real8(tag,rval,r8arr,tags,ntags,ierr) character(len=*), intent(in) :: tag real*8, intent(out) :: rval real*8, intent(in) :: r8arr(:) character(len=lentag), intent(in) :: tags(:) integer, intent(in) :: ntags integer, intent(out) :: ierr logical :: matched integer :: i ierr = 1 matched = .false. rval = 0.d0 ! default if not found over_tags: do i=1,min(ntags,size(tags)) if (trim(tags(i))==trim(adjustl(tag))) then if (size(r8arr) >= i) then rval = r8arr(i) matched = .true. endif exit over_tags ! only match first occurrence endif enddo over_tags if (matched) ierr = 0 if (ierr /= 0) print "(a)",' ERROR: could not find '//trim(adjustl(tag))//' in header' end subroutine extract_real8 !------------------------------------------ ! extraction of single real*4 variables !------------------------------------------ subroutine extract_real4(tag,rval,r4arr,tags,ntags,ierr) character(len=*), intent(in) :: tag real*4, intent(out) :: rval real*4, intent(in) :: r4arr(:) character(len=lentag), intent(in) :: tags(:) integer, intent(in) :: ntags integer, intent(out) :: ierr logical :: matched integer :: i ierr = 1 matched = .false. rval = 0. ! default if not found over_tags: do i=1,min(ntags,size(tags)) if (trim(tags(i))==trim(adjustl(tag))) then if (size(r4arr) >= i) then rval = r4arr(i) matched = .true. endif exit over_tags ! only match first occurrence endif enddo over_tags if (matched) ierr = 0 if (ierr /= 0) print "(a)",' ERROR: could not find '//trim(adjustl(tag))//' in header' end subroutine extract_real4 !------------------------------------------ ! extraction of integer arrays !------------------------------------------ subroutine extract_intarr(tag,ival,intarr,tags,ntags,ierr) character(len=*), intent(in) :: tag integer, intent(out) :: ival(:) integer, intent(in) :: ntags,intarr(:) character(len=lentag), intent(in) :: tags(:) integer, intent(out) :: ierr integer :: i,nmatched ierr = 1 nmatched = 0 ival(:) = 0 ! default if not found over_tags: do i=1,min(ntags,size(tags)) if (trim(tags(i))==trim(adjustl(tag))) then if (size(intarr) >= i .and. size(ival) > nmatched) then nmatched = nmatched + 1 ival(nmatched) = intarr(i) endif endif enddo over_tags if (nmatched==size(ival)) ierr = 0 if (ierr /= 0) print "(a)",' ERROR: could not find '//trim(adjustl(tag))//' in header' end subroutine extract_intarr !------------------------------------------ ! extraction of real*8 arrays !------------------------------------------ subroutine extract_real8arr(tag,rval,r8arr,tags,ntags,ierr) character(len=*), intent(in) :: tag real*8, intent(out) :: rval(:) real*8, intent(in) :: r8arr(:) character(len=lentag), intent(in) :: tags(:) integer, intent(in) :: ntags integer, intent(out) :: ierr integer :: i,nmatched ierr = 1 nmatched = 0 rval = 0.d0 ! default if not found over_tags: do i=1,min(ntags,size(tags)) if (trim(tags(i))==trim(adjustl(tag))) then if (size(r8arr) >= i .and. size(rval) > nmatched) then nmatched = nmatched + 1 rval(nmatched) = r8arr(i) endif endif enddo over_tags if (nmatched==size(rval)) ierr = 0 if (ierr /= 0) print "(a)",' ERROR: could not find '//trim(adjustl(tag))//' in header' end subroutine extract_real8arr !------------------------------------------ ! extraction of real*4 arrays !------------------------------------------ subroutine extract_real4arr(tag,rval,r4arr,tags,ntags,ierr) character(len=*), intent(in) :: tag real*4, intent(out) :: rval(:) real*4, intent(in) :: r4arr(:) character(len=lentag), intent(in) :: tags(:) integer, intent(in) :: ntags integer, intent(out) :: ierr integer :: i,nmatched ierr = 1 nmatched = 0 rval = 0. ! default if not found over_tags: do i=1,min(ntags,size(tags)) if (trim(tags(i))==trim(adjustl(tag))) then if (size(r4arr) >= i .and. size(rval) > nmatched) then nmatched = nmatched + 1 rval(nmatched) = r4arr(i) endif endif enddo over_tags if (nmatched==size(rval)) ierr = 0 if (ierr /= 0) print "(a)",' ERROR: could not find '//trim(adjustl(tag))//' in header' end subroutine extract_real4arr !---------------------------------------------------------------------- ! Extract various options from the fileident string !---------------------------------------------------------------------- subroutine get_options_from_fileident(fileident,smalldump,tagged,phantomdump,& usingvecp,usingeulr,cleaning,h2chem,rt_in_header,batcode) character(len=*), intent(in) :: fileident logical, intent(out) :: smalldump,tagged,phantomdump,batcode logical, intent(out) :: usingvecp,usingeulr,cleaning,h2chem,rt_in_header smalldump = .false. phantomdump = .false. usingvecp = .false. usingeulr = .false. cleaning = .false. h2chem = .false. rt_in_header = .false. batcode = .false. tagged = .false. if (fileident(1:1).eq.'S') then smalldump = .true. endif if (fileident(2:2).eq.'T') then tagged = .true. endif if (index(fileident,'Phantom').ne.0) then phantomdump = .true. else phantomdump = .false. endif if (index(fileident,'vecp').ne.0) then usingvecp = .true. endif if (index(fileident,'eulr').ne.0) then usingeulr = .true. endif if (index(fileident,'clean').ne.0) then cleaning = .true. endif if (index(fileident,'H2chem').ne.0) then h2chem = .true. endif if (index(fileident,'RT=on').ne.0) then rt_in_header = .true. endif if (index(fileident,'This is a test').ne.0) then batcode = .true. endif end subroutine get_options_from_fileident !---------------------------------------------------------------------- ! Routine to read the header of sphNG dump files and extract relevant ! information !---------------------------------------------------------------------- subroutine read_header(iunit,iverbose,debug,doubleprec,& npart,npartoftypei,n1,ntypes,nblocks,& narrsizes,realarr,tagsreal,nreals,ierr) integer, intent(in) :: iunit,iverbose logical, intent(in) :: debug,doubleprec integer, intent(out) :: npart,npartoftypei(:),n1,ntypes,nblocks,narrsizes,nreals,ierr real, intent(out) :: realarr(maxinblock) character(len=lentag), intent(out) :: tagsreal(maxinblock) character(len=lentag) :: tags(maxinblock) integer :: intarr(maxinblock) real(doub_prec) :: real8arr(maxinblock) real(sing_prec) :: real4arr(maxinblock) integer :: i,ierr1,ierr2,ierrs(4) integer :: nints,ninttypes,nreal4s,nreal8s,n2,nreassign,naccrete,nkill real(doub_prec), allocatable :: dattemp(:) real(sing_prec), allocatable :: dattempsingle(:) ! initialise empty tag array tags(:) = '' intarr(:) = 0 nblocks = 1 ! number of MPI blocks npartoftypei(:) = 0 read(iunit,iostat=ierr) nints if (ierr /=0) then print "(a)",'error reading nints' return else if (tagged) then if (nints > maxinblock) then print*,'WARNING: number of ints in header exceeds splash array limit, ignoring some' nints = maxinblock endif read(iunit,iostat=ierr1) tags(1:nints) read(iunit,iostat=ierr2) intarr(1:nints) if (ierr1 /= 0 .or. ierr2 /= 0) then print "(a)",'error reading integer header' ierr = 1 return endif if (debug) print*,'DEBUG: got tags = ',tags(1:nints) call extract('nblocks',nblocks,intarr,tags,nints,ierr) if (ierr /= 0) return call extract('nparttot',npart,intarr,tags,nints,ierr) if (ierr /= 0) return if (phantomdump) then call extract('ntypes',ntypes,intarr,tags,nints,ierr) if (ierr /= 0) return call extract('npartoftype',npartoftypei(1:ntypes),intarr,tags,nints,ierr) if (ierr /= 0) return endif if (phantomdump .and. nints < 7) ntypes = nints - 1 if (iverbose.ge.1) print *,'npart = ',npart,' MPI blocks = ',nblocks if (phantomdump) then n1 = npartoftypei(1) else call extract('n1',n1,intarr,tags,nints,ierr) endif else if (nints.lt.3) then if (.not.phantomdump) print "(a)",'WARNING: npart,n1,n2 NOT IN HEADER??' read(iunit,iostat=ierr) npart npartoftypei(1) = npart elseif (phantomdump) then if (nints.lt.7) then ntypes = nints - 1 read(iunit,iostat=ierr) npart,npartoftypei(1:ntypes) else ntypes = 5 read(iunit,iostat=ierr) npart,npartoftypei(1:5),nblocks endif if (debug) then print*,'DEBUG: ntypes = ',ntypes,' npartoftype = ',npartoftypei(:) endif n1 = npartoftypei(1) n2 = 0 elseif (nints.ge.7) then read(iunit,iostat=ierr) npart,n1,n2,nreassign,naccrete,nkill,nblocks else print "(a)",'warning: nblocks not read from file (assuming non-MPI dump)' read(iunit,iostat=ierr) npart,n1,n2 endif if (ierr /=0) then print "(a)",'error reading npart,n1,n2 and/or number of MPI blocks' return elseif (nblocks.gt.2000) then print *,'npart = ',npart,' MPI blocks = ',nblocks nblocks = 1 print*,' corrupt number of MPI blocks, assuming 1 ' else if (iverbose.ge.1) print *,'npart = ',npart,' MPI blocks = ',nblocks endif endif endif if (ntypes > maxparttypes) then print "(a,i2)",' WARNING: number of particle types exceeds array limits: ignoring types > ',maxparttypes ntypes = maxparttypes endif !--int*1, int*2, int*4, int*8 ierr1 = 0 ierr2 = 0 do i=1,4 read(iunit,iostat=ierr) ninttypes if (ninttypes > 0) then if (tagged) read(iunit,iostat=ierr1) read(iunit,iostat=ierr2) endif if (ierr /= 0 .or. ierr1 /= 0 .or. ierr2 /= 0) then print "(a)",'error skipping int types' return endif enddo !--default reals read(iunit,iostat=ierr) nreals if (ierr /=0) then print "(a)",'error reading default reals' return else if (nreals > maxinblock) then print*,'WARNING: number of reals in header exceeds splash array limit, ignoring some' nreals = maxinblock endif if (tagged) then read(iunit,iostat=ierr) tagsreal(1:nreals) else ! !--set the tags manually for older formats ! (but only the ones we care about) ! if (phantomdump) then tagsreal(1) = 'time' tagsreal(3) = 'gamma' tagsreal(4) = 'rhozero' tagsreal(6) = 'hfact' tagsreal(7) = 'tolh' tagsreal(15:19) = 'massoftype' elseif (batcode) then tagsreal(1) = 'time' tagsreal(3) = 'gamma' tagsreal(4) = 'radL1' tagsreal(5) = 'PhiL1' tagsreal(15) = 'Er' else tagsreal(1) = 'gt' tagsreal(2) = 'dtmax' tagsreal(3) = 'gamma' tagsreal(4) = 'rhozero' tagsreal(5) = 'RK2' if (smalldump) then ! sphNG small dump if (nreals.eq.15) then tagsreal(15) = 'pmassinitial' else tagsreal(23) = 'pmassinitial' endif endif endif endif if (doubleprec) then read(iunit,iostat=ierr) real8arr(1:nreals) realarr(1:nreals) = real(real8arr(1:nreals)) else read(iunit,iostat=ierr) real4arr(1:nreals) realarr(1:nreals) = real(real4arr(1:nreals)) endif endif !--real*4, real*8 read(iunit,iostat=ierr) nreal4s if (nreal4s > 0) then if (tagged) read(iunit,iostat=ierr1) read(iunit,iostat=ierr2) endif if (ierr /= 0 .or. ierr1 /= 0 .or. ierr2 /= 0) then print "(a)",'error skipping real*4''s in header' return endif read(iunit,iostat=ierr) nreal8s if (ierr /= 0 .or. nreal8s < 0) then print "(a)",'error reading nreal8s' return endif ! print "(a,i3)",' ndoubles = ',nreal8s if (iverbose.ge.1) print "(4(a,i3),a)",' header contains ',nints,' ints, ',& nreals,' reals,',nreal4s,' real4s, ',nreal8s,' doubles' if (tagged) then if (nreal8s > maxinblock) then print*,'WARNING: number of real8''s in header exceeds splash array limit, ignoring some' nreal8s = maxinblock endif read(iunit,iostat=ierr) tags(1:nreal8s) read(iunit,iostat=ierr) real8arr(1:nreal8s) call extract('udist',udist,real8arr,tags,nreal8s,ierrs(1)) call extract('umass',umass,real8arr,tags,nreal8s,ierrs(2)) call extract('utime',utime,real8arr,tags,nreal8s,ierrs(3)) call extract('umagfd',umagfd,real8arr,tags,nreal8s,ierrs(4)) if (any(ierrs /= 0)) then print "(a)",' *** error reading units' endif else if (nreal8s.ge.4) then read(iunit,iostat=ierr) udist,umass,utime,umagfd elseif (nreal8s.ge.3) then read(iunit,iostat=ierr) udist,umass,utime umagfd = 1.0 else print "(a)",'*** WARNING: units not found in file' udist = 1.0 umass = 1.0 utime = 1.0 umagfd = 1.0 endif endif if (ierr /= 0) then print "(a)",'*** error reading units' endif ! !--Total number of array blocks in the file ! read(iunit,iostat=ierr) narrsizes if (ierr /= 0) return if (debug) print*,' nblocks(total)=',narrsizes narrsizes = narrsizes/nblocks if (ierr /= 0) then print "(a)",'*** error reading number of array sizes ***' close(iunit) return elseif (narrsizes.gt.maxarrsizes) then narrsizes = maxarrsizes print "(a,i2)",'WARNING: too many array sizes: reading only ',narrsizes endif if (narrsizes.ge.4 .and. nreal8s.lt.4) then print "(a)",' WARNING: could not read magnetic units from dump file' endif if (debug) print*,' number of array sizes = ',narrsizes end subroutine read_header !---------------------------------------------------------------------- ! Read the header to each array block !---------------------------------------------------------------------- subroutine read_block_header(iunit,iblock,iarr,iverbose,debug,& isize,nint,nint1,nint2,nint4,nint8,nreal,nreal4,nreal8,& ntotblock,npart,ntotal,nptmasstot,ncolstep,ierr) integer, intent(in) :: iunit,iblock,iarr,iverbose logical, intent(in) :: debug integer*8, intent(out) :: isize(:) integer, intent(out) :: nint,nint1,nint2,nint4,nint8,nreal,nreal4,nreal8,ierr integer, intent(inout) :: ntotblock,npart,ntotal,nptmasstot,ncolstep read(iunit,iostat=ierr) isize(iarr),nint,nint1,nint2,nint4,nint8,nreal,nreal4,nreal8 if (iarr.eq.1) then ntotblock = isize(iarr) if (npart.le.0) npart = ntotblock ntotal = ntotal + ntotblock elseif (iarr.eq.2) then nptmasstot = nptmasstot + isize(iarr) endif if (debug) print*,'DEBUG: array size ',iarr,' size = ',isize(iarr) if (isize(iarr).gt.0 .and. iblock.eq.1) then if (iverbose.ge.1) print "(1x,a,i1,a,i12,a,5(i2,1x),a,3(i2,1x))", & 'block ',iarr,' dim = ',isize(iarr),' nint =',nint,nint1,nint2,nint4,nint8,& 'nreal =',nreal,nreal4,nreal8 endif !--we are going to read all real arrays but need to convert them all to default real if (iarr.ne.2 .and. isize(iarr).eq.isize(1) .and. iblock.eq.1) then ncolstep = ncolstep + nreal + nreal4 + nreal8 endif end subroutine read_block_header !---------------------------------------------------------------------- ! Extract and print relevant variables from the header block !---------------------------------------------------------------------- subroutine extract_variables_from_header(tags,realarr,nreals,iverbose,debug,& gotbinary,nblocks,nptmasstot,npartoftypei,ntypes,& time,gamma,hfact,npart,ntotal,npartoftype,massoftype,dat,ix,ih,ipmass,ivx) character(len=lentag), intent(in) :: tags(maxinblock) real, intent(in) :: realarr(maxinblock) integer, intent(in) :: nreals,iverbose,nblocks,nptmasstot,npartoftypei(:),ntypes integer, intent(in) :: ix(3),ih,ipmass,ivx real, intent(out) :: time,gamma,hfact,massoftype(:) real, intent(inout) :: dat(:,:) integer, intent(out) :: npartoftype(:) integer, intent(inout) :: npart,ntotal logical, intent(in) :: debug logical, intent(out) :: gotbinary real :: rhozero,tfreefall,tff,radL1,PhiL1,Er,RK2,dtmax,tolh real :: massoftypei(ntypes) integer :: i,ierrs(10),ipos integer :: itype integer, parameter :: ilocbinary = 24 real, parameter :: pi=3.141592653589 if (phantomdump) then call extract('time',time,realarr,tags,nreals,ierrs(1)) else call extract('gt',time,realarr,tags,nreals,ierrs(1)) endif call extract('gamma',gamma,realarr,tags,nreals,ierrs(2)) call extract('rhozero',rhozero,realarr,tags,nreals,ierrs(3)) !--extract required information from the first block header if (rhozero.gt.0.) then tfreefall = SQRT((3. * pi) / (32. * rhozero)) tff = time/tfreefall else tfreefall = 0. tff = 0. endif if (phantomdump) then call extract('massoftype',massoftypei(1:ntypes),realarr,tags,nreals,ierrs(4)) npartoftype(:) = 0 do i=1,ntypes !--map from phantom types to splash types itype = itypemap_phantom(int(i,kind=1)) if (debug) print*,'DEBUG: npart of type ',itype,' += ',npartoftypei(i) npartoftype(itype) = npartoftype(itype) + npartoftypei(i) massoftype(itype) = massoftypei(i) enddo npartoftype(itypemap_sink_phantom) = nptmasstot ! sink particles if (nblocks.gt.1) then print "(a)",' setting ngas=npart for MPI code ' npartoftype(1) = npart npartoftype(2:) = 0 endif ! !--if Phantom calculation uses the binary potential ! then read this as two point mass particles ! if (nreals.ge.ilocbinary + 14) then if (nreals.ge.ilocbinary + 15) then ipos = ilocbinary else print*,'*** WARNING: obsolete header format for external binary information ***' ipos = ilocbinary + 1 endif if (debug) print*,'DEBUG: reading binary information from header ',ilocbinary if (any(realarr(ilocbinary:ilocbinary+14).ne.0.)) then gotbinary = .true. npartoftype(itypemap_sink_phantom) = npartoftype(itypemap_sink_phantom) + 2 ntotal = ntotal + 2 dat(npart+1,ix(1)) = realarr(ipos) dat(npart+1,ix(2)) = realarr(ipos+1) dat(npart+1,ix(3)) = realarr(ipos+2) if (debug) print *,npart+1,npart+2 if (iverbose.ge.1) print *,'binary position: primary: ',realarr(ipos:ipos+2) if (nreals.ge.ilocbinary+15) then if (ipmass.gt.0) dat(npart+1,ipmass) = realarr(ipos+3) dat(npart+1,ih) = realarr(ipos+4) dat(npart+2,ix(1)) = realarr(ipos+5) dat(npart+2,ix(2)) = realarr(ipos+6) dat(npart+2,ix(3)) = realarr(ipos+7) if (ipmass.gt.0) dat(npart+2,ipmass) = realarr(ipos+8) dat(npart+2,ih) = realarr(ipos+9) if (iverbose.ge.1) then print *,' secondary: ',realarr(ipos+5:ipos+7) print *,' m1: ',realarr(ipos+3),' m2:',realarr(ipos+8),& ' h1: ',realarr(ipos+4),' h2:',realarr(ipos+9) endif ipos = ipos + 10 else dat(npart+1,ih) = realarr(ipos+3) dat(npart+2,ix(1)) = realarr(ipos+4) dat(npart+2,ix(2)) = realarr(ipos+5) dat(npart+2,ix(3)) = realarr(ipos+6) dat(npart+2,ih) = realarr(ipos+7) print *,' secondary: ', realarr(ipos+4:ipos+6) ipos = ipos + 8 endif if (ivx.gt.0) then dat(npart+1,ivx) = realarr(ipos) dat(npart+1,ivx+1) = realarr(ipos+1) dat(npart+1,ivx+2) = realarr(ipos+2) dat(npart+2,ivx) = realarr(ipos+3) dat(npart+2,ivx+1) = realarr(ipos+4) dat(npart+2,ivx+2) = realarr(ipos+5) endif npart = npart + 2 endif endif else npartoftype(:) = 0 npartoftype(1) = npart npartoftype(2) = max(ntotal - npart,0) endif hfact = 1.2 if (phantomdump) then call extract('hfact',hfact,realarr,tags,nreals,ierrs(1)) call extract('tolh',tolh,realarr,tags,nreals,ierrs(2)) print "(a,es12.4,a,f6.3,a,f5.2,a,es8.1)", & ' time = ',time,' gamma = ',gamma, & ' hfact = ',hfact,' tolh = ',tolh elseif (batcode) then call extract('radL1',radL1,realarr,tags,nreals,ierrs(1)) call extract('PhiL1',PhiL1,realarr,tags,nreals,ierrs(2)) call extract('Er',Er,realarr,tags,nreals,ierrs(3)) print "(a,es12.4,a,f9.5,a,f8.4,/,a,es12.4,a,es9.2,a,es10.2)", & ' time: ',time, ' gamma: ',gamma, ' tsph: ',realarr(2), & ' radL1: ',radL1,' PhiL1: ',PhiL1,' Er: ',Er else call extract('RK2',RK2,realarr,tags,nreals,ierrs(1)) call extract('dtmax',dtmax,realarr,tags,nreals,ierrs(2)) print "(a,es12.4,a,f9.5,a,f8.4,/,a,es12.4,a,es9.2,a,es10.2)", & ' time: ',time, ' gamma: ',gamma, ' RK2: ',RK2, & ' t/t_ff: ',tff,' rhozero: ',rhozero,' dtmax: ',dtmax endif end subroutine extract_variables_from_header !--------------------------------------------------------------- ! old subroutine for guessing labels in non-tagged sphNG format !--------------------------------------------------------------- subroutine guess_labels(ncolumns,iamvec,label,labelvec,istartmhd,istart_extra_real4,nmhd,nhydroreal4, & ndimV,irho,iBfirst,ivx,iutherm,idivB,iJfirst,iradenergy,icv,& udist,utime,units,unitslabel) use geometry, only:labelcoord integer, intent(in) :: ncolumns,istartmhd,istart_extra_real4,nmhd,nhydroreal4,ndimV,irho integer, intent(out) :: iBfirst,ivx,iutherm,idivB,iJfirst,iradenergy,icv integer, intent(inout) :: iamvec(:) character(len=*), intent(inout) :: label(:),labelvec(:),unitslabel(:) real(doub_prec), intent(in) :: udist,utime real, intent(inout) :: units(:) integer :: i real(doub_prec) :: uergg !--the following only for mhd small dumps or full dumps if (ncolumns.ge.7) then if (mhddump) then iBfirst = irho+1 if (.not.smalldump) then ivx = iBfirst+ndimV iutherm = ivx+ndimV if (phantomdump) then !--phantom MHD full dumps if (nmhd.ge.4) then iamvec(istartmhd:istartmhd+ndimV-1) = istartmhd labelvec(istartmhd:istartmhd+ndimV-1) = 'A' do i=1,ndimV label(istartmhd+i-1) = trim(labelvec(istartmhd))//'\d'//labelcoord(i,1) enddo if (nmhd.ge.7) then label(istartmhd+3) = 'Euler beta\dx' label(istartmhd+4) = 'Euler beta\dy' label(istartmhd+5) = 'Euler beta\dz' idivB = istartmhd+2*ndimV else idivB = istartmhd+ndimV endif elseif (nmhd.ge.3) then label(istartmhd) = 'Euler alpha' label(istartmhd+1) = 'Euler beta' idivB = istartmhd + 2 elseif (nmhd.ge.2) then label(istartmhd) = 'Psi' idivB = istartmhd + 1 elseif (nmhd.ge.1) then idivB = istartmhd endif iJfirst = 0 if (ncolumns.ge.idivB+1) then label(idivB+1) = 'alpha\dB\u' endif else !--sphNG MHD full dumps label(iutherm+1) = 'grad h' label(iutherm+2) = 'grad soft' label(iutherm+3) = 'alpha' if (nmhd.ge.7 .and. usingvecp) then iamvec(istartmhd:istartmhd+ndimV-1) = istartmhd labelvec(istartmhd:istartmhd+ndimV-1) = 'A' do i=1,ndimV label(istartmhd+i-1) = trim(labelvec(16))//'\d'//labelcoord(i,1) enddo idivB = istartmhd+ndimV elseif (nmhd.ge.6 .and. usingeulr) then label(istartmhd) = 'Euler alpha' label(istartmhd+1) = 'Euler beta' idivB = istartmhd + 2 elseif (nmhd.ge.6) then label(istartmhd) = 'psi' idivB = istartmhd + 1 if (nmhd.ge.8) then label(istartmhd+2+ndimV+1) = '\eta_{real}' label(istartmhd+2+ndimV+2) = '\eta_{art}' units(istartmhd+2+ndimV+1:istartmhd+2+ndimV+2) = udist*udist/utime unitslabel(istartmhd+2+ndimV+1:istartmhd+2+ndimV+2) = ' [cm\u2\d/s]' endif if (nmhd.ge.14) then label(istartmhd+2+ndimV+3) = 'fsym\dx' label(istartmhd+2+ndimV+4) = 'fsym\dy' label(istartmhd+2+ndimV+5) = 'fsym\dz' labelvec(istartmhd+ndimV+5:istartmhd+ndimV+7) = 'fsym' iamvec(istartmhd+ndimV+5:istartmhd+ndimV+7) = istartmhd+ndimV+5 label(istartmhd+2+ndimV+6) = 'faniso\dx' label(istartmhd+2+ndimV+7) = 'faniso\dy' label(istartmhd+2+ndimV+8) = 'faniso\dz' labelvec(istartmhd+ndimV+8:istartmhd+ndimV+10) = 'faniso' iamvec(istartmhd+ndimV+8:istartmhd+ndimV+10) = istartmhd+ndimV+8 endif elseif (nmhd.ge.1) then idivB = istartmhd endif iJfirst = idivB + 1 if (ncolumns.ge.iJfirst+ndimV) then label(iJfirst+ndimV) = 'alpha\dB\u' endif endif else ! mhd small dump if (nhydroreal4.ge.3) iutherm = iBfirst+ndimV endif elseif (.not.smalldump) then ! pure hydro full dump ivx = irho+1 iutherm = ivx + ndimV if (phantomdump) then if (istart_extra_real4.gt.0 .and. istart_extra_real4.lt.100) then label(istart_extra_real4) = 'alpha' label(istart_extra_real4+1) = 'alphau' endif else if (istart_extra_real4.gt.0 .and. istart_extra_real4.lt.100) then label(istart_extra_real4) = 'grad h' label(istart_extra_real4+1) = 'grad soft' label(istart_extra_real4+2) = 'alpha' endif endif endif if (phantomdump .and. h2chem) then if (smalldump) then label(nhydroarrays+nmhdarrays+1) = 'H_2 ratio' elseif (.not.smalldump .and. iutherm.gt.0) then label(iutherm+1) = 'H_2 ratio' label(iutherm+2) = 'HI abundance' label(iutherm+3) = 'proton abundance' label(iutherm+4) = 'e^- abundance' label(iutherm+5) = 'CO abundance' endif endif if (istartrt.gt.0 .and. istartrt.le.ncolumns .and. rtdump) then ! radiative transfer dump iradenergy = istartrt label(iradenergy) = 'radiation energy' uergg = (udist/utime)**2 units(iradenergy) = uergg if (smalldump) then icv = istartrt+1 else label(istartrt+1) = 'opacity' units(istartrt+1) = udist**2/umass icv = istartrt+2 label(istartrt+3) = 'lambda' units(istartrt+3) = 1.0 label(istartrt+4) = 'eddington factor' units(istartrt+4) = 1.0 endif if (icv.gt.0) then label(icv) = 'u/T' units(icv) = uergg endif else iradenergy = 0 icv = 0 endif endif end subroutine guess_labels integer function assign_column(tag,iarr,ipos,ikind,imaxcolumnread) result(icolumn) use labels, only:ih,irho,ix,ipmass character(len=lentag), intent(in) :: tag integer, intent(in) :: iarr,ipos,ikind integer, intent(inout) :: imaxcolumnread if (tagged .and. len_trim(tag) > 0) then ! ! use the tags to put certain arrays in an assigned place ! no matter what type is used for the variable in the file ! and no matter what order they appear in the dump file ! select case(trim(tag)) case('x') icolumn = ix(1) case('y') icolumn = ix(2) case('z') icolumn = ix(3) case('m') icolumn = ipmass case('h') icolumn = ih case('rho') icolumn = irho case('Bx') icolumn = nhydroarrays + 1 case('By') icolumn = nhydroarrays + 2 case('Bz') icolumn = nhydroarrays + 3 case default icolumn = max(nhydroarrays + nmhdarrays + 1,imaxcolumnread + 1) if (iarr==1) then if (ikind==4) then ! real*4 array istart_extra_real4 = min(istart_extra_real4,icolumn) if (debug) print*,' istart_extra_real4 = ',istart_extra_real4 endif endif end select else ! ! this is old code handling the non-tagged format where ! particular arrays are assumed to be in particular places ! if (ikind==6) then ! default reals if (iarr.eq.1.and.((phantomdump.and.ipos.eq.4) & .or.(.not.phantomdump.and.ipos.eq.6))) then ! read x,y,z,m,h and then place arrays after always-present ones ! (for phantom read x,y,z only) icolumn = nhydroarrays+nmhdarrays + 1 elseif (.not.phantomdump .and. (iarr.eq.4 .and. ipos.le.3)) then icolumn = nhydroarrays + ipos else icolumn = imaxcolumnread + 1 endif elseif (ikind==4) then ! real*4s if (phantomdump) then if (iarr.eq.1 .and. ipos.eq.1) then icolumn = ih ! h is always first real4 in phantom dumps !!--density depends on h being read !required(ih) = .true. elseif (iarr.eq.4 .and. ipos.le.3) then icolumn = nhydroarrays + ipos else icolumn = max(nhydroarrays+nmhdarrays + 1,imaxcolumnread + 1) if (iarr.eq.1) then istart_extra_real4 = min(istart_extra_real4,icolumn) if (debug) print*,' istart_extra_real4 = ',istart_extra_real4 endif endif else if (iarr.eq.1 .and. ipos.eq.1) then icolumn = irho ! density elseif (iarr.eq.1 .and. smalldump .and. ipos.eq.2) then icolumn = ih ! h which is real4 in small dumps !--this was a bug for sphNG files... !elseif (iarr.eq.4 .and. i.le.3) then ! icolumn = nhydroarrays + ipos else icolumn = max(nhydroarrays+nmhdarrays + 1,imaxcolumnread + 1) if (iarr.eq.1) then istart_extra_real4 = min(istart_extra_real4,icolumn) if (debug) print*,' istart_extra_real4 = ',istart_extra_real4 endif endif endif else ! used for untagged format with real*8's icolumn = imaxcolumnread + 1 endif endif imaxcolumnread = max(imaxcolumnread,icolumn) end function assign_column end module sphNGread !---------------------------------------------------------------------- ! Main read_data routine for splash !---------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,gamma,time,iamtype,npartoftype,maxpart,maxstep,maxcol,masstype !use params, only:int1,int8 use settings_data, only:ndim,ndimV,ncolumns,ncalc,required,ipartialread,& lowmemorymode,ntypes,iverbose use mem_allocation, only:alloc use system_utils, only:lenvironment,renvironment use labels, only:ipmass,irho,ih,ix,ivx,labeltype,print_types use calcquantities, only:calc_quantities use sphNGread implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,k,ierr,iunit integer :: intg1,int2,int3,ilocvx,iversion integer :: i1,iarr,i2,iptmass1,iptmass2 integer :: npart_max,nstep_max,ncolstep,icolumn,nptmasstot integer :: narrsizes integer :: nskip,ntotal,npart,n1,ngas,nreals integer :: iblock,nblocks,ntotblock,ncolcopy integer :: ipos,nptmass,nptmassi,nstar,nunknown,ilastrequired integer :: imaxcolumnread,nhydroarraysinfile,nremoved integer :: itype,iphaseminthistype,iphasemaxthistype,nthistype,iloc integer, dimension(maxparttypes) :: npartoftypei real, dimension(maxparttypes) :: massoftypei real :: pmassi,hi,rhoi,hrlim,rad2d logical :: iexist, doubleprec,imadepmasscolumn,gotbinary,gotiphase character(len=len(rootname)+10) :: dumpfile character(len=100) :: fileident integer*8, dimension(maxarrsizes) :: isize integer, dimension(maxarrsizes) :: nint,nint1,nint2,nint4,nint8,nreal,nreal4,nreal8 integer*1, dimension(:), allocatable :: iphase integer, dimension(:), allocatable :: listpm real(doub_prec), dimension(:), allocatable :: dattemp real*4, dimension(:), allocatable :: dattempsingle real(doub_prec) :: r8 real(sing_prec) :: r4 real, dimension(:,:), allocatable :: dattemp2 real, dimension(maxinblock) :: dummyreal real :: hfact,omega logical :: skip_corrupted_block_3 character(len=lentag) :: tagsreal(maxinblock), tagtmp integer, parameter :: splash_max_iversion = 1 nstepsread = 0 nstep_max = 0 npart_max = maxpart npart = 0 iunit = 15 ipmass = 4 idivvcol = 0 icurlvxcol = 0 icurlvycol = 0 icurlvzcol = 0 nhydroreal4 = 0 umass = 1.d0 utime = 1.d0 udist = 1.d0 umagfd = 1.d0 istartmhd = 0 istartrt = 0 istart_extra_real4 = 100 nmhd = 0 igotmass = .false. tfreefall = 1.d0 gotbinary = .false. gotiphase = .false. skip_corrupted_block_3 = .false. dumpfile = trim(rootname) ! !--check if data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 j = indexstart nstepsread = 0 doubleprec = .true. ilastrequired = 0 do i=1,size(required)-1 if (required(i)) ilastrequired = i enddo if (iverbose.ge.1) print "(1x,a)",'reading sphNG format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) debug = lenvironment('SSPLASH_DEBUG') if (debug) iverbose = 1 ! !--open the (unformatted) binary file ! open(unit=iunit,iostat=ierr,file=dumpfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return else ! !--read header key to work out precision ! doubleprec = .true. read(iunit,iostat=ierr) intg1,r8,int2,iversion,int3 if (intg1.ne.690706 .and. intg1.ne.060769) then print "(a)",'*** ERROR READING HEADER: corrupt file/zero size/wrong endian?' close(iunit) return endif if (int2.ne.780806 .and. int2.ne.060878) then print "(a)",' single precision dump' rewind(iunit) read(iunit,iostat=ierr) intg1,r4,int2,iversion,int3 if (int2.ne.780806 .and. int2.ne.060878) then print "(a)",'ERROR determining single/double precision in file header' endif doubleprec = .false. elseif (int3.ne.690706) then print*,' got ',intg1,r4,int2,iversion,int3 print "(a)",'*** WARNING: default int appears to be int*8: not implemented' else if (debug) print "(a)",' double precision dump' ! no need to print this endif if (iversion==690706) then ! handle old-format files (without version number) gracefully iversion = 0 endif endif if (iversion > splash_max_iversion) then print "(/a,i2,/,a,i2)",& ' *** WARNING: this copy of splash can only read version ',splash_max_iversion, & ' but the file format version is ',iversion if (.not.lenvironment('SSPLASH_IGNORE_IVERSION')) then print "(2(/,a))",' ** press any key to bravely proceed anyway ** ', & ' (set SSPLASH_IGNORE_IVERSION=yes to silence this warning)' read* endif endif ! !--read file ID ! read(iunit,iostat=ierr) fileident if (ierr /=0) then print "(a)",'*** ERROR READING FILE ID ***' close(iunit) return else print "(a)",' File ID: '//trim(fileident) endif mhddump = .false. rtdump = .false. call get_options_from_fileident(fileident,smalldump,tagged,phantomdump,& usingvecp,usingeulr,cleaning,h2chem,rt_in_header,batcode) if (tagged .and. iversion < 1) print "(a)",'ERROR: got tagged format but iversion is ',iversion ! !--read variables from header ! call read_header(iunit,iverbose,debug,doubleprec, & npart,npartoftypei,n1,ntypes,nblocks,narrsizes,dummyreal,tagsreal,nreals,ierr) if (ierr /= 0) then print "(a)",' *** ERROR READING HEADER ***' close(iunit) return endif ! !--Attempt to read all MPI blocks ! ntotal = 0 ntotblock = 0 nptmasstot = 0 i2 = 0 iptmass2 = 0 igotmass = .true. imadepmasscolumn = .false. massoftypei(:) = 0. over_MPIblocks: do iblock=1,nblocks ! !--read array header from this block ! if (iblock.eq.1) ncolstep = 0 do iarr=1,narrsizes call read_block_header(iunit,iblock,iarr,iverbose,debug, & isize,nint(iarr),nint1(iarr),nint2(iarr),nint4(iarr),nint8(iarr),& nreal(iarr),nreal4(iarr),nreal8(iarr),& ntotblock,npart,ntotal,nptmasstot,ncolstep,ierr) if (ierr /= 0) then print "(a)",' *** ERROR READING ARRAY SIZES ***' close(iunit) return endif enddo if (debug) print*,'DEBUG: ncolstep=',ncolstep,' from file header, also nptmasstot = ',nptmasstot ! !--this is a bug fix for a corrupt version of wdump outputting bad ! small dump files ! if (smalldump .and. nreal(1).eq.5 .and. iblock.eq.1 .and. lenvironment('SSPLASH_FIX_CORRUPT')) then print*,'FIXING CORRUPT HEADER ON SMALL DUMPS: assuming nreal=3 not 5' nreal(1) = 3 ncolstep = ncolstep - 2 endif npart_max = maxval(isize(1:narrsizes)) npart_max = max(npart_max,npart+nptmasstot,ntotal) ! !--work out from array header how many columns we are going to read ! in order to allocate memory ! if (iblock.eq.1) then igotmass = .true. if (smalldump .or. phantomdump) then if (phantomdump) then if (tagged) then call extract('massoftype',massoftypei(1:ntypes),dummyreal,tagsreal,nreals,ierr) else ! old phantom dumps had only 5 types call extract('massoftype',massoftypei(1:5),dummyreal,tagsreal,nreals,ierr) endif else call extract('pmassinitial',massoftypei(1),dummyreal,tagsreal,nreals,ierr) if (ierr /= 0) then print "(a)",' error extracting particle mass from small dump file' massoftypei(1) = 0. igotmass = .false. endif endif if (debug) print*,'DEBUG: got massoftype(gas) = ',massoftypei(1) if (any(massoftypei(1:ntypes).gt.tiny(0.)) .and. .not.lowmemorymode) then ncolstep = ncolstep + 1 ! make an extra column to contain particle mass imadepmasscolumn = .true. elseif (lowmemorymode) then igotmass = .false. else igotmass = .false. endif if (all(abs(massoftypei(1:ntypes)).lt.tiny(0.)) .and. nreal(1).lt.4) then print "(a)",' error: particle masses not present in small dump file' igotmass = .false. endif endif if (debug) print*,'DEBUG: gotmass = ',igotmass, ' ncolstep = ',ncolstep ! !-- to handle both small and full dumps, we need to place the quantities dumped ! in both small and full dumps at the start of the dat array ! quantities only in the full dump then come after ! also means that hydro/MHD are "semi-compatible" in the sense that x,y,z,m,h and rho ! are in the same place for both types of dump ! ix(1) = 1 ix(2) = 2 ix(3) = 3 if (igotmass) then ipmass = 4 ih = 5 irho = 6 nhydroarrays = 6 ! x,y,z,m,h,rho else ipmass = 0 ih = 4 irho = 5 nhydroarrays = 5 ! x,y,z,h,rho endif nhydroarraysinfile = nreal(1) + nreal4(1) + nreal8(1) nhydroreal4 = nreal4(1) if (imadepmasscolumn) nhydroarraysinfile = nhydroarraysinfile + 1 if (nhydroarraysinfile .lt.nhydroarrays .and. .not.phantomdump) then print "(a)",' ERROR: one of x,y,z,m,h or rho missing in small dump read' nhydroarrays = nreal(1)+nreal4(1)+nreal8(1) elseif (phantomdump .and. (nreal(1).lt.3 .or. nreal4(1).lt.1)) then print "(a)",' ERROR: x,y,z or h missing in phantom read' endif if (narrsizes.ge.4) then nmhdarrays = 3 ! Bx,By,Bz nmhd = nreal(4) + nreal4(4) + nreal8(4) - nmhdarrays ! how many "extra" mhd arrays if (debug) print*,'DEBUG: ',nmhd,' extra MHD arrays' else nmhdarrays = 0 endif !--radiative transfer dump? if (narrsizes.ge.3 .and. isize(3).eq.isize(1)) rtdump = .true. !--mhd dump? if (narrsizes.ge.4) mhddump = .true. if (.not.(mhddump.or.smalldump)) then ivx = nhydroarrays+1 elseif (mhddump .and. .not.smalldump) then ivx = nhydroarrays+nmhdarrays+1 else ivx = 0 endif !--need to force read of velocities e.g. for corotating frame subtraction if (any(required(ivx:ivx+ndimV-1))) required(ivx:ivx+ndimV-1) = .true. !--for phantom dumps, also make a column for density ! and divv, if a .divv file exists if (phantomdump) then ncolstep = ncolstep + 1 inquire(file=trim(dumpfile)//'.divv',exist=iexist) if (iexist) then idivvcol = ncolstep + 1 icurlvxcol = ncolstep + 2 icurlvycol = ncolstep + 3 icurlvzcol = ncolstep + 4 ncolstep = ncolstep + 4 endif endif endif ! !--allocate memory now that we know the number of columns ! if (iblock.eq.1) then ncolumns = ncolstep + ncalc if (ncolumns.gt.maxplot) then print*,'ERROR with ncolumns = ',ncolumns,' in data read' return endif ilastrequired = 0 do i=1,ncolumns if (required(i)) ilastrequired = i enddo endif if (npart_max.gt.maxpart .or. j.gt.maxstep .or. ncolumns.gt.maxcol) then if (lowmemorymode) then call alloc(max(npart_max+2,maxpart),j,ilastrequired) else call alloc(max(npart_max+2,maxpart),j,ncolumns,mixedtypes=.true.) endif endif ! !--now that memory has been allocated, copy info from the header into ! the relevant arrays ! if (iblock.eq.1) then call extract_variables_from_header(tagsreal,dummyreal,nreals,iverbose,debug, & gotbinary,nblocks,nptmasstot,npartoftypei,ntypes,& time(j),gamma(j),hfact,npart,ntotal,npartoftype(:,j),masstype(:,j), & dat(:,:,j),ix,ih,ipmass,ivx) nstepsread = nstepsread + 1 ! !--stop reading file here if no columns required ! if (ilastrequired.eq.0) exit over_MPIblocks if (allocated(iphase)) deallocate(iphase) allocate(iphase(npart_max+2)) if (phantomdump) then iphase(:) = 1 else iphase(:) = 0 endif if (gotbinary) then iphase(npart-1) = -3 iphase(npart) = -3 endif endif ! !--Arrays ! imaxcolumnread = 0 icolumn = 0 istartmhd = 0 istartrt = 0 i1 = i2 + 1 i2 = i1 + isize(1) - 1 if (debug) then print "(1x,a10,i4,3(a,i12))",'MPI block ',iblock,': particles: ',i1,' to ',i2,' of ',npart elseif (nblocks.gt.1) then if (iblock.eq.1) write(*,"(a,i1,a)",ADVANCE="no") ' reading MPI blocks: .' write(*,"('.')",ADVANCE="no") endif iptmass1 = iptmass2 + 1 iptmass2 = iptmass1 + isize(2) - 1 nptmass = nptmasstot if (nptmass.gt.0 .and. debug) print "(15x,3(a,i12))",' pt. masses: ',iptmass1,' to ',iptmass2,' of ',nptmass do iarr=1,narrsizes if (nreal(iarr) + nreal4(iarr) + nreal8(iarr).gt.0) then if (iarr.eq.4) then istartmhd = imaxcolumnread + 1 if (debug) print*,' istartmhd = ',istartmhd elseif (iarr.eq.3 .and. rtdump) then istartrt = max(nhydroarrays+nmhdarrays+1,imaxcolumnread + 1) if (debug) print*,' istartrt = ',istartrt endif endif !--read iphase from array block 1 if (iarr.eq.1) then !--skip default int nskip = nint(iarr) do i=1,nskip if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) enddo if (nint1(iarr).lt.1) then if (.not.phantomdump .or. any(npartoftypei(2:).gt.0)) then print "(a)",' WARNING: can''t locate iphase in dump' elseif (phantomdump) then print "(a)",' WARNING: can''t locate iphase in dump' endif gotiphase = .false. !--skip remaining integer arrays nskip = nint1(iarr) + nint2(iarr) + nint4(iarr) + nint8(iarr) else gotiphase = .true. if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) iphase(i1:i2) !--skip remaining integer arrays nskip = nint1(iarr) - 1 + nint2(iarr) + nint4(iarr) + nint8(iarr) endif elseif (smalldump .and. iarr.eq.2 .and. isize(iarr).gt.0 .and. .not.phantomdump) then !--read listpm from array block 2 for small dumps (needed here to extract sink masses) if (allocated(listpm)) deallocate(listpm) allocate(listpm(isize(iarr))) if (nint(iarr).lt.1) then print "(a)",'ERROR: can''t locate listpm in dump' nskip = nint(iarr) + nint1(iarr) + nint2(iarr) + nint4(iarr) + nint8(iarr) else if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) listpm(1:isize(iarr)) nskip = nint(iarr) - 1 + nint1(iarr) + nint2(iarr) + nint4(iarr) + nint8(iarr) endif else !--otherwise skip all integer arrays (not needed for plotting) nskip = nint(iarr) + nint1(iarr) + nint2(iarr) + nint4(iarr) + nint8(iarr) endif if (iarr.eq.3 .and. lenvironment('SSPLASH_BEN_HACKED')) then nskip = nskip - 1 print*,' FIXING HACKED DUMP FILE' endif !print*,'skipping ',nskip do i=1,nskip if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) enddo ! !--real arrays ! if (iarr.eq.2) then !--read sink particles from phantom dumps if (phantomdump .and. iarr.eq.2 .and. isize(iarr).gt.0) then if (nreal(iarr).lt.5) then print "(a)",'ERROR: not enough arrays written for sink particles in phantom dump' nskip = nreal(iarr) else iphase(npart+1:npart+isize(iarr)) = -3 ilocvx = nreal(iarr)-2 ! velocity is always last 3 numbers for phantom sinks if (doubleprec) then !--convert default real to single precision where necessary if (debug) print*,'DEBUG: reading sink data, converting from double precision ',isize(iarr) if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(isize(iarr)),stat=ierr) if (ierr /= 0) then print "(a)",'ERROR in memory allocation' return endif tagtmp = '' do k=1,nreal(iarr) if (tagged) read(iunit,end=33,iostat=ierr) tagtmp if (debug) print*,'DEBUG: reading sink array ',k,isize(iarr),' tag = ',trim(tagtmp) read(iunit,end=33,iostat=ierr) dattemp(1:isize(iarr)) if (ierr /= 0) print*,' ERROR during read of sink particle data, array ',k select case(k) case(1:3) iloc = ix(k) case(4) iloc = ipmass case(5) iloc = ih case default if (k >= ilocvx .and. k < ilocvx+3 .and. ivx > 0) then iloc = ivx + k-ilocvx ! put velocity into correct arrays else iloc = 0 endif end select if (iloc.gt.size(dat(1,:,j))) then; print*,' error iloc = ',iloc,ivx; stop; endif if (iloc.gt.0) then do i=1,isize(iarr) dat(npart+i,iloc,j) = real(dattemp(i)) enddo else if (debug) print*,'DEBUG: skipping sink particle array ',k endif enddo else if (debug) print*,'DEBUG: reading sink data, converting from single precision ',isize(iarr) if (allocated(dattempsingle)) deallocate(dattempsingle) allocate(dattempsingle(isize(iarr)),stat=ierr) if (ierr /= 0) then print "(a)",'ERROR in memory allocation' return endif do k=1,nreal(iarr) select case(k) case(1:3) iloc = ix(k) case(4) iloc = ipmass case(5) iloc = ih case default if (k >= ilocvx .and. k < ilocvx+3 .and. ivx > 0) then iloc = ivx + k-ilocvx ! put velocity into correct arrays else iloc = 0 endif end select if (iloc.gt.0) then if (debug) print*,'DEBUG: reading sinks into ',npart+1,'->',npart+isize(iarr),iloc if (tagged) read(iunit,end=33,iostat=ierr) !tagarr(iloc) read(iunit,end=33,iostat=ierr) dattempsingle(1:isize(iarr)) do i=1,isize(iarr) dat(npart+i,iloc,j) = real(dattempsingle(i)) enddo if (ierr /= 0) print*,' ERROR during read of sink particle data, array ',k else if (debug) print*,'DEBUG: skipping sink particle array ',k if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) endif enddo endif npart = npart + isize(iarr) endif elseif (smalldump .and. iarr.eq.2 .and. allocated(listpm)) then !--for sphNG, read sink particle masses from block 2 for small dumps if (nreal(iarr).lt.1) then if (isize(iarr).gt.0) print "(a)",'ERROR: sink masses not present in small dump' nskip = nreal(iarr) + nreal4(iarr) + nreal8(iarr) else if (doubleprec) then !--convert default real to single precision where necessary if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(isize(iarr)),stat=ierr) if (ierr /=0) print "(a)",'ERROR in memory allocation' if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) dattemp(1:isize(iarr)) if (nptmass.ne.isize(iarr)) print "(a)",'ERROR: nptmass.ne.block size' if (ipmass.gt.0) then do i=1,isize(iarr) dat(listpm(iptmass1+i-1),ipmass,j) = real(dattemp(i)) enddo else print*,'WARNING: sink particle masses not read because no mass array allocated' endif else !--convert default real to double precision where necessary if (allocated(dattempsingle)) deallocate(dattempsingle) allocate(dattempsingle(isize(iarr)),stat=ierr) if (ierr /=0) print "(a)",'ERROR in memory allocation' if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) dattempsingle(1:isize(iarr)) if (nptmass.ne.isize(iarr)) print "(a)",'ERROR: nptmass.ne.block size' if (ipmass.gt.0) then do i=1,isize(iarr) dat(listpm(iptmass1+i-1),ipmass,j) = real(dattempsingle(i)) enddo else print*,'WARNING: sink particle masses not read because no mass array allocated' endif endif nskip = nreal(iarr) - 1 + nreal4(iarr) + nreal8(iarr) endif else !--for other blocks, skip real arrays if size different nskip = nreal(iarr) + nreal4(iarr) + nreal8(iarr) endif do i=1,nskip if (tagged) read(iunit,end=33,iostat=ierr) ! skip tags read(iunit,end=33,iostat=ierr) enddo ! deallocate dattempsingle if (allocated(dattempsingle)) deallocate(dattempsingle) elseif (isize(iarr).eq.isize(1)) then ! !--read all real arrays defined on all the particles (same size arrays as block 1) ! if ((doubleprec.and.nreal(iarr).gt.0).or.nreal8(iarr).gt.0) then if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(isize(iarr)),stat=ierr) if (ierr /=0) print "(a)",'ERROR in memory allocation (read_data_sphNG: dattemp)' elseif (nreal(iarr).gt.0 .or. nreal8(iarr).gt.0) then if (allocated(dattempsingle)) deallocate(dattempsingle) allocate(dattempsingle(isize(iarr)),stat=ierr) if (ierr /=0) print "(a)",'ERROR in memory allocation (read_data_sphNG: dattempsingle)' endif ! default reals may need converting do i=1,nreal(iarr) tagtmp = '' if (tagged) read(iunit,end=33,iostat=ierr) tagtmp icolumn = assign_column(tagtmp,iarr,i,6,imaxcolumnread) if (tagged) tagarr(icolumn) = tagtmp if (debug) print*,' reading real ',icolumn,' tag = ',trim(tagtmp) if (required(icolumn)) then if (doubleprec) then read(iunit,end=33,iostat=ierr) dattemp(1:isize(iarr)) dat(i1:i2,icolumn,j) = real(dattemp(1:isize(iarr))) else read(iunit,end=33,iostat=ierr) dattempsingle(1:isize(iarr)) dat(i1:i2,icolumn,j) = real(dattempsingle(1:isize(iarr))) endif else read(iunit,end=33,iostat=ierr) endif enddo ! ! set masses for equal mass particles (not dumped in small dump or in phantom) ! if (((smalldump.and.nreal(1).lt.ipmass).or.phantomdump).and. iarr.eq.1) then if (abs(masstype(1,j)).gt.tiny(masstype)) then icolumn = ipmass if (required(ipmass) .and. ipmass.gt.0) then if (phantomdump) then dat(i1:i2,ipmass,j) = masstype(itypemap_phantom(iphase(i1:i2)),j) else where (iphase(i1:i2).eq.0) dat(i1:i2,icolumn,j) = masstype(1,j) endif endif !--dust mass for phantom particles if (phantomdump .and. npartoftypei(itypemap_dust_phantom).gt.0 .and. ipmass.gt.0) then print*,'dust particle mass = ',masstype(itypemap_dust_phantom,j),& ' ratio m_dust/m_gas = ',masstype(itypemap_dust_phantom,j)/masstype(1,j) endif if (debug) print*,'mass ',icolumn elseif (phantomdump .and. npartoftypei(1).gt.0) then print*,' ERROR: particle mass zero in Phantom dump file!' endif endif ! ! real4 arrays (may need converting if splash is compiled in double precision) ! if (nreal4(iarr).gt.0 .and. kind(dat).eq.doub_prec) then if (allocated(dattempsingle)) deallocate(dattempsingle) allocate(dattempsingle(isize(iarr)),stat=ierr) if (ierr /=0) print "(a)",'ERROR in memory allocation (read_data_sphNG: dattempsingle)' endif if (debug) print*,'DEBUG: SIZE of dattempsingle',size(dattempsingle) ! real4s may need converting imaxcolumnread = max(imaxcolumnread,icolumn) if ((nreal(iarr)+nreal4(iarr)).gt.6) imaxcolumnread = max(imaxcolumnread,6) do i=1,nreal4(iarr) tagtmp = '' if (tagged) read(iunit,end=33,iostat=ierr) tagtmp icolumn = assign_column(tagtmp,iarr,i,4,imaxcolumnread) if (debug) print*,'reading real4 ',icolumn,' tag = ',trim(tagtmp) if (tagged) tagarr(icolumn) = tagtmp if (phantomdump .and. icolumn==ih) required(ih) = .true. ! h always required for density if (required(icolumn)) then if (allocated(dattempsingle)) then read(iunit,end=33,iostat=ierr) dattempsingle(1:isize(iarr)) dat(i1:i2,icolumn,j) = real(dattempsingle(1:isize(iarr))) else read(iunit,end=33,iostat=ierr) dat(i1:i2,icolumn,j) endif else read(iunit,end=33,iostat=ierr) endif !--construct density for phantom dumps based on h, hfact and particle mass if (phantomdump .and. icolumn.eq.ih) then icolumn = irho ! density ! !--dead particles have -ve smoothing lengths in phantom ! so use abs(h) for these particles and hide them ! if (any(npartoftypei(2:).gt.0)) then if (.not.required(ih)) print*,'ERROR: need to read h, but required=F' !--need masses for each type if not all gas if (debug) print*,'DEBUG: phantom: setting h for multiple types ',i1,i2 if (debug) print*,'DEBUG: massoftype = ',masstype(:,j) do k=i1,i2 itype = itypemap_phantom(iphase(k)) pmassi = masstype(itype,j) hi = dat(k,ih,j) if (hi > 0.) then if (required(irho)) dat(k,irho,j) = pmassi*(hfact/hi)**3 elseif (hi < 0.) then npartoftype(itype,j) = npartoftype(itype,j) - 1 npartoftype(itypemap_unknown_phantom,j) = npartoftype(itypemap_unknown_phantom,j) + 1 if (required(irho)) dat(k,irho,j) = pmassi*(hfact/abs(hi))**3 else if (required(irho)) dat(k,irho,j) = 0. endif enddo else if (.not.required(ih)) print*,'ERROR: need to read h, but required=F' if (debug) print*,'debug: phantom: setting rho for all types' !--assume all particles are gas particles do k=i1,i2 hi = dat(k,ih,j) if (hi.gt.0.) then rhoi = massoftypei(1)*(hfact/hi)**3 elseif (hi.lt.0.) then rhoi = massoftypei(1)*(hfact/abs(hi))**3 iphase(k) = -1 else ! if h = 0. rhoi = 0. iphase(k) = -2 endif if (required(irho)) dat(k,irho,j) = rhoi enddo endif if (debug) print*,'debug: making density ',icolumn endif enddo ! real 8's need converting do i=1,nreal8(iarr) tagtmp = '' if (tagged) read(iunit,end=33,iostat=ierr) tagtmp icolumn = assign_column(tagtmp,iarr,i,8,imaxcolumnread) if (debug) print*,'reading real8 ',icolumn,' tag = ',trim(tagtmp) if (tagged) tagarr(icolumn) = tagtmp if (required(icolumn)) then read(iunit,end=33,iostat=ierr) dattemp(1:isize(iarr)) dat(i1:i2,icolumn,j) = real(dattemp(1:isize(iarr))) else read(iunit,end=33,iostat=ierr) endif enddo endif enddo ! over array sizes enddo over_MPIblocks ! !--reached end of file (during data read) ! goto 34 33 continue print "(/,1x,a,/)",'*** WARNING: END OF FILE DURING READ ***' print*,'Press any key to continue (but there is likely something wrong with the file...)' read* 34 continue ! !--read .divv file for phantom dumps ! if (phantomdump .and. idivvcol.ne.0 .and. any(required(idivvcol:icurlvzcol))) then print "(a)",' reading divv from '//trim(dumpfile)//'.divv' open(unit=66,file=trim(dumpfile)//'.divv',form='unformatted',status='old',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR opening '//trim(dumpfile)//'.divv' else read(66,iostat=ierr) dat(1:ntotal,idivvcol,j) if (ierr /= 0) print "(a)",' WARNING: ERRORS reading divv from file' if (any(required(icurlvxcol:icurlvzcol))) then read(66,iostat=ierr) dat(1:ntotal,icurlvxcol,j) read(66,iostat=ierr) dat(1:ntotal,icurlvycol,j) read(66,iostat=ierr) dat(1:ntotal,icurlvzcol,j) endif if (ierr /= 0) print "(a)",' WARNING: ERRORS reading curlv from file' close(66) endif endif ! !--reset centre of mass to zero if environment variable "SSPLASH_RESET_CM" is set ! if (allocated(dat) .and. n1.GT.0 .and. n1 <= size(dat(:,1,1)) & .and. lenvironment('SSPLASH_RESET_CM') .and. allocated(iphase)) then call reset_centre_of_mass(dat(1:n1,1:3,j),dat(1:n1,4,j),iphase(1:n1),n1) endif ! !--remove particles at large H/R is "SSPLASH_REMOVE_LARGE_HR" is set ! if (lenvironment('SSPLASH_REMOVE_LARGE_HR')) then hrlim = renvironment('SSPLASH_HR_LIMIT') print "(a)", 'SSPLASH_REMOVE_LARGE_HR set:' print "(a)", 'Removing particles at large H/R values' print "(a,F7.4)", 'H/R limit set to ',hrlim nremoved = 0 do i = 1,npart if (int(iphase(i)) == 0) then rad2d = sqrt(dat(i,1,j)**2 + dat(i,2,j)**2) if (abs(dat(i,3,j) / rad2d) >= hrlim) then iphase(i) = -1 nremoved = nremoved + 1 endif endif enddo print "(I5,a)", nremoved, ' particles removed at large H/R' endif ! !--reset corotating frame velocities if environment variable "SSPLASH_OMEGA" is set ! if (allocated(dat) .and. n1.GT.0 .and. all(required(1:2))) then omega = renvironment('SSPLASH_OMEGAT') if (abs(omega).gt.tiny(omega) .and. ndim.ge.2) then call reset_corotating_positions(n1,dat(1:n1,1:2,j),omega,time(j)) endif if (.not. smalldump) then if (abs(omega).lt.tiny(omega)) omega = renvironment('SSPLASH_OMEGA') if (abs(omega).gt.tiny(omega) .and. ivx.gt.0) then if (.not.all(required(1:2)) .or. .not.all(required(ivx:ivx+1))) then print*,' ERROR subtracting corotating frame with partial data read' else call reset_corotating_velocities(n1,dat(1:n1,1:2,j),dat(1:n1,ivx:ivx+1,j),omega) endif endif endif endif !--set flag to indicate that only part of this file has been read if (.not.all(required(1:ncolstep))) ipartialread = .true. nptmassi = 0 nunknown = 0 ngas = 0 nstar = 0 !--can only do this loop if we have read the iphase array iphasealloc: if (allocated(iphase)) then ! !--translate iphase into particle types (mixed type storage) ! if (size(iamtype(:,j)).gt.1) then if (phantomdump) then ! !--phantom: translate iphase to splash types ! do i=1,npart itype = itypemap_phantom(iphase(i)) iamtype(i,j) = itype select case(itype) case(1,2,4) ! remove accreted particles if (ih.gt.0 .and. required(ih)) then if (dat(i,ih,j) <= 0.) then iamtype(i,j) = itypemap_unknown_phantom endif endif case(itypemap_unknown_phantom) nunknown = nunknown + 1 end select enddo else ! !--sphNG: translate iphase to splash types ! do i=1,npart itype = itypemap_sphNG(iphase(i)) iamtype(i,j) = itype select case(itype) case(1) ngas = ngas + 1 case(3) nptmassi = nptmassi + 1 case(4) nstar = nstar + 1 case default nunknown = nunknown + 1 end select enddo do i=npart+1,ntotal iamtype(i,j) = 2 enddo endif !print*,'mixed types: ngas = ',ngas,nptmassi,nunknown elseif (any(iphase(1:ntotal).ne.0)) then if (phantomdump) then print*,'ERROR: low memory mode will not work correctly with phantom + multiple types' print*,'press any key to ignore this and continue anyway (at your own risk...)' read* endif ! !--place point masses after normal particles ! if not storing the iamtype array ! print "(a)",' sorting particles by type...' nunknown = 0 do i=1,npart if (iphase(i).ne.0) nunknown = nunknown + 1 enddo ncolcopy = min(ncolstep,maxcol) allocate(dattemp2(nunknown,ncolcopy)) iphaseminthistype = 0 ! to avoid compiler warnings iphasemaxthistype = 0 do itype=1,3 nthistype = 0 ipos = 0 select case(itype) case(1) ! ptmass iphaseminthistype = 1 iphasemaxthistype = 9 case(2) ! star iphaseminthistype = 10 iphasemaxthistype = huge(iphasemaxthistype) case(3) ! unknown iphaseminthistype = -huge(iphaseminthistype) iphasemaxthistype = -1 end select do i=1,ntotal ipos = ipos + 1 if (iphase(i).ge.iphaseminthistype .and. iphase(i).le.iphasemaxthistype) then nthistype = nthistype + 1 !--save point mass information in temporary array if (nptmassi.gt.size(dattemp2(:,1))) stop 'error: ptmass array bounds exceeded in data read' dattemp2(nthistype,1:ncolcopy) = dat(i,1:ncolcopy,j) ! print*,i,' removed', dat(i,1:3,j) ipos = ipos - 1 endif !--shuffle dat array if (ipos.ne.i .and. i.lt.ntotal) then ! print*,'copying ',i+1,'->',ipos+1 dat(ipos+1,1:ncolcopy,j) = dat(i+1,1:ncolcopy,j) !--must also shuffle iphase (to be correct for other types) iphase(ipos+1) = iphase(i+1) endif enddo !--append this type to end of dat array do i=1,nthistype ipos = ipos + 1 ! print*,ipos,' appended', dattemp2(i,1:3) dat(ipos,1:ncolcopy,j) = dattemp2(i,1:ncolcopy) !--we make iphase = 1 for point masses (could save iphase and copy across but no reason to) iphase(ipos) = iphaseminthistype enddo select case(itype) case(1) nptmassi = nthistype if (nptmassi.ne.nptmass) print *,'WARNING: nptmass from iphase =',nptmassi,'not equal to nptmass =',nptmass case(2) nstar = nthistype case(3) nunknown = nthistype end select enddo endif endif iphasealloc if (allocated(dattemp)) deallocate(dattemp) if (allocated(dattempsingle)) deallocate(dattempsingle) if (allocated(dattemp2)) deallocate(dattemp2) if (allocated(iphase)) deallocate(iphase) if (allocated(listpm)) deallocate(listpm) call set_labels if (.not.phantomdump) then npartoftype(:,j) = 0 npartoftype(1,j) = npart - nptmassi - nstar - nunknown npartoftype(2,j) = ntotal - npart npartoftype(3,j) = nptmassi npartoftype(4,j) = nstar npartoftype(5,j) = nunknown else npartoftype(1,j) = npartoftype(1,j) - nunknown npartoftype(itypemap_unknown_phantom,j) = npartoftype(itypemap_unknown_phantom,j) + nunknown endif call print_types(npartoftype(:,j),labeltype) close(15) if (debug) print*,' finished data read, npart = ',npart, ntotal, npartoftype(1:ntypes,j) return contains ! !--reset centre of mass to zero ! subroutine reset_centre_of_mass(xyz,pmass,iphase,np) implicit none integer, intent(in) :: np real, dimension(np,3), intent(inout) :: xyz real, dimension(np), intent(in) :: pmass integer(kind=int1), dimension(np), intent(in) :: iphase real :: masstot,pmassi real, dimension(3) :: xcm integer :: i ! !--get centre of mass ! xcm(:) = 0. masstot = 0. do i=1,np if (iphase(i).ge.0) then pmassi = pmass(i) masstot = masstot + pmass(i) where (required(1:3)) xcm(:) = xcm(:) + pmassi*xyz(i,:) endif enddo xcm(:) = xcm(:)/masstot print*,'RESETTING CENTRE OF MASS (',pack(xcm,required(1:3)),') TO ZERO ' if (required(1)) xyz(1:np,1) = xyz(1:np,1) - xcm(1) if (required(2)) xyz(1:np,2) = xyz(1:np,2) - xcm(2) if (required(3)) xyz(1:np,3) = xyz(1:np,3) - xcm(3) return end subroutine reset_centre_of_mass subroutine reset_corotating_velocities(np,xy,velxy,omeg) implicit none integer, intent(in) :: np real, dimension(np,2), intent(in) :: xy real, dimension(np,2), intent(inout) :: velxy real, intent(in) :: omeg integer :: ip print*,'SUBTRACTING COROTATING VELOCITIES, OMEGA = ',omeg do ip=1,np velxy(ip,1) = velxy(ip,1) + xy(ip,2)*omeg enddo do ip=1,np velxy(ip,2) = velxy(ip,2) - xy(ip,1)*omeg enddo return end subroutine reset_corotating_velocities subroutine reset_corotating_positions(np,xy,omeg,t) implicit none integer, intent(in) :: np real, dimension(np,2), intent(inout) :: xy real, intent(in) :: omeg,t real :: phii,phinew,r integer :: ip print*,'SUBTRACTING COROTATING POSITIONS, OMEGA = ',omeg,' t = ',t !$omp parallel default(none) & !$omp shared(xy,np) & !$omp firstprivate(omeg,t) & !$omp private(ip,r,phii,phinew) !$omp do do ip=1,np r = sqrt(xy(ip,1)**2 + xy(ip,2)**2) phii = atan2(xy(ip,2),xy(ip,1)) phinew = phii + omeg*t xy(ip,1) = r*COS(phinew) xy(ip,2) = r*SIN(phinew) enddo !$omp end do !$omp end parallel return end subroutine reset_corotating_positions end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,unitslabel,labelzintegration,labeltype,labelvec,iamvec, & ix,ipmass,irho,ih,iutherm,ivx,iBfirst,idivB,iJfirst,icv,iradenergy,idustfrac use params use settings_data, only:ndim,ndimV,ntypes,ncolumns,UseTypeInRenderings,debugmode use geometry, only:labelcoord use settings_units, only:units,unitzintegration use sphNGread use asciiutils, only:lcase use system_commands, only:get_environment use system_utils, only:lenvironment implicit none integer :: i real(doub_prec) :: uergg character(len=20) :: string if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif !--all formats read the following columns do i=1,ndim ix(i) = i enddo if (igotmass) then ipmass = 4 ! particle mass ih = 5 ! smoothing length else ipmass = 0 ih = 4 ! smoothing length endif irho = ih + 1 ! density if (smalldump .and. nhydroreal4.ge.3) iutherm = irho+1 ! !--translate array tags into column labels, where necessary ! if (tagged) then do i=1,ncolumns label(i) = tagarr(i) select case(trim(tagarr(i))) case('m') ipmass = i case('h') ih = i case('rho') irho = i case('vx') ivx = i case('u') iutherm = i case('divv') idivvcol = i case('curlvx') icurlvxcol = i case('curlvy') icurlvycol = i case('curlvz') icurlvzcol = i case('Bx') iBfirst = i case('divB') idivB = i case('curlBx') iJfirst = i case('psi') label(i) = '\psi' case('dustfrac') idustfrac = i case('alpha') label(i) = '\alpha' case('alphaB') label(i) = '\alpha_B' case('EulerAlpha') label(i) = 'Euler \alpha' case('EulerBeta') label(i) = 'Euler \beta' case('EtaReal') label(i) = '\eta_{real}' case('EtaArtificial') label(i) = '\eta_{art}' case('Erad') iradenergy = i label(i) = 'radiation energy' units(iradenergy) = (udist/utime)**2 case('opacity') label(i) = 'opacity' units(i) = udist**2/umass case('EddingtonFactor') label(i) = 'Eddington Factor' case('Cv') label(i) = 'u/T' icv = i units(icv) = (udist/utime)**2 case('h2ratio') label(i) = 'H_2 ratio' case('abH1q','abHIq') label(i) = 'HI abundance' case('abhpq') label(i) = 'proton abundance' case('abeq') label(i) = 'e^- abundance' case('abco') label(i) = 'CO abundance' case default if (debugmode) print "(a,i2)",' DEBUG: Unknown label '''//trim(tagarr(i))//''' in column ',i label(i) = tagarr(i) end select enddo else call guess_labels(ncolumns,iamvec,label,labelvec,istartmhd,istart_extra_real4,& nmhd,nhydroreal4,ndimV,irho,iBfirst,ivx,iutherm,idivB,iJfirst,& iradenergy,icv,udist,utime,units,unitslabel) endif label(ix(1:ndim)) = labelcoord(1:ndim,1) if (irho.gt.0) label(irho) = 'density' if (iutherm.gt.0) label(iutherm) = 'u' if (ih.gt.0) label(ih) = 'h ' if (ipmass.gt.0) label(ipmass) = 'particle mass' if (idivB.gt.0) label(idivB) = 'div B' if (idivvcol.gt.0) label(idivvcol) = 'div v' if (icurlvxcol.gt.0) label(icurlvxcol) = 'curl v_x' if (icurlvycol.gt.0) label(icurlvycol) = 'curl v_y' if (icurlvzcol.gt.0) label(icurlvzcol) = 'curl v_z' if (icurlvxcol.gt.0 .and. icurlvycol.gt.0 .and. icurlvzcol.gt.0) then iamvec(icurlvxcol:icurlvzcol) = icurlvxcol labelvec(icurlvxcol:icurlvzcol) = 'curl v' endif ! !--set labels for vector quantities ! if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'_'//labelcoord(i,1) enddo endif if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'_'//labelcoord(i,1) enddo endif if (iJfirst.gt.0) then iamvec(iJfirst:iJfirst+ndimV-1) = iJfirst labelvec(iJfirst:iJfirst+ndimV-1) = 'J' do i=1,ndimV label(iJfirst+i-1) = trim(labelvec(iJfirst))//'_'//labelcoord(i,1) enddo endif ! !--set units for plot data ! ! npower = int(log10(udist)) ! udist = udist/10.**npower ! udistAU = udist/1.495979e13 if (ndim.ge.3) then units(1:3) = udist unitslabel(1:3) = ' [cm]' endif ! do i=1,3 ! write(unitslabel(i),"('[ 10\u',i2,'\d cm]')") npower ! enddo if (ipmass.gt.0) then units(ipmass) = umass unitslabel(ipmass) = ' [g]' endif units(ih) = udist unitslabel(ih) = ' [cm]' if (ivx.gt.0) then units(ivx:ivx+ndimV-1) = udist/utime unitslabel(ivx:ivx+ndimV-1) = ' [cm/s]' endif if (iutherm.gt.0) then units(iutherm) = (udist/utime)**2 unitslabel(iutherm) = ' [erg/g]' endif units(irho) = umass/udist**3 unitslabel(irho) = ' [g/cm\u3\d]' if (iBfirst.gt.0) then units(iBfirst:iBfirst+ndimV-1) = umagfd unitslabel(iBfirst:iBfirst+ndimV-1) = ' [G]' endif !--use the following two lines for time in years call get_environment('SSPLASH_TIMEUNITS',string) select case(trim(lcase(adjustl(string)))) case('s','seconds') units(0) = utime unitslabel(0) = trim(string) case('min','minutes','mins') units(0) = utime/60.d0 unitslabel(0) = trim(string) case('h','hr','hrs','hours','hour') units(0) = utime/3600.d0 unitslabel(0) = trim(string) case('y','yr','yrs','years','year') units(0) = utime/3.1536d7 unitslabel(0) = trim(string) case('d','day','days') units(0) = utime/(3600.d0*24.d0) unitslabel(0) = trim(string) case('tff','freefall','tfreefall') !--or use these two lines for time in free-fall times units(0) = 1./tfreefall unitslabel(0) = ' ' case default units(0) = utime/3.1536d7 unitslabel(0) = ' yrs' end select !--or use these two lines for time in free-fall times !units(0) = 1./tfreefall !unitslabel(0) = ' ' unitzintegration = udist labelzintegration = ' [cm]' ! !--set labels for each particle type ! if (phantomdump) then ! phantom ntypes = itypemap_unknown_phantom labeltype(1) = 'gas' labeltype(2) = 'dust' labeltype(3) = 'sink' labeltype(4) = 'ghost' labeltype(5) = 'star' labeltype(6) = 'dark matter' labeltype(7) = 'bulge' labeltype(8) = 'unknown/dead' UseTypeInRenderings(:) = .true. UseTypeInRenderings(3) = .false. if (lenvironment('SSPLASH_PLOT_DUST')) then UseTypeInRenderings(2) = .false. endif if (lenvironment('SSPLASH_PLOT_STARS')) then UseTypeInRenderings(5) = .false. endif if (lenvironment('SSPLASH_PLOT_DM')) then UseTypeInRenderings(6) = .false. endif else ntypes = 5 labeltype(1) = 'gas' labeltype(2) = 'ghost' labeltype(3) = 'sink' labeltype(4) = 'star' labeltype(5) = 'unknown/dead' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. UseTypeInRenderings(4) = .true. UseTypeInRenderings(5) = .true. ! only applies if turned on endif !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_sphysics.f90000644 000770 000000 00000021630 12156076073 017721 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! the data is stored in the global array dat ! ! THIS VERSION FOR THE DUAL SPHYSICS CODE ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- !--local module to store header information so we can later set the labels module sphysicsdata use params use labels, only:lenlabel implicit none end module sphysicsdata subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:npartoftype,masstype,time,gamma,dat,maxpart,maxstep,maxcol,iamtype use params use filenames, only:nfiles use settings_data, only:ndim,ndimV,ncolumns,ncalc, & buffer_data,iverbose,debugmode,ntypes use mem_allocation, only:alloc use labels, only:ipr,ivx,ih,irho,labeltype implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname character(len=len(rootname)+4) :: datfile integer :: i,ierr,iunit,j,iblock integer :: npart_max,nstep_max integer, dimension(:), allocatable :: itype character(len=20) :: geomfile character(len=7) :: keyword character(len=70) :: title character(len=1) :: dumchar character(len=16) :: unitsys integer :: istep,jtype,np,ione,kk,idum,nblock real(kind=sing_prec) :: version,timesingle,dum real(kind=doub_prec) :: versiond,timedbl,dumd real :: timein,dx,dy logical :: singleprecision iunit = 11 ! file unit number nstepsread = 0 if (rootname(1:1).ne.' ') then datfile = trim(rootname) else print*,' **** no data read **** ' return endif if (iverbose.ge.1) print "(1x,a)",'reading Dual SPHysics format' write(*,"(23('-'),1x,a,1x,23('-'))") trim(datfile) ndim = 2 ndimV = 2 ! !--open data file and read data ! open(unit=iunit,iostat=ierr,file=datfile,status='old',form='unformatted',access='stream') if (ierr /= 0) then print*,' *** Error opening '//trim(datfile)//' ***' return endif ! !--read first header line ! read(iunit,iostat=ierr,end=80) keyword read(iunit,iostat=ierr,end=80) version read(iunit,iostat=ierr,end=80) title read(iunit,iostat=ierr,end=80) istep read(iunit,iostat=ierr,end=80) timesingle timein = timesingle read(iunit,iostat=ierr,end=80) np read(iunit,iostat=ierr,end=80) ione if (ierr /= 0 .or. np <= 0 .or. timesingle.lt.0.) then ! !--try single precision ! rewind(iunit) read(iunit,iostat=ierr,end=80) keyword read(iunit,iostat=ierr,end=80) versiond version = versiond read(iunit,iostat=ierr,end=80) title read(iunit,iostat=ierr,end=80) istep read(iunit,iostat=ierr,end=80) timedbl timein = timedbl read(iunit,iostat=ierr,end=80) np read(iunit,iostat=ierr,end=80) ione singleprecision = .false. if (ierr /= 0 .or. np < 0 .or. timedbl < 0.) then print "(a)",' *** Error reading first header ***' close(iunit) return endif endif print "(a,f4.2)",' keyword = '//trim(keyword)//' version = ',version !print "(a)",' title = '//trim(title) print "(a,i6,a,es10.3,a,i6)",' step = ',istep,' time = ',timein,' np = ',np ! !--allocate memory for data arrays ! if (buffer_data) then nstep_max = max(nfiles,maxstep,indexstart) else nstep_max = max(1,maxstep,indexstart) endif npart_max = max(int(1.1*np),maxpart) ncolumns = 7 if (.not.allocated(dat) .or. npart_max.gt.maxpart & .or. nstep_max.gt.maxstep .or. ncolumns+ncalc.gt.maxcol) then call alloc(npart_max,nstep_max,ncolumns+ncalc,mixedtypes=.true.) endif i = indexstart nstepsread = 0 time(i) = timein gamma(i) = 5./3. npartoftype(1,i) = np do j=1,np read(iunit,iostat=ierr,end=67) idum,(dat(j,kk,i),kk=1,2),dum enddo read(iunit,iostat=ierr,end=67) nblock read(iunit,iostat=ierr,end=67) (idum,j=1,nblock) ntypes = 4 allocate(itype(np)) read(iunit,iostat=ierr,end=67) (itype(j),j=1,nblock) npartoftype(:,i) = 0 do j=1,np jtype = itype(j) !--map types from code types to splash types select case(jtype) case(1) jtype = 2 ! boundary case(2) jtype = 1 ! water case default ! unknown jtype = 4 end select iamtype(j,i) = jtype npartoftype(jtype,i) = npartoftype(jtype,i) + 1 enddo deallocate(itype) read(iunit,iostat=ierr,end=67) (dumchar,j=1,nblock) read(iunit,iostat=ierr,end=67) (idum,j=1,nblock) call set_labels do iblock=1,1 read(iunit,iostat=ierr,end=67) nblock read(iunit,iostat=ierr,end=67) idum do j=1,nblock read(iunit,iostat=ierr,end=67) compName(j),unitsys,idum,idum,dum !print*,trim(compName(j)) enddo do j=1,np read(iunit,iostat=ierr,end=67) dum,dat(j,ipr,i),dat(j,ivx,i),dat(j,ivx+1,i),dat(j,1,i),dat(j,2,i) if (abs(dum).lt.tiny(0.)) then npartoftype(iamtype(j,i),i) = npartoftype(iamtype(j,i),i) - 1 ! remove from previous type iamtype(j,i) = 3 npartoftype(3,i) = npartoftype(3,i) + 1 ! add to "box" type endif enddo enddo ! !--fake other properties: density, mass, smoothing length etc. ! masstype(1,i) = 1./npartoftype(1,i) ! !--assume smoothing length to be the max dimension divided by the number of particles^(1/ndim) ! dx = maxval(dat(1:np,1,i)) - minval(dat(1:np,1,i)) dy = maxval(dat(1:np,2,i)) - minval(dat(1:np,2,i)) dat(:,ih,i) = dx/(npartoftype(1,i))**(1./ndim)*(dy/dx) print*,' WARNING: ASSUMING SMOOTHING LENGTH = ',dat(1,ih,i),' AND ARBITRARY PARTICLE MASSES' dat(:,irho,i) = 1. nstepsread = 1 do jtype=1,ntypes write(*,"(' n(',a,') = ',i6)",advance="no") trim(labeltype(jtype)),npartoftype(jtype,i) enddo write(*,*) !read* goto 68 67 continue print "(a)",' > end of file reached <' 68 continue ! !--close data file and return ! close(unit=11) if (debugmode) print*,'DEBUG> Read steps ',indexstart,'->',indexstart + nstepsread - 1, & ' last step ntot = ',sum(npartoftype(:,indexstart+nstepsread-1)) return 80 continue print*,' *** data file empty : no timesteps ***' return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:ix,ivx,ih,irho,ipr,& iamvec,labelvec,label,labeltype use params use settings_data, only:ndim,ndimV,UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = ndim + 1 ipr = ndim + ndimV + 1 irho = ipr + 1 ih = irho + 1 label(ipr) = 'pressure' label(irho) = 'density' label(ih) = 'h' label(ix(1:ndim)) = labelcoord(1:ndim,1) ! !--label vector quantities (e.g. velocity) appropriately ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' ! !--set labels for each type of particles ! labeltype(1) = 'water' labeltype(2) = 'boundary' labeltype(3) = 'box' labeltype(4) = 'unknown' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. UseTypeInRenderings(3) = .false. UseTypeInRenderings(4) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_spyros.f90000644 000770 000000 00000015166 11622211702 017405 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM THE VINE CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: j,ierr,ntoti,irec integer :: npart_max,nstep_max,ncolstep logical :: iexist character(len=len(rootname)+10) :: dumpfile !--we are assuming dump is double precision real(doub_prec) :: variable1,variable2 real(doub_prec), dimension(:), allocatable :: dattemp nstepsread = 0 npart_max = maxpart dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 ! !--allocate memory initially ! nstep_max = max(indexstart,1) j = indexstart nstepsread = 0 print "(1x,a)",'reading Spyros Kitsonias'' format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='unformatted',& access='direct',recl=4000000) if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' else ! !--read timestep header (integers only) ! read(15,iostat=ierr) variable1,variable2 if (ierr < 0) then print "(a)",'*** END OF FILE IN TIMESTEP HEADER ***' return elseif (ierr /= 0) then print "(a)",'*** ERROR READING TIMESTEP HEADER ***' return endif ! !--get number of particles from header and allocate memory ! ntoti = int(variable1) ncolstep = int(variable2) ncolumns = ncolstep if (.not.allocated(dat) .or. ntoti.gt.npart_max) then npart_max = max(npart_max,INT(1.1*ntoti)) call alloc(npart_max,nstep_max,ncolstep+ncalc) endif ! !--rewind file ! rewind(15) endif npart_max = max(npart_max,ntoti) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+2*nstepsread,maxcol) endif ! !--allocate a temporary array for double precision variables ! if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(npart_max),stat=ierr) dattemp = 0. if (ierr /= 0) print*,'not enough memory in read_data' ! !--now read the timestep data in the dumpfile ! print "(a,i5,a,f8.3,a,i8)",'| step ',j,': t = ',time(j),' ntotal = ',ntoti nstepsread = nstepsread + 1 ! !--set particle numbers ! npartoftype(:,j) = 0 npartoftype(1,j) = ntoti ! !--read all records ! overcolumns: do irec=1,ncolstep read(15,rec=irec,iostat=ierr) variable1,variable2,dattemp(1:ntoti) if (ierr < 0) then print "(a)",'*** END OF FILE IN READ DATA (CHECK PRECISION) ***' exit overcolumns elseif (ierr /= 0) then print "(a)",'*** ERROR READING DATA ***' exit overcolumns endif ! !--time and gamma ! if (irec.eq.2) time(j) = real(variable1) if (irec.eq.5) gamma(j) = real(variable2) ! !--convert to single precision ! dat(1:ntoti,irec,j) = real(dattemp(1:ntoti)) enddo overcolumns ! !--clean up ! if (allocated(dattemp)) deallocate(dattemp) ! !--close file ! close(15) if (nstepsread .gt. 0) then print*,'>> end of dump file: ntotal = ',sum(npartoftype(:,j)) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels use params use settings_data use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ih = 10 ! smoothing length iutherm = 9 ! thermal energy ipmass = 8 ! particle mass irho = 7 ! location of rho in data array label(ix(1:ndim)) = labelcoord(1:ndim,1) label(irho) = 'density' label(iutherm) = 'temperature' label(ih) = 'h' label(ipmass) = 'particle mass' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo ! !--set labels for each particle type ! ntypes = 1 labeltype(1) = 'gas' UseTypeInRenderings(1) = .true. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_sro.f90000644 000770 000000 00000064077 12160267416 016671 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM STEPHAN ROSSWOG'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! RSPLASH_FORMAT can be 'MHD' or 'HYDRO' ! RSPLASH_RESET_COM if 'YES' then centre of mass is reset for n2=0 (ie single objects) ! RSPLASH_COROTATING if 'YES' then velocities are transformed to corotating frame ! RSPLASH_HFACT can be changed to give correct hfact value for particle masses ! on minidumps: e.g. setenv RSPLASH_HFACT=1.2 ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,time,npartoftype,gamma,maxpart,maxcol,maxstep use params use settings_data, only:ndim,ndimV,ncolumns,iformat use mem_allocation, only:alloc use system_utils, only:lenvironment use system_commands, only:get_environment implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer, parameter :: max_spec = 7 ! number of species in abundance file real :: hfact, dhfact3,hfacttemp integer :: i,j,k,ierr,ierr1 integer :: nprint,nptmass,npart_max,nstep_max integer :: n1,n2,idump,ncol logical :: iexist,magfield,minidump,doubleprec,iabunfileopen character(len=len(rootname)) :: dumpfile character(len=13) :: abunfile character(len=10) :: string real :: timei,tkin,tgrav,tterm,escap,rstar,mstar,Etot_burn_cgs real(doub_prec) :: timedb,tkindb,tgravdb,ttermdb real(doub_prec) :: escapdb,rstardb,mstardb,Etot_burn_cgsdb real(doub_prec), dimension(:,:), allocatable :: datdb nstepsread = 0 nstep_max = 0 npart_max = maxpart iabunfileopen = .false. hfact = 1.5 dhfact3 = 1./hfact**3 dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--use minidump format if minidump ! minidump = .false. if (index(dumpfile,'minidump').ne.0) minidump = .true. ! !--get hfact for minidumps ! if (minidump) then call get_environment('RSPLASH_HFACT',string) read(string,*,iostat=ierr) hfacttemp if (hfacttemp.gt.0.5 .and. hfacttemp .lt.10.0 .and. ierr.eq.0) then hfact = hfacttemp print *,'setting hfact =',hfact,' from RSPLASH_HFACT environment variable' else print "(1x,a)",'error reading hfact from RSPLASH_HFACT environment variable' endif endif ! !--try to guess full dump format from file names ! magfield = .true. ! if (.not.minidump) then ! if (index(dumpfile,'SMBH').gt.0) magfield = .false. ! if (index(dumpfile,'nsbh').gt.0) magfield = .false. ! if (index(dumpfile,'NSBH').gt.0) magfield = .false. ! if (index(dumpfile,'WD').gt.0) magfield = .false. ! endif ! !--override this with environment variable ! call get_environment('RSPLASH_FORMAT',string) select case(trim(adjustl(string))) case('MHD','mhd','ns','NS') magfield = .true. case('WD','hydro','HYDRO','ns_bh_v2') magfield = .false. end select if (magfield) then print "(1x,a)",'reading MAGMA code format (set RSPLASH_FORMAT=hydro for hydro format)' else print "(1x,a)",'reading Stephan Rosswog (hydro) code format (set RSPLASH_FORMAT=MHD for MAGMA)' endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 if (magfield) then if (minidump) then ncol = 11 iformat = 1 else ncol = 27 iformat = 2 endif else if (minidump) then ncol = 7 ! number of columns in file iformat = 3 else ncol = 16 iformat = 4 endif endif n1 = 0 n2 = 0 ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return else ! !--read the number of particles in the first step, ! allocate memory and rewind ! doubleprec = .true. if (minidump) then !--try double precision first read(15,end=55,iostat=ierr) timedb,nprint,nptmass !--change to single precision if stupid answers if (nprint.le.0.or.nprint.gt.1e10 & .or.nptmass.lt.0.or.nptmass.gt.1e6) then doubleprec = .false. rewind(15) read(15,end=55,iostat=ierr) timei,nprint,nptmass if (magfield) then print "(a)",' single precision MHD minidump' else print "(a)",' single precision hydro minidump' endif else if (magfield) then print "(a)",' double precision MHD minidump' else print "(a)",' double precision hydro minidump' endif timei = real(timedb) endif else !--try double precision first read(15,end=55,iostat=ierr) nprint,rstardb,mstardb,n1,n2, & nptmass,timedb !--change to single precision if stupid answers if (n1.lt.0.or.n1.gt.1e10.or.n2.lt.0.or.n2.gt.1e10 & .or.nptmass.lt.0.or.nptmass.gt.1.e6) then doubleprec = .false. rewind(15) read(15,end=55,iostat=ierr) nprint,rstar,mstar,n1,n2, & nptmass,timei if (magfield) then print "(a)",' single precision full MHD dump' else print "(a)",' single precision full hydro dump' endif else if (magfield) then print "(a)",' double precision full MHD dump' else print "(a)",' double precision full hydro dump' endif timei = real(timedb) endif endif print "(a,f10.2,a,i9,a,i6)",' time: ',timei,' npart: ',nprint,' nptmass: ',nptmass !--barf if stupid answers in single and double precision if (nptmass.lt.0.or.nptmass.gt.1.e6 .or. nprint.lt.0 & .or. nprint.gt.1e10 .or. (nprint.eq.0 .and. nptmass.eq.0)) then print "(a)",' *** ERRORS IN TIMESTEP HEADER: NO DATA READ ***' close(15) return endif ncolumns = ncol ! !--check if abundance files are present and read from them ! if (.not.magfield) then !--extract dump number from filename (last 5 characters) read(dumpfile(len_trim(dumpfile)-4:len_trim(dumpfile)),*,iostat=ierr1) idump if (ierr1 /= 0) then print "(a)",' error extracting dump number from filename' else write(abunfile,"(a,'.',i5.5)") 'abun_a7',idump inquire(file=abunfile,exist=iexist) if (.not.iexist) then print "(a)",' abundance file '//trim(abunfile)//' NOT FOUND' else open(unit=41,file=abunfile,status='old',form='unformatted',iostat=ierr1) if (ierr1 /= 0) then print "(a)",'*** ERROR OPENING '//trim(abunfile) else ncolumns = ncol + max_spec + 2 iabunfileopen = .true. endif endif endif endif if (.not.allocated(dat) .or. (nprint+nptmass).gt.npart_max) then npart_max = max(npart_max,INT(1.1*(nprint+nptmass))) call alloc(npart_max,nstep_max,ncolumns) endif rewind(15) endif if (ierr /= 0) then print "(a)",'*** ERROR READING TIMESTEP HEADER ***' else ! !--loop over the timesteps in this file ! npart_max = max(npart_max,nprint) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+1,maxcol) endif ! !--now read the timestep data in the dumpfile ! if (magfield) then if (minidump) then dat(:,:,j) = 0. if (doubleprec) then allocate(datdb(maxpart,ncol),stat=ierr) if (ierr /= 0) then print*,"(a)",'*** error allocating memory for double conversion ***' return else datdb = 0. endif read(15,end=55,iostat=ierr) timedb,nprint,nptmass, & ((datdb(i,k),i=1,nprint),k=1,6), & ((datdb(i,k),i=1,nprint),k=8,ncol), & (datdb(i,7), i=nprint+1, nprint+nptmass), & ((datdb(i,k), i=nprint+1, nprint+nptmass),k=1,3) if (ierr /= 0) print "(a)",'*** WARNING: ERRORS DURING READ ***' dat(:,1:ncol,j) = real(datdb(:,1:ncol)) time(j) = real(timedb) else read(15,end=55,iostat=ierr) time(j),nprint,nptmass, & ((dat(i,k,j),i=1,nprint),k=1,6), & ((dat(i,k,j),i=1,nprint),k=8,ncol), & (dat(i,7,j), i=nprint+1, nprint+nptmass), & ((dat(i,k,j), i=nprint+1, nprint+nptmass),k=1,3) endif ! !--because masses are not dumped, we need to reconstruct them ! from density and h (only strictly true for grad h code) ! dat(1:nprint,7,j) = dat(1:nprint,4,j)**3*dat(1:nprint,5,j)*dhfact3 print "(a,f5.2,a)", & ' WARNING: setting particle masses assuming h = ',hfact,'*(m/rho)^(1/3)' else dat(:,:,j) = 0. ! because ptmasses don't have all quantities ! !--read full dump ! if (doubleprec) then allocate(datdb(maxpart,27),stat=ierr) if (ierr /= 0) then print*,"(a)",'*** error allocating memory for double conversion ***' return else datdb = 0. endif read(15,iostat=ierr) nprint,rstardb,mstardb,n1,n2, & nptmass,timedb,(datdb(i,7),i=1,nprint), & escapdb,tkindb,tgravdb,ttermdb, & ((datdb(i,k),i=1,nprint),k=1,6), & ((datdb(i,k),i=1,nprint),k=8,ncol), & (datdb(i,9), i=nprint+1, nprint+nptmass), & ((datdb(i,k), i=nprint+1, nprint+nptmass),k=1,6), & ((datdb(i,k), i=nprint+1, nprint+nptmass),k=21,23) if (ierr < 0) print "(a)",'*** WARNING: END OF FILE DURING READ ***' if (ierr > 0) print "(a)",'*** WARNING: ERRORS DURING READ ***' dat(:,1:ncol,j) = real(datdb(:,1:ncol)) time(j) = real(timedb) else read(15,iostat=ierr) nprint,rstar,mstar,n1,n2, & nptmass,time(j),(dat(i,7,j),i=1,nprint), & escap,tkin,tgrav,tterm, & ((dat(i,k,j),i=1,nprint),k=1,6), & ((dat(i,k,j),i=1,nprint),k=8,ncol), & (dat(i,9,j), i=nprint+1, nprint+nptmass), & ((dat(i,k,j), i=nprint+1, nprint+nptmass),k=1,6), & ((dat(i,k,j), i=nprint+1, nprint+nptmass),k=21,23) if (ierr < 0) print "(a)",'*** WARNING: END OF FILE DURING READ ***' if (ierr > 0) print "(a)",'*** WARNING: ERRORS DURING READ ***' endif endif else ! !--hydro minidumps ! if (minidump) then if (doubleprec) then allocate(datdb(maxpart,7),stat=ierr) if (ierr /= 0) then print*,"(a)",'*** error allocating memory for double conversion ***' return else datdb = 0. endif read(15,end=55,iostat=ierr) timedb,nprint,nptmass, & ((datdb(i,k), i=1, nprint),k=1,6), & (datdb(i,7), i=nprint+1, nprint+nptmass), & ((datdb(i,k), i=nprint+1, nprint+nptmass),k=1,3) if (ierr < 0) print "(a)",'*** WARNING: END OF FILE DURING READ ***' if (ierr > 0) print "(a)",'*** WARNING: ERRORS DURING READ ***' dat(:,1:ncol,j) = real(datdb(:,1:ncol)) time(j) = real(timedb) else read(15,end=55,iostat=ierr) time(j),nprint,nptmass, & ((dat(i,k,j), i=1, nprint),k=1,6), & (dat(i,7,j), i=nprint+1, nprint+nptmass), & ((dat(i,k,j), i=nprint+1, nprint+nptmass),k=1,3) endif ! !--because masses are not dumped, we need to reconstruct them ! from density and h (only strictly true for grad h code) ! dat(1:nprint,7,j) = dat(1:nprint,4,j)**3*dat(1:nprint,5,j)*dhfact3 print "(a,f5.2,a)", & ' WARNING: setting particle masses assuming h = ',hfact,'*(m/rho)^(1/3)' else ! !--hydro full dumps ! dat(:,:,j) = 0. ! because ptmasses don't have all quantities if (doubleprec) then allocate(datdb(maxpart,ncol),stat=ierr) if (ierr /= 0) then print*,"(a)",'*** error allocating memory for double conversion ***' return else datdb = 0. endif read(15,iostat=ierr) nprint,rstardb,mstardb,n1,n2, & nptmass,timedb,(datdb(i,7),i=1,nprint), & escapdb,tkindb,tgravdb,ttermdb, & ((datdb(i,k),i=1,nprint),k=1,6), & ((datdb(i,k),i=1,nprint),k=8,ncol), & (datdb(i,9), i=nprint+1, nprint+nptmass), & ((datdb(i,k), i=nprint+1, nprint+nptmass),k=1,6), & ((datdb(i,k), i=nprint+1, nprint+nptmass),k=13,15) if (ierr < 0) print "(a)",'*** WARNING: END OF FILE DURING READ ***' if (ierr > 0) print "(a)",'*** WARNING: ERRORS DURING READ ***' dat(:,1:ncol,j) = real(datdb(:,1:ncol)) time(j) = real(timedb) else read(15,iostat=ierr) nprint,rstar,mstar,n1,n2, & nptmass,time(j),(dat(i,7,j),i=1,nprint), & escap,tkin,tgrav,tterm, & ((dat(i,k,j),i=1,nprint),k=1,6), & ((dat(i,k,j),i=1,nprint),k=8,ncol), & (dat(i,9,j), i=nprint+1, nprint+nptmass), & ((dat(i,k,j), i=nprint+1, nprint+nptmass),k=1,6), & ((dat(i,k,j), i=nprint+1, nprint+nptmass),k=13,15) if (ierr < 0) print "(a)",'*** WARNING: END OF FILE DURING READ ***' if (ierr > 0) print "(a)",'*** WARNING: ERRORS DURING READ ***' endif endif endif if (ierr /= 0 ) then print "(a)",'|*** ERROR READING TIMESTEP ***' ! return ! else ! nstepsread = nstepsread + 1 endif nstepsread = nstepsread + 1 npartoftype(1,j) = nprint npartoftype(2,j) = nptmass !! print*,j,' time = ',time(j) gamma(j) = 1.666666666667 ! !--read abundances from abundance file ! if (iabunfileopen) then print "(a)",' ... reading abundances from '//trim(abunfile)//' ...' read(41,iostat=ierr1) nprint if (ierr1 /= 0) then print "(a)",' *** ERROR READING ABUNDANCE FILE ***' elseif (nprint.ne.npartoftype(1,j)) then print "(a)",' *** ERROR: npart in abundance file differs from full dump ***' else rewind(41) if (doubleprec) then read(41,iostat=ierr1) nprint,((datdb(i,k),k=1,max_spec+2),i=1,nprint),Etot_burn_cgsdb dat(:,ncol+1:ncolumns,j) = real(datdb(:,1:max_spec+2)) print*,' Etot_burn (cgs) = ',Etot_burn_cgsdb else read(41,iostat=ierr1) nprint,((dat(i,k,j),k=1,max_spec+2),i=1,nprint),Etot_burn_cgs print*,' Etot_burn (cgs) = ',Etot_burn_cgs endif if (ierr1 < 0) then print "(a)",' *** END OF FILE REACHED IN ABUNDANCE FILE ***' elseif (ierr1 > 0) then print "(a)",' *** ERRORS DURING ABUNDANCE FILE READ ***' elseif (nprint.ne.npartoftype(1,j)) then print "(a)",' *** ERROR: npart in abundance file differs from full dump ***' endif endif close(unit=41) endif j = j + 1 if (allocated(datdb)) deallocate(datdb) endif 55 continue ! !--reached end of file ! close(15) ! !--reset centre of mass to zero ! if (allocated(dat) .and. n2.eq.0 .and. lenvironment('RSPLASH_RESET_CM')) then if (minidump) then call reset_centre_of_mass(dat(1:nprint,1:3,j-1),dat(1:nprint,7,j-1),nprint) else ! full dumps ipmass = 9 call reset_centre_of_mass(dat(1:nprint,1:3,j-1),dat(1:nprint,9,j-1),nprint) endif endif ! !--transform velocities to corotating frame ! if (.not.minidump .and. allocated(dat) .and. lenvironment('RSPLASH_COROTATING')) then print*,'TRANSFORMING VELOCITIES TO CORORATING FRAME' call set_corotating_vels(dat(1:nprint,9,j-1),dat(1:nprint,4:5,j-1),n1,nprint) endif if (allocated(npartoftype)) then print*,'>> end of dump file: nsteps =',j-1,'ntot = ', & sum(npartoftype(:,j-1)),'nptmass=',npartoftype(2,j-1) endif return contains ! !--reset centre of mass to zero ! subroutine reset_centre_of_mass(xyz,pmass,npart) implicit none integer, intent(in) :: npart real, dimension(npart,3), intent(inout) :: xyz real, dimension(npart) :: pmass real :: masstot,xcm,ycm,zcm ! !--get centre of mass ! masstot = SUM(pmass(1:npart)) xcm = SUM(pmass(1:npart)*xyz(1:npart,1))/masstot ycm = SUM(pmass(1:npart)*xyz(1:npart,2))/masstot zcm = SUM(pmass(1:npart)*xyz(1:npart,3))/masstot print*,' centre of mass is at ',xcm,ycm,zcm print*,' resetting to zero...' xyz(1:npart,1) = xyz(1:npart,1) - xcm xyz(1:npart,2) = xyz(1:npart,2) - ycm xyz(1:npart,3) = xyz(1:npart,3) - zcm return end subroutine reset_centre_of_mass ! !--adjust velocities to corotating frame ! subroutine set_corotating_vels(pmass,vxy,n1,npart) implicit none integer, intent(in) :: n1,npart real, dimension(npart,2), intent(inout) :: vxy !, xy real, dimension(npart) :: pmass real :: mass1,mass2 !,xcm1,ycm1,xcm2,ycm2 real :: vxcm1,vycm1,vxcm2,vycm2 ! !--get centre of mass of star 1 and star 2 ! mass1 = SUM(pmass(1:n1)) ! xcm1 = SUM(pmass(1:n1)*xy(1:n1,1))/mass1 ! ycm1 = SUM(pmass(1:n1)*xy(1:n1,2))/mass1 mass2 = SUM(pmass(n1+1:npart)) ! xcm2 = SUM(pmass(n1+1:npart)*xy(n1+1:npart,1))/mass2 ! ycm2 = SUM(pmass(n1+1:npart)*xy(n1+1:npart,2))/mass2 ! !--work out centre of mass velocities for each star ! vxcm1 = SUM(pmass(1:n1)*vxy(1:n1,1))/mass1 vycm1 = SUM(pmass(1:n1)*vxy(1:n1,2))/mass1 vxcm2 = SUM(pmass(n1+1:npart)*vxy(n1+1:npart,1))/mass2 vycm2 = SUM(pmass(n1+1:npart)*vxy(n1+1:npart,2))/mass2 ! !--subtract centre of mass velocities appropriately ! vxy(1:n1,1) = vxy(1:n1,1) - vxcm1 vxy(1:n1,2) = vxy(1:n1,2) - vycm1 vxy(n1+1:npart,1) = vxy(n1+1:npart,1) - vxcm2 vxy(n1+1:npart,2) = vxy(n1+1:npart,2) - vycm2 end subroutine set_corotating_vels end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use filenames, only:rootname use labels, only:label,unitslabel,labelvec,labeltype,iamvec,& ix,ivx,ih,irho,iutherm,ipmass,iBfirst,idivB use settings_data, only:ndim,ndimV,ncolumns,ntypes,UseTypeInRenderings,iformat use geometry, only:labelcoord use settings_units, only:units implicit none integer :: i logical :: minidump real :: udistcm,udistkm,utime,umass,uvelkms minidump = .false. if (index(rootname(1),'minidump').ne.0) minidump = .true. if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo if (minidump) then ivx = 0 ih = 4 ! smoothing length irho = 5 ! location of rho in data array iutherm = 0 ! thermal energy ipmass = 7 ! particle mass label(6) = 'T' if (ncolumns.gt.7) then iBfirst = 8 idivB = 11 endif if (ncolumns.gt.11) then label(12) = 'grad h' label(13) = 'grad soft' label(14) = 'dsoft' endif ! !--set transformation factors between code units/real units ! udistkm = 1.5 ! km udistcm = 1.5e5 utime = 5.0415e-6 umass = 1.99e33 units(1:3) = udistkm unitslabel(1:3) = ' [km]' units(ih) = udistkm unitslabel(ih) = ' [km]' units(ipmass) = umass unitslabel(ipmass) = ' [g]' units(irho) = umass/udistcm**3 unitslabel(irho) = ' [g/cm\u3\d]' if (iBfirst.gt.0) then units(iBfirst:iBfirst+ndimV-1) = 8.0988e14 unitslabel(iBfirst:iBfirst+ndimV-1) = ' [G]' units(idivB) = units(iBfirst)/udistcm unitslabel(idivB) = ' [G/cm]' endif else !--full dump ivx = ndim+1 ih = 7 iutherm = 8 ipmass = 9 irho = 10 label(11) = 'temperature [ MeV ]' label(12) = 'electron fraction (y\de\u)' if (iformat.eq.2) then ! MHD full dump iBfirst = 13 label(16) = 'psi' idivB = 17 iamvec(18:20) = 18 labelvec(18:20) = 'force' do i=1,ndimV label(18+i-1) = trim(labelvec(18))//'\d'//labelcoord(i,1) enddo label(21) = 'Euler alpha' label(22) = 'Euler beta' label(23) = 'Bevol\dz' label(24) = 'grad h' label(25) = 'grad soft' label(26) = 'av ' label(27) = 'avB' ! !--set transformation factors between code units/real units ! udistkm = 1.5 ! km udistcm = 1.5e5 utime = 5.0415e-6 umass = 1.99e33 units(iBfirst:iBfirst+ndimV-1) = 8.0988e14 unitslabel(iBfirst:iBfirst+ndimV-1) = ' [G]' units(idivB) = units(iBfirst)/udistcm unitslabel(idivB) = ' [G/cm]' units(1:3) = udistkm unitslabel(1:3) = ' [km]' units(4:6) = 1.0 unitslabel(4:6) = '/c' units(7) = udistkm unitslabel(7) = ' [km]' units(8) = (udistcm/utime)**2 unitslabel(8) = ' [erg/g]' units(9) = umass unitslabel(9) = ' [g]' units(10) = umass/udistcm**3 unitslabel(10) = ' [g/cm\u3\d]' else iamvec(13:15) = 13 labelvec(13:15) = 'force' do i=1,ndimV label(13+i-1) = trim(labelvec(13))//'\d'//labelcoord(i,1) enddo label(16) = 'dgrav' if (ncolumns.gt.16) then label(11) = 'temperature [ 10\u6\dK ]' do i=17,ncolumns write(label(i),"('species ',i2)") i-16 enddo if (ncolumns.ge.25) then label(17) = 'He' label(18) = 'C' label(19) = 'O' label(20) = 'Ne' label(21) = 'Mg' label(22) = 'Si' label(23) = 'Fe' label(24) = 'mean A' label(25) = 'mean Z' endif endif udistcm = 1.0e9 utime = 2.7443 umass = 1.99e33 uvelkms = (udistcm/utime)/1e5 units(1:3) = 1.0 !!udistcm unitslabel(1:3) = ' [10\u9\d cm]' units(4:6) = uvelkms unitslabel(4:6) = ' [km/s]' units(ih) = units(1) unitslabel(ih) = unitslabel(1) units(8) = (udistcm/utime)**2 unitslabel(8) = ' [erg/g]' units(9) = umass unitslabel(9) = ' [g]' units(10) = umass/udistcm**3 unitslabel(10) = ' [g/cm\u3\d]' endif endif units(0) = utime*1000. unitslabel(0) = ' ms' if (ivx.ne.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo endif if (iBfirst.ne.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'\d'//labelcoord(i,1) enddo label(idivB) = 'div B' endif label(ix(1:ndim)) = labelcoord(1:ndim,1) label(irho) = '\gr' if (iutherm.gt.0) label(iutherm) = 'u' label(ih) = 'h ' label(ipmass) = 'particle mass' ! !--set labels for each particle type ! ntypes = 2 !!maxparttypes labeltype(1) = 'gas' labeltype(2) = 'point mass' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_tipsy.F90000644 000770 000000 00000034107 12017334756 017170 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING TIPSY FILES ! ! => HANDLES BOTH BINARY AND ASCII TIPSY FORMATS ! (DETECTS WHICH ONE AUTOMATICALLY) ! ! BINARY FORMAT READING REQUIRES F2003 STREAM I/O ! WHICH MAY NOT BE IMPLEMENTED ON OLDER COMPILERS ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,time,npartoftype,gamma,maxpart use params use settings_data, only:ndim,ndimV,ncolumns use mem_allocation, only:alloc use labels, only:label,ih,ipmass,irho use exact, only:hfact implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer, parameter :: iunit = 16 integer :: j,ierr integer :: nprint,ngas,ndark,nptmass,npart_max,nstep_max integer :: ncol,nread,iambinaryfile logical :: iexist character(len=len(rootname)) :: dumpfile character(len=11) :: fmt real :: timei nstepsread = 0 nstep_max = 0 npart_max = maxpart dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--determine whether file is binary or ascii and open it ! inquire(file=dumpfile,form=fmt) !print*,'fmt = ',fmt select case(trim(adjustl(fmt))) case('UNFORMATTED') iambinaryfile = 1 #ifdef __INTEL_COMPILER #if __INTEL_COMPILER<1010 !--this is how stream access is implemented for ifort 9 and lower open(unit=iunit,file=dumpfile,status='old',form='unformatted',recordtype='stream',iostat=ierr) #else open(unit=iunit,file=dumpfile,status='old',form='unformatted',access='stream',iostat=ierr) #endif #else open(unit=iunit,file=dumpfile,status='old',form='unformatted',access='stream',iostat=ierr) #endif case('FORMATTED') iambinaryfile = 0 open(unit=iunit,file=dumpfile,status='old',form='formatted',iostat=ierr) case default !--if compiler cannot distinguish the two, try ascii first, then binary iambinaryfile = -1 open(unit=iunit,file=dumpfile,status='old',form='formatted',iostat=ierr) end select if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return endif ! !--read the file header ! try ascii format first, and if unsuccessful try binary ! if (iambinaryfile.eq.1) then print "(a)",' reading binary tipsy format ' call read_tipsyheader_binary(iunit,ierr) else if (iambinaryfile.eq.0) print "(a)",' reading ascii tipsy format ' call read_tipsyheader_ascii(iunit,ierr,iambinaryfile) if (iambinaryfile.lt.0) then if (ierr.eq.0) then !--if successful ascii header read, file is ascii iambinaryfile = 0 print "(a)",' reading ascii tipsy format ' else !--otherwise, close ascii file, and assume file is binary close(unit=iunit) iambinaryfile = 1 #ifdef __INTEL_COMPILER #if __INTEL_COMPILER<1010 !--this is how stream access is implemented for ifort 9 and lower open(unit=iunit,file=dumpfile,status='old',form='unformatted',recordtype='stream',iostat=ierr) #else open(unit=iunit,file=dumpfile,status='old',form='unformatted',access='stream',iostat=ierr) #endif #else open(unit=iunit,file=dumpfile,status='old',form='unformatted',access='stream',iostat=ierr) #endif print "(a)",' reading binary tipsy format ' call read_tipsyheader_binary(iunit,ierr) endif endif endif if (ierr /= 0) then print* ndim = 0 ncolumns = 0 close(unit=iunit) return endif print "(a,f10.2,1(a,i1))",' time: ',timei,' ndim: ',ndim print "(4(a,i10))",' ntot: ',nprint,' ngas: ',ngas,' ndark: ',ndark,' nstar: ',nptmass ndimV = ndim ncol = 2*ndim + 4 ncolumns = ncol ! !--allocate memory ! if (.not.allocated(dat) .or. nprint.gt.npart_max) then npart_max = max(npart_max,nprint) call alloc(npart_max,nstep_max,ncolumns) endif ! !--now read the timestep data in the dumpfile ! dat(:,:,j) = 0. time(j) = timei nread = 0 call set_labels if (iambinaryfile.eq.1) then call read_tipsybody_binary(iunit,ierr,nread) else call read_tipsybody_ascii(iunit,ierr,nread) endif close(unit=iunit) if (nread.lt.ncol) then print "(a,i2)",' WARNING: END OF FILE: READ TO COLUMN ',nread ncolumns = nread endif ! !--often tipsy dumps contain only a (fixed) gravitational softening length ! for sph particles. In this case we need to create a sensible smoothing length ! (and warn people about the evils of using fixed softening lengths for sph particles) ! if (ngas.ge.0 .and. nread.ge.irho .and. all(abs(dat(1:ngas,ih,j)-dat(1,ih,j)).le.tiny(dat))) then print "(a)",'WARNING: fixed softening lengths detected: simulation may contain artificial fragmentation!' print "(a,f5.2,a,i1,a)",' : creating SPH smoothing lengths using h = ',hfact,'*(m/rho)**(1/',ndim,')' dat(1:ngas,ih,j) = hfact*(dat(1:ngas,ipmass,j)/(dat(1:ngas,irho,j) + tiny(dat)))**(1./ndim) endif nstepsread = nstepsread + 1 npartoftype(1,j) = ngas npartoftype(2,j) = ndark npartoftype(3,j) = nptmass gamma(j) = 1.666666666667 j = j + 1 if (allocated(npartoftype)) then print*,'>> end of dump file: nsteps =',j-1,'ntot = ',sum(npartoftype(:,j-1)) endif return contains !---------------------------------------------------- ! ascii header read !---------------------------------------------------- subroutine read_tipsyheader_ascii(iunit,ierr,iwarn) implicit none integer, intent(in) :: iunit,iwarn integer, intent(out) :: ierr read(iunit,*,end=55,iostat=ierr) nprint,ngas,nptmass read(iunit,*,end=55,iostat=ierr) ndim read(iunit,*,end=55,iostat=ierr) timei ndark = nprint - ngas - nptmass !--errors in header read if (nprint.le.0 .or. nprint.gt.1e10 .or. ndim.le.0 .or. ndim.gt.3 .or. ndark.lt.0) then if (iwarn.ge.0) print "(a)",' ERROR reading ascii file header ' ierr = 2 return endif return 55 continue if (iwarn.ge.0) print "(a)",' ERROR: end of file in ascii header read ' ierr = -1 return end subroutine read_tipsyheader_ascii !---------------------------------------------------- ! binary header read !---------------------------------------------------- subroutine read_tipsyheader_binary(iunitb,ierr) implicit none integer, intent(in) :: iunitb integer, intent(out) :: ierr real(doub_prec) :: timedb ierr = 0 read(iunitb,iostat=ierr,end=55) timedb,nprint,ndim,ngas,ndark,nptmass !print*,'header = ',timedb,nprint,ndim,ngas,ndark,nptmass timei = real(timedb) !--check for wrong endianness if (ierr /= 0 .or. timedb.lt.0. .or. ndim.lt.0 .or. ndim.gt.3 & .or. nprint.le.0 .or. ngas.lt.0 .or. ndark.lt.0 .or. nptmass.lt.0 & .or. nprint.gt.1e10 .or. ngas.gt.1.e10 .or. ndark.gt.1.e10 .or. nptmass.gt.1.e8) then print "(a)",' ERROR reading binary file header: wrong endian? ' ierr = 2 endif if (ndim.eq.0) ndim = 3 return 55 continue print "(a)",' ERROR: end of file in binary header read' ierr = -1 return end subroutine read_tipsyheader_binary !---------------------------------------------------- ! ascii body read !---------------------------------------------------- subroutine read_tipsybody_ascii(iunit,ierr,nread) implicit none integer, intent(in) :: iunit integer, intent(out) :: ierr, nread integer :: i,ic,icol,nerr !--pmass,x,y,z,vx,vy,vz do ic=1,2*ndim+1 nerr = 0 nread = nread + 1 if (ic.eq.1) then ! pmass icol = ndim + 1 elseif (ic.ge.2 .and. ic.le.ndim+1) then ! x, y, z icol = ic - 1 else ! everything after icol = ic endif !print "(1x,a)",trim(label(icol)) nerr = 0 do i=1,nprint read(iunit,*,end=44,iostat=ierr) dat(i,icol,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print *,'*** WARNING: ERRORS READING '//trim(label(icol))//' ON ',nerr,' LINES' enddo !--h dark matter if (ndark.gt.0) then nerr = 0 do i=ngas+1,ngas+ndark-1 read(iunit,*,end=44,iostat=ierr) dat(i,ih,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print *,'*** WARNING: ERRORS READING DARK MATTER H ON ',nerr,' LINES' endif !--h star particles if (nptmass.gt.0) then nerr = 0 do i=ngas+ndark+1,ngas+ndark+nptmass read(iunit,*,end=44,iostat=ierr) dat(i,ih,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print *,'*** WARNING: ERRORS READING PTMASS H ON ',nerr,' LINES' endif !--density, temperature, sph smoothing length do icol=2*ndim+2,ncol nread = nread + 1 !print "(1x,a)",trim(label(icol)) do i=1,ngas read(iunit,*,end=44,iostat=ierr) dat(i,icol,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print *,'*** WARNING: ERRORS READING '//trim(label(icol))//' ON ',nerr,' LINES' enddo ierr = 0 return 44 continue ierr = -1 end subroutine read_tipsybody_ascii !---------------------------------------------------- ! binary body read !---------------------------------------------------- subroutine read_tipsybody_binary(iunitb,ierr,nread) integer, intent(in) :: iunitb integer, intent(out) :: ierr,nread integer :: i,nerr real :: dummy !--gas particles read(iunitb) dummy ! WHY DO WE NEED THIS?? nerr = 0 do i=1,ngas !--pmass,x,y,z,vx,vy,vz,rho,temp,h read(iunitb,end=44,iostat=ierr) dat(i,ipmass,j),dat(i,1:ndim,j),dat(i,ndim+2:ncolumns,j),dummy,dummy !print*,' gas mass = ',i,dat(i,ipmass,j), ' xyz = ',dat(i,1:ndim,j) if (ierr /= 0) nerr = nerr + 1 enddo nread = ncolumns if (nerr.gt.0) print *,'*** WARNING: ERRORS READING GAS PARTICLES ON ',nerr,' LINES' !--dark matter if (ndark.gt.0) then nerr = 0 do i=ngas+1,ngas+ndark !--only read as far as velocities, then eps as smoothing length read(iunitb,end=44,iostat=ierr) dat(i,ipmass,j),dat(i,1:ndim,j),dat(i,ndim+2:2*ndim+1,j),dat(i,ih,j),dummy !print*,' DM mass = ',i,dat(i,ipmass,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print *,'*** WARNING: ERRORS READING DARK MATTER PARTICLES ON ',nerr,' LINES' endif !--star particles if (nptmass.gt.0) then nerr = 0 do i=ngas+ndark+1,ngas+ndark+nptmass !--only read as far as velocities, then eps as smoothing length read(iunitb,end=44,iostat=ierr) dat(i,ipmass,j),dat(i,1:ndim,j),dat(i,ndim+2:2*ndim+1,j),dummy,dummy,dat(i,ih,j),dummy !print*,' star mass = ',i,dat(i,ipmass,j),' xyz = ',dat(i,1:ndim,j),dat(i,ndim+2:2*ndim+1,j),crap,crap,dat(i,ih,j),crap if (ierr /= 0) nerr = nerr + 1 enddo if (nerr.gt.0) print *,'*** WARNING: ERRORS READING STAR PARTICLES ON ',nerr,' LINES' endif ierr = 0 return 44 continue ierr = -1 end subroutine read_tipsybody_binary end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,labelvec,labeltype,iamvec,& ix,ivx,ih,irho,ipmass !,iutherm use settings_data, only:ndim,ndimV,ntypes,UseTypeInRenderings use geometry, only:labelcoord !use settings_units, only:units,unitslabel implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ipmass = ndim + 1 ivx = ndim + 2 irho = ivx + ndim !iutherm = irho + 1 label(irho+1) = 'temperature' ih = irho + 2 label(ix(1:ndim)) = labelcoord(1:ndim,1) label(ih) = 'h' !if (iutherm.gt.0) label(iutherm) = 'temperature' label(ipmass) = 'particle mass' label(irho) = 'density' if (ivx.ne.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//trim(labelcoord(i,1)) enddo endif ! !--set labels for each particle type ! ntypes = 3 labeltype(1) = 'gas' labeltype(2) = 'dark matter' labeltype(3) = 'star' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. UseTypeInRenderings(3) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_UCLA.f90000644 000770 000000 00000015056 11622211702 016570 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR SKY KING / MARK MORRIS' (UCLA) ASCII DATA FORMAT ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ntot(maxstep) : total number of particles in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,npartoftype,time,gamma,maxpart,maxcol,maxstep use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation, only:alloc implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,ierr,nerr,iunit,ncolstep,ncolenv integer :: nprint,npart_max,nstep_max,icol integer :: igatherb,ntot,ninit,ninit1,nstar logical :: iexist real :: tread,pmass,hbav1,dttot,xmacc,xlxacc,xlyacc,xlzacc real, dimension(3) :: xptmass,yptmass,vxptmass,vyptmass character(len=len(rootname)+4) :: dumpfile nstepsread = 0 nstep_max = 0 npart_max = maxpart iunit = 15 ! logical unit number for input dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions (0 means no particle coords) ! ndim = 3 ndimV = 3 ncolstep = 10 ! create one column for particle mass nstar = 3 j = indexstart nstepsread = 0 print "(a)",' reading Sky King/Mark Morris (UCLA) ascii data format ' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the file and read the number of particles ! open(unit=iunit,iostat=ierr,file=dumpfile,status='old',form='formatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return endif ! !--read header lines, try to use it to set time ! read(iunit,*,iostat=ierr) nprint,tread,pmass,xptmass(1),yptmass(1),xptmass(2),yptmass(2),& vxptmass(1),vyptmass(1),vxptmass(2),vyptmass(2), & xptmass(3),yptmass(3),vxptmass(3),vyptmass(3) if (ierr /= 0) print "(a)",' WARNING: error(s) reading first header line' print "(a,i10,a,1pe10.3)",' npart = ',nprint, ' time = ',tread read(iunit,*,iostat=ierr) igatherb,ntot,ninit,ninit1,hbav1,dttot,xmacc,xlxacc,xlyacc,xlzacc if (ierr /= 0) print "(a)",' WARNING: error(s) reading second header line' print "(a)",' header info: ' print "(2(a11,i10))",' igatherb: ',igatherb,' ntot: ',ntot print "(2(a11,i10))",' ninit: ',ninit,' ninit1: ',ninit1 print "(3(a11,1pe10.4))",' hbav1: ',hbav1,' dttot: ',dttot,' xmacc: ',xmacc print "(3(a11,1pe10.4))",' accelx: ',xlxacc,' accely: ',xlyacc,' accelz: ',xlzacc ! !--(re)allocate memory ! nstep_max = max(nstep_max,indexstart,1) if (.not.allocated(dat) .or. (nprint.gt.maxpart) .or. (ncolstep+ncalc).gt.maxcol) then npart_max = max(npart_max,INT(1.1*(nprint)),maxpart) call alloc(npart_max,nstep_max,max(ncolstep+ncalc,maxcol)) endif ! !--set the necessary parameters ! ncolumns = ncolstep nstepsread = nstepsread + 1 npartoftype(:,j) = 0 npartoftype(1,j) = nprint npartoftype(2,j) = nstar time(j) = tread ! !--now read the timestep data in the dumpfile ! nerr = 0 do i=1,nprint read(iunit,*,iostat=ierr) (dat(i,icol,j),icol = 1,9) if (ierr.ne.0) nerr = nerr + 1 enddo if (nerr > 0) print *,' ERRORS reading particle data on ',nerr,' lines' close(iunit) !--set particle mass from column dat(1:nprint,10,j) = pmass !--copy star particle properties into main data array do i=nprint+1,nprint+nstar dat(i,1,j) = xptmass(i-nprint) dat(i,2,j) = yptmass(i-nprint) dat(i,3,j) = 0. dat(i,4,j) = vxptmass(i-nprint) dat(i,5,j) = vyptmass(i-nprint) dat(i,6,j) = 0. enddo return end subroutine read_data !!------------------------------------------------------------------- !! set labels for each column of data !! !! read these from a file called 'columns' in the current directory !! then take sensible guesses as to which quantities are which !! from the column labels !! !!------------------------------------------------------------------- subroutine set_labels use labels, only:label,labeltype,ix,irho,ipmass,ih,ipr,ivx,iamvec,labelvec use params use settings_data, only:ncolumns,ntypes,ndim,ndimV,UseTypeInRenderings use geometry, only:labelcoord implicit none integer :: i,ierr,ndimVtemp do i=1,ndim ix(i) = i enddo ivx = 4 irho = 7 ipr = 8 ih = 9 ipmass = 10 label(irho) = 'density' label(ipr) = 'pressure' label(ih) = 'smoothing length' label(ipmass) = 'particle mass' if (ivx.gt.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = 'v\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 2 labeltype(1) = 'gas' labeltype(2) = 'star' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_urban.f90000644 000770 000000 00000022400 11622211702 017142 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM ANDREA URBAN'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,npartoftype,maxpart,maxcol,maxstep,time,gamma use params use settings_data, only:ndim,ndimV,ncolumns,ncalc use mem_allocation, only:alloc !use system_utils, only:lenvironment,ienvironment use asciiutils, only:get_ncolumns implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,ierr,lab,icol,ilen integer :: nprint,npart_max,nstep_max integer :: ncol,nerr,nheaderlines logical :: iexist,timeset,gammaset real :: dummyreal character(len=len(rootname)+5) :: dumpfile integer, parameter :: iunit = 15 nstepsread = 0 nstep_max = 0 npart_max = maxpart dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 !--number of columns to read from file ! this is determined automatically !ncol = 13 j = indexstart nstepsread = 0 print "(a)",' reading Andrea Urban ascii file format' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the file and read the number of particles ! open(unit=iunit,file=dumpfile,status='old',form='formatted',iostat=ierr) if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return else call get_ncolumns(iunit,ncol,nheaderlines) ncol = max(ncol - 1,0) if (ncol.le.0) then print "(a,/)",' *** no data read from file ***' return endif ! !--allocate memory initially ! nprint = 10001 nstep_max = max(nstep_max,indexstart,1) if (.not.allocated(dat) .or. (nprint.gt.npart_max) .or. (ncol+ncalc).gt.maxcol) then npart_max = max(npart_max,nprint) call alloc(npart_max,nstep_max,ncol+ncalc) endif endif npart_max = max(npart_max,nprint) ncolumns = ncol ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+1,maxcol) endif ! !--read header lines, try to use it to set time ! timeset = .false. gammaset = .false. if (nheaderlines.gt.0) then print*,'skipping ',nheaderlines,' header lines' do i=1,nheaderlines read(iunit,*,iostat=ierr) dummyreal if (timeset .and. .not.gammaset .and. ierr.eq.0 & .and. dummyreal.gt.0.999999 .and. dummyreal.lt.2.000001) then print*,'setting gamma = ',dummyreal,' from header line ',i gamma(j) = dummyreal gammaset = .true. endif if (ierr.eq.0 .and. .not. timeset) then time(j) = dummyreal timeset = .true. print*,'setting time = ',dummyreal,' from header line ',i endif enddo endif ! !--now read the timestep data in the dumpfile ! dat(:,:,j) = 0. ! time(j) = -1.0 ! time not read ! !--now read the timestep data in the dumpfile ! i = 0 ierr = 0 nerr = 0 overparts: do while (ierr >= 0) i = i + 1 if (i.gt.npart_max) then ! reallocate memory if necessary npart_max = 10*npart_max call alloc(npart_max,nstep_max,ncol+ncalc) endif read(iunit,*,iostat=ierr) (dat(i,icol,j),icol = 1,10),lab,(dat(i,icol,j),icol=11,ncol) if (ierr > 0) then nerr = nerr + 1 if (nerr .le. 10) print "(a,i8,a)",' ERROR reading data from line ',i+nheaderlines,', skipping' i = i - 1 ! ignore lines with errors endif enddo overparts close(iunit) nprint = i - 1 nstepsread = nstepsread + 1 if (nerr > 10) then print "(a,i8,a)",' *** WARNING: errors whilst reading file on ',nerr,' lines: skipped these ***' endif if (ierr < 0) then print*,'end of file: npart = ',nprint endif npartoftype(:,j) = 0 npartoftype(1,j) = nprint ! !--now open the sink particle file and read it ! !--find the last underscore in the file name ilen = index(rootname,'_',back=.true.) if (ilen.le.0) ilen = len_trim(rootname) + 1 dumpfile = rootname(1:ilen-1)//'_S' inquire(file=trim(dumpfile),exist=iexist) if (iexist) then open(unit=iunit+1,file=trim(dumpfile),form='formatted',status='old',iostat=ierr) if (ierr.ne.0) then print "(a)",' ERROR: could not open sink particle file '//trim(dumpfile) else i = npartoftype(1,j) ierr = 0 nerr = 0 oversinks: do while (ierr >= 0) i = i + 1 if (i.gt.npart_max) then ! reallocate memory if necessary npart_max = npart_max + 1000 call alloc(npart_max,nstep_max,ncol+ncalc) endif read(iunit+1,*,iostat=ierr) (dat(i,icol,j),icol = 1,10) if (ierr > 0) then nerr = nerr + 1 if (nerr .le. 10) print "(a,i8,a)",' ERROR reading sink data from line ',i+nheaderlines,', skipping' i = i - 1 ! ignore lines with errors endif enddo oversinks endif npartoftype(2,j) = i - 1 - npartoftype(1,j) print "(a,i8,a)",' read ',npartoftype(2,j),' sink particles from '//trim(dumpfile) close(iunit+1) else print "(a)",' sink particle file ('//trim(dumpfile)//') not present' endif ! !--look for a _t file for the time (interim measure) ! dumpfile = rootname(1:ilen-1)//'_t' inquire(file=trim(dumpfile),exist=iexist) if (iexist) then open(unit=iunit+2,file=trim(dumpfile),form='formatted',status='old',iostat=ierr) if (ierr.ne.0) then print "(a)",' ERROR: could not open time file '//trim(dumpfile) else read(iunit+2,*,iostat=ierr) time(j) if (ierr.ne.0) then print "(a)",' ERROR reading time from file '//trim(dumpfile) else print*,' got time = ',time(j),' from file '//trim(dumpfile) endif endif close(iunit+2) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,labelvec,labeltype,iamvec,& ix,ivx,ih,irho,iutherm,ipmass use settings_data, only:ndim,ndimV,ntypes,UseTypeInRenderings use geometry, only:labelcoord !use settings_units, only:units,unitslabel implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ipmass = 7 ih = 8 irho = 9 iutherm = 10 label(ix(1:ndim)) = labelcoord(1:ndim,1) label(ipmass) = 'particle mass' label(ih) = 'h' label(irho) = 'density' if (iutherm.gt.0) label(iutherm) = 'u' label(11) = 't\ddust\u' label(12) = 'N\dcol\u' label(13) = 'N\dloc\u' if (ivx.ne.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 2 labeltype(1) = 'gas' labeltype(2) = 'sink' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_vanaverbeke.f90000644 000770 000000 00000020413 12143031032 020321 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT ! FROM SIGFRIED VANAVERBEKE'S CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! VSPLASH_SINGLEPREC if 'YES' or 'TRUE' then assumes data is single precision ! VSPLASH_NCOL to change the number of columns read from the file, ! e.g. setenv VSPLASH_NCOL=13 ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:dat,time,npartoftype,gamma,maxpart use params use settings_data, only:ndim,ndimV,ncolumns use mem_allocation, only:alloc use system_utils, only:lenvironment,ienvironment implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: i,j,k,ierr integer :: nprint,ntotal,npart_max,nstep_max integer :: ncol,nread,nerr,ncoltemp,nsink,nsinkcol,nacc logical :: iexist,doubleprec integer, parameter :: iunit = 15 character(len=len(rootname)) :: dumpfile real :: timei,gammai real(doub_prec), dimension(maxplot) :: datdb real(doub_prec) :: timedb,gammadb nstepsread = 0 nstep_max = 0 npart_max = maxpart dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 !--number of columns to read from file ncol = 10 nsinkcol = 7 doubleprec = .true. !--can override these settings with environment variables if (lenvironment('VSPLASH_SINGLEPREC')) doubleprec = .false. ncoltemp = ienvironment('VSPLASH_NCOL') if (ncoltemp.gt.0) ncol = ncoltemp ! !--allocate memory initially ! nstep_max = max(nstep_max,indexstart,1) j = indexstart nstepsread = 0 print "(a)",' reading Vanaverbeke format...' write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) ! !--open the (unformatted) binary file and read the number of particles ! open(unit=iunit,file=dumpfile,status='old',form='unformatted',iostat=ierr) if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' return else timei = 0. read(iunit,iostat=ierr) nprint,nacc,nsink print "(3(a,i10))",'npart:',nprint,' naccreted:',nacc,' nsinks:',nsink if (doubleprec) then read(iunit,iostat=ierr) timedb,gammadb timei = real(timedb) gammai = real(gammadb) else read(iunit,iostat=ierr) timei,gammai endif print "(2(a,1pe12.3))",'time:',timei,' gamma:',gammai !--barf if stupid values read if (nprint.lt.0 .or. nacc.lt.0 .or. nsink.lt.0 .or. nsink.gt.1e7) then print "(a)",' *** ERROR IN TIMESTEP HEADER: WRONG ENDIAN? (or old header format)?' close(iunit) return elseif (ierr /= 0) then print "(a)",'*** ERROR READING TIMESTEP HEADER: WRONG ENDIAN? ***' close(iunit) return endif if (timei.lt.0. .or. gammai.lt.1.0 .or. gammai.gt.2.0) then print*,'*** ERROR IN HEADER: strange time and/or gamma read: wrong precision?' endif ncolumns = ncol ntotal = nprint + nsink if (.not.allocated(dat) .or. ntotal.gt.npart_max) then npart_max = max(npart_max,ntotal) call alloc(npart_max,nstep_max,ncolumns) endif ! !--now read the timestep data in the dumpfile ! dat(:,:,j) = 0. time(j) = timei gamma(j) = gammai if (doubleprec) then nerr = 0 nread = 0 do i=1,nprint nread = nread + 1 read(iunit,end=44,iostat=ierr) (datdb(k),k=1,ncol) if (ierr /= 0) then nerr = nerr + 1 else dat(i,1:ncol,j) = real(datdb(1:ncol)) endif enddo do i=nprint+1,nprint+nsink nread = nread + 1 read(iunit,end=44,iostat=ierr) (datdb(k),k=1,nsinkcol) if (ierr /= 0) then nerr = nerr + 1 else dat(i,1:nsinkcol,j) = real(datdb(1:nsinkcol)) endif enddo else nerr = 0 nread = 0 do i=1,nprint nread = nread + 1 read(iunit,end=44,iostat=ierr) dat(i,1:ncol,j) if (ierr /= 0) nerr = nerr + 1 enddo do i=nprint+1,nprint+nsink nread = nread + 1 read(iunit,end=44,iostat=ierr) dat(i,1:nsinkcol,j) if (ierr /= 0) nerr = nerr + 1 enddo endif goto 45 44 continue print "(a,i10)",' WARNING: END-OF-FILE AT LINE ',nread 45 continue if (nerr.gt.0) print *,'*** WARNING: ERRORS DURING READ ON ',nerr,' LINES' nstepsread = nstepsread + 1 npartoftype(1,j) = nprint - nacc npartoftype(2,j) = nacc npartoftype(3,j) = nsink j = j + 1 endif close(iunit) if (allocated(npartoftype)) then print*,'>> end of dump file: nsteps =',j-1,'ntot = ',sum(npartoftype(:,j-1)) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,labelvec,labeltype,iamvec,& ix,ivx,ih,irho,iutherm,ipmass,ispsound use settings_data, only:ndim,ndimV,ntypes,UseTypeInRenderings use geometry, only:labelcoord !use settings_units, only:units,unitslabel implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ivx = 4 ipmass = 7 ih = ipmass + 1 iutherm = ih + 1 irho = iutherm + 1 ispsound = 0 label(ix(1:ndim)) = labelcoord(1:ndim,1) label(ih) = 'h' if (irho.gt.0) label(irho) = '\gr' if (ipmass.gt.0) label(ipmass) = 'particle mass' if (iutherm.gt.0) label(iutherm) = 'u' if (ispsound.gt.0) label(ispsound) = 'c_s' if (ivx.ne.0) then iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//trim(labelcoord(i,1)) enddo endif ! !--set labels for each particle type ! ntypes = 3 labeltype(1) = 'gas' labeltype(2) = 'accreted/dead' labeltype(3) = 'sink' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .true. UseTypeInRenderings(3) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/read_data_VINE.f90000644 000770 000000 00000045006 12017612712 016610 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------- ! this subroutine reads from the data file(s) ! change this to change the format of data input ! ! THIS VERSION IS FOR READING UNFORMATTED OUTPUT FROM THE VINE CODE ! (ie. STRAIGHT FROM THE DATA DUMP) ! ! *** CONVERTS TO SINGLE PRECISION *** ! ! SOME CHOICES FOR THIS FORMAT CAN BE SET USING THE FOLLOWING ! ENVIRONMENT VARIABLES: ! ! VINE_MHD or VSPLASH_MHD if 'YES' or 'TRUE', reads MHD dump files ! VINE_HFAC or VSPLASH_HFAC if 'YES' or 'TRUE', multiplies the ! smoothing lengths read from the file by a factor of 2.8 for ! compatibility with older VINE dump files. ! ! the data is stored in the global array dat ! ! >> this subroutine must return values for the following: << ! ! ncolumns : number of data columns ! ndim, ndimV : number of spatial, velocity dimensions ! nstepsread : number of steps read from this file ! ! maxplot,maxpart,maxstep : dimensions of main data array ! dat(maxplot,maxpart,maxstep) : main data array ! ! npartoftype(1:6,maxstep) : number of particles of each type in each timestep ! ! time(maxstep) : time at each step ! gamma(maxstep) : gamma at each step ! ! most of these values are stored in global arrays ! in the module 'particle_data' !------------------------------------------------------------------------- module vineread implicit none ! ! These are the indices of various values saved in ! the header part of the dump file. ! ! SHOULD BE IDENTICAL TO THOSE DEFINED IN THE VINE io.F FILE... ! integer,parameter::id_iheadlen= 1, id_npart = 2, id_npart_sph = 3 integer,parameter::id_nstep = 4, id_idump = 5, id_makechkpnt= 6 integer,parameter::id_idbg = 7, id_itme = 8, id_ibctype = 9 integer,parameter::id_indts =10, id_iusebin=11, id_ipres =12 integer,parameter::id_ipdv =13, id_ieos =14, id_icool =15 integer,parameter::id_iheat =16, id_ivisc =17, id_ivtime =18 integer,parameter::id_ibals =19, id_ishok =20, id_igrav =21 integer,parameter::id_isoft =22, id_imac =23, id_ihts =24 integer,parameter::id_iexpand =25, id_ncdumps=26, id_maxclumpsize=27 integer,parameter::id_intgrtr =28, id_ishift =29, id_ndim =30 integer,parameter::id_io_fmt =31, id_iunits =32, id_maxbunchsize=33 integer,parameter::id_npoim =34, id_ndt_ana=35, id_maxbuild =36 integer,parameter::id_fullextrap=37,id_revise=38, id_n_dtmax =39 integer,parameter::id_n_ana =40 integer,parameter::id_lastint1=41 !1 after last id for integers integer, parameter::id_t = 1,id_dtmax = 2,id_deltnew = 3 integer, parameter::id_gamma = 4,id_ekin = 5,id_egrav = 6 integer, parameter::id_etherm = 7,id_ascale = 8,id_cosbox = 9 integer, parameter::id_vlength =10,id_alfstar =11,id_betastar =12 integer, parameter::id_tol =13,id_cfl =14,id_dhmax =15 integer, parameter::id_treeacc =16,id_sepmax =17,id_hmin =18 integer, parameter::id_eps =19,id_dtinit =20,id_tstop =21 integer, parameter::id_dt_out =22,id_uconst =23,id_xmas =24 integer, parameter::id_ylen =25,id_umin =26,id_rcore =27 integer, parameter::id_h_0 =28,id_omegam =29,id_gmasslim =30 integer, parameter::id_hmax =31,id_uexpon =32,id_ftol =33 integer, parameter::id_clhfrac =34,id_xmin =35,id_xmax =36 integer, parameter::id_ymin =37,id_ymax =38,id_zmin =39 integer, parameter::id_zmax =40 integer, parameter::id_eosK =41,id_rhozero =42,id_ftolpm =43 integer, parameter::id_tolpm =44,id_tnextout=45,id_alfmax =46 integer, parameter::id_vtol =47,id_vtolpm =48,id_dtmin =49 integer, parameter::id_tlastout=50,id_dt_ana =51,id_bsepmax =52 integer, parameter::id_taucool =53 integer, parameter::id_lastreal1=54 !1 after last id for real numbers end module vineread subroutine read_data(rootname,indexstart,nstepsread) use particle_data, only:npartoftype,dat,time,gamma,maxcol,maxpart,maxstep use params, only:doub_prec use settings_data, only:ndim,ndimV,ncolumns,ncalc use labels, only:ivx, iBfirst,ih,ipmass use mem_allocation, only:alloc use system_utils, only:lenvironment use vineread, only:id_gamma,id_iheadlen,id_ndim,id_npart,id_npart_sph,& id_npoim,id_t implicit none integer, intent(in) :: indexstart integer, intent(out) :: nstepsread character(len=*), intent(in) :: rootname integer :: iheadlength integer :: i,j,ierr,nparti,ntoti,i1,icol integer :: npart_max,nstep_max,ncolstep,nptmass logical :: iexist,mhdread,useipindx character(len=len(rootname)+10) :: dumpfile integer, parameter :: maxheadlength = 1000 integer, dimension(maxheadlength) :: iheader integer, dimension(:), allocatable :: ipindx,itstepbin !--we are assuming dump is double precision real(doub_prec), dimension(maxheadlength) :: dheader real(doub_prec), dimension(:,:), allocatable :: dattemp, dattempvec real :: dum real :: hfactor nstepsread = 0 npart_max = maxpart !--this is the default header length iheadlength = maxheadlength dumpfile = trim(rootname) ! !--check if first data file exists ! inquire(file=dumpfile,exist=iexist) if (.not.iexist) then print "(a)",' *** error: '//trim(dumpfile)//': file not found ***' return endif ! !--fix number of spatial dimensions ! ndim = 3 ndimV = 3 mhdread = .false. if (lenvironment('VSPLASH_MHD') .or. lenvironment('VINE_MHD')) then mhdread = .true. endif if (lenvironment('VSPLASH_HFAC') .or. lenvironment('VINE_HFAC')) then hfactor = 2.8 else hfactor = 1.0 endif nstep_max = max(indexstart,1) j = indexstart nstepsread = 0 nparti = 0 ncolstep = 0 write(*,"(26('>'),1x,a,1x,26('<'))") trim(dumpfile) if (mhdread) then print "(a)",' reading VINE MHD format' else print "(a)",' reading default VINE format (set VINE_MHD=yes for MHD)' endif ! !--open the (unformatted) binary file and read the number of particles ! open(unit=15,iostat=ierr,file=dumpfile,status='old',form='unformatted') if (ierr /= 0) then print "(a)",'*** ERROR OPENING '//trim(dumpfile)//' ***' else ! !--read timestep header (integers only) ! read(15,iostat=ierr) (iheader(i),i=1,iheadlength) ! !--get number of particles from header and allocate memory ! iheadlength = iheader(id_iheadlen) if (iheadlength.gt.maxheadlength) print "(a)",' ERROR: header length too big!' ntoti = iheader(id_npart ) nparti = iheader(id_npart_sph) nptmass = iheader(id_npoim ) ndim = iheader(id_ndim ) if (ntoti.lt.nparti) then print*,' *** WARNING: ntotal < npart_sph in header, setting n_total=n_sph' ntoti = nparti endif if (nptmass.lt.0) then print*,' *** WARNING: error in nptmass read from header, nptmass = ',nptmass,' setting to 0' nptmass = 0 endif if (nparti.le.0) then print*,' *** WARNING: error in npart read from header, npart = ',nparti ierr = 2 endif if (ndim.le.0 .or. ndim.gt.3) then print*,' *** WARNING: error in ndim read from header, ndim = ',ndim ierr = 1 endif ndimV = ndim if (ndim.ne.3) print "(a,i1)",' number of dimensions = ',ndim if (mhdread) then ncolstep = 2*ndim + 6 + ndim else ncolstep = 2*ndim + 6 endif ncolumns = ncolstep if ((.not.allocated(dat) .or. ntoti+nptmass.gt.npart_max) .and. ierr.eq.0) then if (.not.allocated(dat)) then npart_max = ntoti + nptmass else npart_max = max(npart_max,INT(1.1*(ntoti+nptmass))) endif call alloc(npart_max,nstep_max,ncolstep+ncalc) endif ! !--rewind file ! rewind(15) endif if (ierr /= 0) then print "(/,a)", ' *** ERROR READING TIMESTEP HEADER: wrong endian? ***' print "(/,a)", ' (see splash userguide for compiler-dependent' print "(a)", ' ways to change endianness on the command line)' print "(/,a)", ' (set environment variable VINE_MHD to yes or TRUE ' print "(a,/)", ' if you are trying to read MHD format)' else npart_max = max(npart_max,ntoti) ! !--allocate/reallocate memory if j > maxstep ! if (j.gt.maxstep) then call alloc(maxpart,j+2*nstepsread,maxcol) endif ! !--allocate a temporary array for double precision variables ! if (allocated(dattemp)) deallocate(dattemp) allocate(dattemp(npart_max,ncolstep),stat=ierr) dattemp = 0. if (ierr /= 0) print*,'not enough memory in read_data (dattemp)' ! !--allocate a temporary array for vectors ! if (allocated(dattempvec)) deallocate(dattempvec) if (mhdread) then allocate(dattempvec(3*ndim+1,npart_max),stat=ierr) else allocate(dattempvec(2*ndim+1,npart_max),stat=ierr) endif dattempvec = 0. if (ierr /= 0) print*,'not enough memory in read_data (dattempvec)' ! !--allocate a temporary array for particle index ! if (allocated(ipindx)) deallocate(ipindx) allocate(ipindx(npart_max),stat=ierr) !ipindx = 0 if (ierr /= 0) print*,'not enough memory in read_data (ipindx)' ! !--allocate a temporary array for itstepbin (MHD or point masses only) ! if (mhdread .or. nptmass.gt.0) then if (allocated(itstepbin)) deallocate(itstepbin) allocate(itstepbin(npart_max),stat=ierr) !itstepbin = 0 if (ierr /= 0) print*,'not enough memory in read_data (itstepbin)' endif ! !--now read the timestep data in the dumpfile ! write(*,"(a,i5,a)",advance="no") '| step ',j,': ' ivx = ndim + 2 ! location of vx in 'columns' ! starting point for non position and velocity columns icol = ndim + 1 + ndimV + 1 if (mhdread) then if (nptmass.gt.0) then print "(a)",' WARNING: MHD format but point masses are present' print "(a)",' and reading of point masses is not implemented' print "(a)",' *** Please email a copy of io.F so I can fix this *** ' endif iBfirst = icol+5 read(15,iostat=ierr) & (iheader(i),i=1,iheadlength), & (dheader(i),i=1,iheadlength), & (dattempvec(1:ndim+1,i),i=1,ntoti), & (dattempvec(ivx:ivx+ndimV-1,i),i=1,ntoti), & (dattemp(i,icol), i=1,ntoti), & (dattemp(i,icol+1), i=1,nparti), & (dattemp(i,icol+2), i=1,nparti), & (dattemp(i,icol+3), i=1,nparti), & (dattemp(i,icol+4), i=1,ntoti), & (ipindx(i), i=1,ntoti), & (itstepbin(i),i=1,ntoti), & (dattempvec(ivx+ndimV:ivx+2*ndimV-1,i),i=1,nparti) else if (nptmass.gt.0) then ! !--read point mass information at the end of the dump file ! read(15,iostat=ierr) & (iheader(i),i=1,iheadlength), & (dheader(i),i=1,iheadlength), & (dattempvec(1:ndim+1,i),i=1,ntoti), & (dattempvec(ivx:ivx+ndimV-1,i),i=1,ntoti), & (dattemp(i,icol), i=1,ntoti), & (dattemp(i,icol+1), i=1,nparti), & (dattemp(i,icol+2), i=1,nparti), & (dattemp(i,icol+3), i=1,nparti), & (dattemp(i,icol+4), i=1,ntoti), & (ipindx(i), i=1,ntoti), & (dum, i=1,nparti), & (itstepbin(i), i=1,ntoti), & (dattempvec(1:ndim+1,i),i=ntoti+1,ntoti+nptmass), & (dattempvec(ivx:ivx+ndimV-1,i),i=ntoti+1,ntoti+nptmass), & ((dum, i1=1,3),i=1,nptmass), & (dattemp(i,icol), i=ntoti+1,ntoti+nptmass) else ! !--no point masses, so shorter read ! read(15,iostat=ierr) & (iheader(i),i=1,iheadlength), & (dheader(i),i=1,iheadlength), & (dattempvec(1:ndim+1,i),i=1,ntoti), & (dattempvec(ivx:ivx+ndimV-1,i),i=1,ntoti), & (dattemp(i,icol), i=1,ntoti), & (dattemp(i,icol+1), i=1,nparti), & (dattemp(i,icol+2), i=1,nparti), & (dattemp(i,icol+3), i=1,nparti), & (dattemp(i,icol+4), i=1,ntoti), & (ipindx(i), i=1,ntoti) endif endif if (ierr < 0) then print "(a)",'*** END OF FILE IN READ DATA ***' elseif (ierr /= 0) then if (mhdread) then print "(a)",'*** ERROR READING DATA: MAYBE NOT AN MHD FILE?? ***' else print "(a)",'*** ERROR READING DATA ***' print "(/,a)", ' (set environment variable VINE_MHD to yes or TRUE ' print "(a,/)", ' if you are trying to read MHD format)' endif endif nstepsread = nstepsread + 1 ! !--spit out time ! time(j) = real(dheader(id_t )) gamma(j) = real(dheader(id_gamma)) print "(a,es10.3,3(a,i8))",'t = ',time(j),' n(SPH) = ',ntoti,' n(Nbody) = ',ntoti-nparti,' n(star) = ',nptmass ! !--check sanity of ipindx array: do not sort particles if values not sensible ! useipindx = .true. if (any(ipindx(1:ntoti).le.0 .or. ipindx(1:ntoti).gt.ntoti)) then print*,'WARNING: ipindx array has values < 0 or > ntot: particles not sorted' useipindx = .false. endif ! !--convert posm and velocity vectors to columns and double to single precision ! do i=1,2*ndim+1 if (useipindx) then dat(ipindx(1:ntoti),i,j) = real(dattempvec(i,1:ntoti)) else dat(1:ntoti,i,j) = real(dattempvec(i,1:ntoti)) endif enddo if (nptmass.gt.0) then do i=1,2*ndim+1 dat(ntoti+1:ntoti+nptmass,i,j) = real(dattempvec(i,ntoti+1:ntoti+nptmass)) enddo endif ! !--convert B vectors to columns and double to single precision ! if (mhdread) then i1 = iBfirst - 1 do i=ivx+ndimV,ivx+2*ndimV-1 i1 = i1 + 1 if (useipindx) then dat(ipindx(1:nparti),i1,j) = real(dattempvec(i,1:nparti)) else dat(1:nparti,i1,j) = real(dattempvec(i,1:nparti)) endif enddo endif ! !--now convert scalars ! if (useipindx) then dat(ipindx(1:ntoti),icol:ncolstep,j) = real(dattemp(1:ntoti,icol:ncolstep)) else dat(1:ntoti,icol:ncolstep,j) = real(dattemp(1:ntoti,icol:ncolstep)) endif if (nptmass.gt.0) then dat(ntoti+1:ntoti+nptmass,icol,j) = real(dattemp(ntoti+1:ntoti+nptmass,icol)) endif call set_labels if (ih.gt.0 .and. hfactor.gt.1.0) then dat(1:ntoti+nptmass,ih,j) = hfactor*dat(1:ntoti+nptmass,ih,j) endif if (nptmass.lt.10) then do i=1,nptmass if (ndim.eq.2) then print "('| point mass ',i1,': pos = (',es10.2,',',es10.2,'), mass = ',es10.2)", & i,dat(ntoti+i,1:ndim,j),dat(ntoti+i,ipmass,j) else print "('| point mass ',i1,': pos = (',2(es10.2,','),es10.2,'), mass = ',es10.2)", & i,dat(ntoti+i,1:ndim,j),dat(ntoti+i,ipmass,j) endif enddo endif ! !--set particle numbers ! npartoftype(1,j) = nparti npartoftype(2,j) = ntoti - nparti npartoftype(3,j) = nptmass ! !--clean up ! if (allocated(dattemp)) deallocate(dattemp) if (allocated(dattempvec)) deallocate(dattempvec) if (allocated(ipindx)) deallocate(ipindx) if (allocated(itstepbin)) deallocate(itstepbin) endif ! !--reached end of file ! close(15) if (nstepsread .gt. 0) then print*,'>> end of dump file: ntotal = ',sum(npartoftype(:,j)) endif return end subroutine read_data !!------------------------------------------------------------ !! set labels for each column of data !!------------------------------------------------------------ subroutine set_labels use labels, only:label,ih,ipmass,ivx,iutherm,irho,ix,iBfirst, & labelvec,iamvec,labeltype use params use settings_data, only:ndim,ndimV,UseTypeInRenderings,ntypes use geometry, only:labelcoord implicit none integer :: i if (ndim.le.0 .or. ndim.gt.3) then print*,'*** ERROR: ndim = ',ndim,' in set_labels ***' return endif if (ndimV.le.0 .or. ndimV.gt.3) then print*,'*** ERROR: ndimV = ',ndimV,' in set_labels ***' return endif do i=1,ndim ix(i) = i enddo ipmass = ndim+1 ! particle mass ivx = ndim+2 ih = ndim + 1 + ndimV + 1 ! smoothing length iutherm = ih+1 ! thermal energy irho = iutherm+1 ! location of rho in data array label(ix(1:ndim)) = labelcoord(1:ndim,1) label(irho) = 'density' label(iutherm) = 'u' label(ih) = 'h' label(ipmass) = 'particle mass' label(irho+1) = 'alpha' label(irho+2) = 'potential energy' ! !--set labels for vector quantities ! iamvec(ivx:ivx+ndimV-1) = ivx labelvec(ivx:ivx+ndimV-1) = 'v' do i=1,ndimV label(ivx+i-1) = trim(labelvec(ivx))//'\d'//labelcoord(i,1) enddo if (iBfirst.gt.0) then iamvec(iBfirst:iBfirst+ndimV-1) = iBfirst labelvec(iBfirst:iBfirst+ndimV-1) = 'B' do i=1,ndimV label(iBfirst+i-1) = trim(labelvec(iBfirst))//'\d'//labelcoord(i,1) enddo endif ! !--set labels for each particle type ! ntypes = 3 labeltype(1) = 'gas' labeltype(2) = 'Nbody' labeltype(3) = 'point mass' UseTypeInRenderings(1) = .true. UseTypeInRenderings(2) = .false. UseTypeInRenderings(3) = .false. !----------------------------------------------------------- return end subroutine set_labels splash/src/render.f90000644 000770 000000 00000022530 12156075751 015351 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !------------------------------------------------------------------------ ! Module containing "interface" routines between the calculated ! pixel arrays and the plot library routines which do the actual rendering !------------------------------------------------------------------------ module render use colourbar, only:plotcolourbar implicit none public :: render_pix, render_vec private contains !------------------------------------------------------------------------ ! this subroutine takes a 2D grid of data and renders it via the ! plotting library. Rendering is either: ! - contours (icolouropt = 0) ! - greyscale (icolouropt = 1) ! - colour (icolouropt>1) ! contouring plots nc contours between datmin and datmax. !------------------------------------------------------------------------ subroutine render_pix(datpix,datmin,datmax,label,npixx,npixy, & xmin,ymin,dx,dy,icolouropt,iplotcont,iColourBarStyle,ncontours,log, & ilabelcont,contmin,contmax,blank,transparent,alpha) use plotutils, only:formatreal use plotlib, only:plot_imag,plot_conb,plot_cons,plot_qch,plot_sch,& plot_qch,plot_sch,plot_conl,plot_gray,plot_imag_transparent,& plot_imag_alpha use contours_module, only:read_contours,contours_list,contourtitles implicit none integer, intent(in) :: npixx,npixy,ncontours,icolouropt real, intent(in) :: xmin,ymin,datmin,datmax,dx,dy real, dimension(npixx,npixy), intent(in) :: datpix logical, intent(in) :: iplotcont,log,ilabelcont integer, intent(in) :: iColourBarStyle character(len=*), intent(in) :: label real, intent(in), optional :: contmin,contmax,blank logical, intent(in), optional :: transparent real, dimension(npixx,npixy), intent(in), optional :: alpha integer :: i,ierr,nc real :: trans(6),levels(ncontours),dcont,charheight,cmin,cmax character(len=12) :: string logical :: iuse_transparent,ifixed_contours ! !--set up grid for rendering ! trans(1) = xmin - 0.5*dx ! this is for the pgimag call trans(2) = dx ! see help for pgimag/pggray/pgcont trans(3) = 0.0 trans(4) = ymin - 0.5*dy trans(5) = 0.0 trans(6) = dy iuse_transparent = .false. if (present(transparent)) iuse_transparent = transparent print*,'rendering...',npixx,'x',npixy,'=',size(datpix),' pixels' if (abs(icolouropt).eq.1) then ! greyscale if (iColourBarStyle.gt.0) call plotcolourbar(iColourBarstyle,icolouropt,datmin,datmax,trim(label),log,0.) if (icolouropt.eq.1) then call plot_gray(datpix,npixx,npixy,1,npixx,1,npixy,datmin,datmax,trans) else !--allow inverse greyscale call plot_imag(datpix,npixx,npixy,1,npixx,1,npixy,datmin,datmax,trans) endif elseif (abs(icolouropt).gt.0) then ! colour ! !--plot colour bar ! if (iColourBarStyle.gt.0) call plotcolourbar(iColourBarstyle,icolouropt,datmin,datmax,trim(label),log,0.) ! !--plot pixel map ! if (iuse_transparent) then call plot_imag_transparent(datpix,npixx,npixy,1,npixx,1,npixy,datmin,datmax,trans) else if (present(alpha)) then call plot_imag_alpha(datpix,alpha,npixx,npixy,1,npixx,1,npixy,datmin,datmax,trans) else call plot_imag(datpix,npixx,npixy,1,npixx,1,npixy,datmin,datmax,trans) endif endif endif ! !--contours ! if (iplotcont) then nc = ncontours if (present(contmin)) then cmin = contmin else cmin = datmin endif if (present(contmax)) then cmax = contmax else cmax = datmax endif ! !--set contour levels: first attempt to read these ! from a file. If file does not exist or errors during read ! then we construct the default levels as usual. ! call read_contours(nc,ierr) if (ierr.eq.0 .and. nc.gt.0) then ifixed_contours = .true. else nc = ncontours ifixed_contours = .false. endif if (ifixed_contours) then do i=1,min(nc,ncontours) print*,"contour @ ", contours_list(i), ": ", trim(contourtitles(i)) levels(i) = contours_list(i) enddo dcont = 0. elseif (nc.le.0) then print*,'ERROR: cannot plot contours with ',nc,' levels' return elseif (nc.eq.1) then levels(1) = cmin dcont = 0. else dcont = (cmax-cmin)/real(nc-1) ! even contour levels do i=1,nc levels(i) = cmin + real(i-1)*dcont enddo endif ! !--plot contours (use pgcont if pgcons causes trouble) ! with blanking if blank is input ! if (present(blank)) then if (.not.ifixed_contours) then print 10,nc,' contours (with blanking)',levels(1),levels(nc),dcont print 20,levels(1:nc) endif !print*,' blanking = ',blank,'min,max = ',datmin,datmax call plot_conb(datpix,npixx,npixy,1,npixx,1,npixy,levels,nc,trans,blank) else if (.not.ifixed_contours) then print 10,nc,' contours',levels(1),levels(nc),dcont print 20,levels(1:nc) endif call plot_cons(datpix,npixx,npixy,1,npixx,1,npixy,levels,nc,trans) endif 10 format(1x,'plotting ',i4,a,' between ',es10.2,' and ',es10.2,', every ',es10.2,':') 20 format(10(6(1x,es9.2),/)) ! !--labelling of contour levels ! if (ilabelcont) then call plot_qch(charheight) ! query character height call plot_sch(0.75*charheight) ! shrink character height do i=1,nc if (ifixed_contours) then string=adjustl(contourtitles(i)) else call formatreal(levels(i),string) endif call plot_conl(datpix,npixx,npixy,1,npixx,1,npixy,levels(i),trans,trim(string),npixx/2,30) enddo call plot_sch(charheight) ! restore character height endif ! !--this line prints the label inside the contour plot ! (now obsolete-- this functionality can be achieved using plot titles) ! call pgmtxt('T',-2.0,0.05,0.0,trim(label)) endif return end subroutine render_pix !-------------------------------------------------------------------------- ! this subroutine takes a 2D grid of vector data (ie. x and y components) ! and plots an arrow map of it !-------------------------------------------------------------------------- subroutine render_vec(vecpixx,vecpixy,vecmax,npixx,npixy, & xmin,ymin,dx,dy,label,unitslabel,plotlegend) use legends, only:legend_vec use settings_vecplot, only:hposlegendvec,vposlegendvec,& iplotarrowheads,iallarrowssamelength use plotlib, only:plot_sah,plot_qch,plot_sch,plot_vect implicit none integer, intent(in) :: npixx,npixy real, intent(in) :: xmin,ymin,dx,dy real, intent(inout) :: vecmax real, dimension(npixx,npixy), intent(in) :: vecpixx,vecpixy real, dimension(npixx,npixy) :: dvmag character(len=*), intent(in) :: label,unitslabel logical, intent(in) :: plotlegend real :: trans(6),scale real :: charheight !set up grid for rendering trans(1) = xmin - 0.5*dx ! this is for the pgimag call trans(2) = dx ! see help for pgimag/pggray/pgcont trans(3) = 0.0 trans(4) = ymin - 0.5*dy trans(5) = 0.0 trans(6) = dy print*,'vector plot..',npixx,'x',npixy,'=',size(vecpixx),' pixels' !!print*,'max(x component) = ',maxval(vecpixx),'max(y component) = ',maxval(vecpixy) if (iplotarrowheads) then call plot_sah(2,45.0,0.7) ! arrow style else call plot_sah(2,0.0,1.0) endif call plot_qch(charheight) call plot_sch(0.3) ! size of arrow head if (iallarrowssamelength) then !!if (vecmax.le.0.0) vecmax = 1.0 ! adaptive limits scale=0.9*dx !!/vecmax print*,trim(label),' showing direction only: max = ',vecmax where (abs(vecpixx).gt.tiny(vecpixx) .and. abs(vecpixy).gt.tiny(vecpixy)) dvmag(:,:) = 1./sqrt(vecpixx**2 + vecpixy**2) elsewhere dvmag(:,:) = 0. end where call plot_vect(vecpixx(:,:)*dvmag(:,:),vecpixy(:,:)*dvmag(:,:),npixx,npixy, & 1,npixx,1,npixy,scale,0,trans,0.0) else if (vecmax.le.0.0) then ! adaptive limits scale = 0.0 vecmax = max(maxval(vecpixx(:,:)),maxval(vecpixy(:,:))) if (vecmax.gt.0.) scale = dx/vecmax else scale=dx/vecmax endif print*,trim(label),' max = ',vecmax call plot_vect(vecpixx(:,:),vecpixy(:,:),npixx,npixy, & 1,npixx,1,npixy,scale,0,trans,0.0) if (plotlegend) then call legend_vec(label,unitslabel,vecmax,dx,hposlegendvec,vposlegendvec,charheight) endif endif call plot_sch(charheight) return end subroutine render_vec end module render splash/src/rotate.f90000644 000770 000000 00000017446 12156075733 015402 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! This module contains all the routines for rotating the particles ! and plotting the rotated axes ! module rotation implicit none ! !--2D rotation (about z axis) ! contains subroutine rotate2D(xcoords,anglez) implicit none real, intent(inout) :: xcoords(2) real, intent(in) :: anglez real :: x, y, r, phi x = xcoords(1) y = xcoords(2) ! !--rotate about z ! r = sqrt(x**2 + y**2) phi = ATAN2(y,x) phi = phi - anglez x = r*COS(phi) y = r*SIN(phi) xcoords(1) = x xcoords(2) = y return end subroutine rotate2D ! !--3D rotation (about x, y and z axes) ! This is done in the order z-y-x ! subroutine rotate3D(xcoords,anglex,angley,anglez,zobs,dz1) implicit none real, intent(inout) :: xcoords(3) real, intent(in) :: anglex, angley, anglez, zobs, dz1 real :: x, y, z, r, phi, zfrac x = xcoords(1) y = xcoords(2) z = xcoords(3) ! !--rotate about z ! if (abs(anglez).gt.tiny(anglez)) then r = sqrt(x**2 + y**2) phi = ATAN2(y,x) phi = phi - anglez x = r*COS(phi) y = r*SIN(phi) endif ! !--rotate about y ! if (abs(angley).gt.tiny(angley)) then r = sqrt(z**2 + x**2) phi = ATAN2(z,x) phi = phi - angley z = r*SIN(phi) x = r*COS(phi) endif ! !--rotate about x ! if (abs(anglex).gt.tiny(anglex)) then r = sqrt(y**2 + z**2) phi = ATAN2(z,y) phi = phi - anglex y = r*COS(phi) z = r*SIN(phi) endif ! !--change perspective according to z depth ! (for straight rotation == parallel projections use dz1= 0 on input) ! zobs is the z position of the observer. ! if (abs(dz1).gt.tiny(dz1)) then zfrac = abs(dz1/(z-zobs)) else zfrac = 1.0 endif xcoords(1) = x*zfrac xcoords(2) = y*zfrac xcoords(3) = z return end subroutine rotate3D ! !--plots rotated plot axes ! subroutine rotate_axes2D(ioption,xmin,xmax,xorigin,anglez) use plotlib, only:plot_arro,plot_sfs,plot_poly implicit none integer, intent(in) :: ioption real, intent(in), dimension(2) :: xmin,xmax,xorigin real, intent(in) :: anglez integer :: i,idim real, dimension(2) :: xpttemp real, dimension(2,4) :: xpt ! ! plot various options for the 3D axes ! select case(ioption) case(1) !--rotated axes print*,'plotting rotated (2D) axes...' do idim=1,2 !--plot to max of each axis xpt(:,2) = 0. xpt(idim,2) = xmax(idim) do i=1,2 xpttemp(:) = xpt(:,i) - xorigin(:) call rotate2D(xpttemp(:),anglez) xpt(:,i) = xpttemp(:) + xorigin(:) enddo !--plot each axis as an arrow call plot_arro(xpt(1,1),xpt(2,1),xpt(1,2),xpt(2,2)) enddo case default print*,'plotting rotated (2D) box...' !--front face (pts 1->4) xpt(:,1) = xmin(:) ! xmin, ymin xpt(1,2) = xmin(1) ! xmin xpt(2,2) = xmax(2) ! ymax xpt(1,3) = xmax(1) ! xmax xpt(2,3) = xmax(2) ! ymax xpt(1,4) = xmax(1) ! xmax xpt(2,4) = xmin(2) ! ymin ! !--now rotate each of these coordinates ! do i=1,4 xpttemp(:) = xpt(:,i) - xorigin(:) call rotate2D(xpttemp(:),anglez) xpt(:,i) = xpttemp(:) + xorigin(:) enddo ! !--now plot box appropriately using points ! call plot_sfs(2) call plot_poly(4,xpt(1,1:4),xpt(2,1:4)) end select return end subroutine rotate_axes2D subroutine rotate_axes3D(ioption,iplotx,iploty,xmin,xmax,xorigin, & anglex,angley,anglez,zobs,dz1) use plotlib, only:plot_poly,plot_sfs,plot_arro,plot_line implicit none integer, intent(in) :: ioption,iplotx,iploty real, intent(in), dimension(3) :: xmin,xmax,xorigin real, intent(in) :: anglex, angley, anglez, zobs, dz1 integer :: i,idim,iline integer, parameter :: nlines = 10 real, dimension(3,8) :: xpt real, dimension(3) :: xpttemp real, dimension(2) :: xline,yline real :: dx ! ! plot various options for the 3D axes ! select case(ioption) case(1) !--rotated axes print*,'plotting rotated 3D axes...' xpt = 0. !--origin xpt(1:3,1) = 0. do idim=1,3 !--plot to max of each axis xpt(:,2) = 0. xpt(idim,2) = xmax(idim) do i=1,2 xpttemp(:) = xpt(:,i) - xorigin(:) call rotate3D(xpttemp(:),anglex,angley,anglez,zobs,dz1) xpt(:,i) = xpttemp(:) + xorigin(:) enddo !--plot each axis as an arrow call plot_arro(xpt(iplotx,1),xpt(iploty,1),xpt(iplotx,2),xpt(iploty,2)) !! call pgline(2,xpt(iplotx,1:2),xpt(iploty,1:2)) enddo case(2) !--rotated box print*,'plotting rotated 3D box...',iplotx,iploty !--front face (pts 1->4) xpt(:,1) = xmin(:) ! xmin, ymin xpt(1,2) = xmin(1) ! xmin xpt(2,2) = xmax(2) ! ymax xpt(1,3) = xmax(1) ! xmax xpt(2,3) = xmax(2) ! ymax xpt(1,4) = xmax(1) ! xmax xpt(2,4) = xmin(2) ! ymin xpt(3,1:4) = xmin(3) ! zmin !--back face (pts 5->8) do i=1,4 xpt(1:2,i+4) = xpt(1:2,i) enddo xpt(3,5:8) = xmax(3) ! !--now rotate each of these coordinates ! do i=1,8 xpttemp(:) = xpt(:,i) - xorigin(:) call rotate3D(xpttemp(:),anglex,angley,anglez,zobs,dz1) xpt(:,i) = xpttemp(:) + xorigin(:) enddo ! !--now draw lines appropriately through points ! call plot_sfs(2) !--front face call plot_poly(4,xpt(iplotx,1:4),xpt(iploty,1:4)) !--back face call plot_poly(4,xpt(iplotx,5:8),xpt(iploty,5:8)) !--connecting lines ( 1->5, 2->6, 3->7, 4->8 ) do i=1,4 xline(1) = xpt(iplotx,i) yline(1) = xpt(iploty,i) xline(2) = xpt(iplotx,i+4) yline(2) = xpt(iploty,i+4) call plot_line(2,xline,yline) enddo case(3) !--gridded x-y plane print*,'plotting rotated x-y plane...' !--lines of constant x dx = (xmax(1) - xmin(1))/real(nlines-1) do iline=1,nlines !--all pts at z = 0 xpt(3,:) = 0. !--start from xmin, plot line from ymin to ymax xpt(1,1:2) = xmin(1) + (iline-1)*dx xpt(2,1) = xmin(2) xpt(2,2) = xmax(2) do i=1,2 xpttemp(:) = xpt(:,i) - xorigin(:) call rotate3D(xpttemp(:),anglex,angley,anglez,zobs,dz1) xpt(:,i) = xpttemp(:) + xorigin(:) enddo call plot_line(2,xpt(iplotx,1:2),xpt(iploty,1:2)) enddo !--lines of constant y dx = (xmax(2) - xmin(2))/real(nlines-1) do iline=1,nlines !--all pts at z = 0 xpt(3,:) = 0. !--start from ymin, plot line from xmin to xmax xpt(2,1:2) = xmin(2) + (iline-1)*dx xpt(1,1) = xmin(1) xpt(1,2) = xmax(1) do i=1,2 xpttemp(:) = xpt(:,i) - xorigin(:) call rotate3D(xpttemp(:),anglex,angley,anglez,zobs,dz1) xpt(:,i) = xpttemp(:) + xorigin(:) enddo call plot_line(2,xpt(iplotx,1:2),xpt(iploty,1:2)) enddo case default !--do nothing end select return end subroutine rotate_axes3D end module rotation splash/src/setpage.f90000644 000770 000000 00000036453 12517310430 015516 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module pagesetup implicit none public :: redraw_axes, setpage2 real, parameter, public :: xlabeloffset = 2.5, ylabeloffset = 4.5 private contains ! !--this subroutine determines the setup of the plotting page ! sorts out labelling of axes, positioning of windows etc ! can be used as a replacement for PGENV and PGLABEL ! ! divides up a single page into subpanels ! ! ! option to tile graphs appropriately on a page: ! divides up a single panel into subpanels, with a margin at the edge ! should replace the call to pgenv and pglabel ! ! for tiled plots the page setup looks like this: ! ! | | | | ! --+---+---+---+-- ! | 1 | 2 | 3 | ! --+---+---+---+-- ! | 4 | 5 | 6 | ! --+---+---+---+-- ! | | | | ! ! (ie. with margins in x and y) ! note that we divide up a single panel, so pgbeg should be called with nx=1,ny=1 ! ! arguments: ! iplot : current plot number ! nx : number of panels in x direction ! ny : number of panels in y direction ! xmin, : xmax, ymin, ymax : plot limits (if tiled should be same for all plots) ! labelx : x axis label (if tiled should be same for all plots) ! labely : y axis label (if tiled should be same for all plots) ! title : current plot title (can differ between plots) ! just : just=1 gives equal aspect ratios (same as in pgenv) ! axis : axes options (same as in pgenv with a few extra) ! vmarginleft,right,bottom,top : initial margin sizes (% of page (if tiled) or panel (if not)) ! (default should be zero for these) ! tile : assumes all plots can be tiled ! ! This version by Daniel Price, July 2006 ! subroutine setpage2(iplotin,nx,ny,xmin,xmax,ymin,ymax,labelx,labely,title,just,axis, & vmarginleftin,vmarginrightin,vmarginbottomin,vmargintopin, & colourbarwidth,titleoffset,isamexaxis,tile,adjustlimits,lastrow,lastplot,& yscale,labelyalt,itransy) use plotlib,only:plot_svp,plot_swin,plot_box,plot_qvsz,plot_annotate, & plot_page,plot_qcs,plot_wnad,plot_set_exactpixelboundaries, & plot_qvp use asciiutils, only:string_delete implicit none integer, intent(in) :: iplotin,nx,ny,just,axis,itransy real, intent(inout) :: xmin, xmax, ymin, ymax real, intent(in) :: colourbarwidth, titleoffset real, intent(in) :: vmarginleftin,vmarginrightin,vmargintopin,vmarginbottomin real, intent(in) :: yscale character(len=*), intent(in) :: labelx,labely,title,labelyalt logical, intent(in) :: isamexaxis,tile,adjustlimits,lastrow,lastplot integer iplot,ix,iy real vptsizeeffx,vptsizeeffy,panelsizex,panelsizey real vmargintop,vmarginbottom,vmarginleft,vmarginright real vptxmin,vptxmax,vptymin,vptymax real aspectratio,devaspectratio,x1,x2,y1,y2 real xch,ych,dx,dy,xcen,ycen character(len=10) :: xopts, yopts logical, parameter :: useexactpixelboundaries = .true. logical :: plot_alt_y_axis if (axis.eq.4) then plot_alt_y_axis = .true. else plot_alt_y_axis = .false. endif ! ! new page if iplot > number of plots on page ! if (iplotin.gt.nx*ny) then if (mod(iplotin,nx*ny).eq.1) call plot_page iplot = iplotin - (nx*ny)*((iplotin-1)/(nx*ny)) elseif (iplotin.le.0) then return else iplot = iplotin endif ! ! check for errors in input ! if (nx.le.0 .or. ny.le.0) return ! ! for tiled plots, adjust effective viewport size if just=1 and graphs are not square ! if (tile .and. just.eq.1) then if (abs(ymax-ymin) < tiny(ymin)) then print*,'setpage: error tiling plots: ymax=ymin' return endif ! ! query the current aspect ratio of the device and set aspect ratio appropriately ! call plot_qvsz(3,x1,x2,y1,y2) devaspectratio = (x2-x1)/(y2-y1) aspectratio = ((xmax-xmin)*nx)/((ymax-ymin)*ny)/devaspectratio else aspectratio = 1.0 endif ! ! set positions of x and y labels in units of character height from edge ! ! xlabeloffset = 3.0 ! ylabeloffset = 4.5 ! ! query the character height as fraction of viewport ! call plot_qcs(0,xch,ych) ! ! set margin size in units of viewport dimensions ! allow enough room for the plot labels if they are drawn ! nb: pgplot sets the character height as some fraction of the smallest ! dimension ! ! for tiled plots, these margins apply to the whole page ! otherwise, these are applied to each panel individually ! vmargintop = vmargintopin vmarginright = vmarginrightin if (axis.ge.0) then !--if we are drawing an axis ! leave a minimum of half a character ! spacing (or 0.7 for antialiasing) ! so that axis numbers are not chopped ! in half at the edges of the viewport vmargintop = max(vmargintop,0.7*ych) vmarginright = max(vmarginright,0.7*xch) !--leave space for labels if (axis.ne.3) then vmarginleft = vmarginleftin + (ylabeloffset+1.5)*xch vmarginbottom = vmarginbottomin + (xlabeloffset+1.0)*ych else vmarginleft = vmarginleftin + 2.0*xch vmarginbottom = vmarginbottomin + 1.5*ych endif if (plot_alt_y_axis) vmarginright = vmarginleft if (.not.tile) then if (ny.gt.1 .and. .not.isamexaxis) then vmarginbottom = vmarginbottom + 0.5*ych elseif (ny.gt.1) then vmarginbottom = vmarginbottom + 0.25*ych endif endif else vmarginleft = vmarginleftin vmarginbottom = vmarginbottomin endif ! !--set size of each panel ! ix = iplot - ((iplot-1)/nx)*nx iy = (iplot-1)/nx + 1 if (tile) then !--also leave room for title if necessary if (titleoffset.ge.0.) then vmargintop = vmargintop + (titleoffset+1.)*ych endif ! ! effective viewport size = size - margins (only used for tiled ! vptsizeeffx = 1.0 - vmarginright - vmarginleft vptsizeeffy = 1.0 - vmargintop - vmarginbottom ! reduce x or y size if just=1 to get right aspect ratio if (aspectratio.le.1.0 .and. just.eq.1) then if (aspectratio*vptsizeeffy.lt.vptsizeeffx) then vptsizeeffx = aspectratio*vptsizeeffy ! but this could still be bigger than the margins allow... else vptsizeeffy = vptsizeeffx/aspectratio endif elseif (aspectratio.gt.1.0 .and. just.eq.1) then if (vptsizeeffx/aspectratio.lt.vptsizeeffy) then vptsizeeffy = vptsizeeffx/aspectratio ! but this could still be bigger than the margins allow... else vptsizeeffx = vptsizeeffy*aspectratio endif endif panelsizex = vptsizeeffx/nx panelsizey = vptsizeeffy/ny ! print*,ix,iy,nx,ny ! print*,panelsizex,panelsizey,vptsizeeffx,vptsizeeffy ! print*,'margins = ',vmarginleft,vmarginright vptxmin = vmarginleft + (ix-1)*panelsizex vptxmax = vptxmin + panelsizex vptymax = (1.0 - vmargintop) - (iy-1)*panelsizey vptymin = vptymax - panelsizey else !--use full page for non-tiled plots, then set margins inside each panel panelsizex = 1.0/nx panelsizey = 1.0/ny vptxmin = (ix-1)*panelsizex + vmarginleft vptxmax = ix*panelsizex - vmarginright vptymax = 1.0 - (iy-1)*panelsizey - vmargintop vptymin = 1.0 - iy*panelsizey + vmarginbottom !--also leave room for title if necessary if (titleoffset.ge.0.) then vptymax = vptymax - (titleoffset+1.)*ych endif !--also leave room for colour bar if necessary if (colourbarwidth.GT.0.) then vptxmax = vptxmax - (colourbarwidth + 1.6)*xch endif endif ! print*,vptxmin,vptxmax,vptymin,vptymax ! ! set viewport ! !print*,'setting ',vptxmin,vptxmax,vptymin,vptymax call plot_svp(vptxmin,vptxmax,vptymin,vptymax) ! ! set axes ! if (just.eq.1) then if (nx*ny.eq.1 .and. adjustlimits) then !--query viewport aspect ratio call plot_qvp(3,x1,x2,y1,y2) devaspectratio = (x2-x1)/(y2-y1) !--adjust limits to match viewport aspect ratio dx = xmax - xmin dy = ymax - ymin if (devaspectratio*dy/dx.ge.1.) then xcen = 0.5*(xmin + xmax) xmin = xcen - 0.5*devaspectratio*dy xmax = xcen + 0.5*devaspectratio*dy print*,' auto-adjusting xmin = ',xmin,' xmax = ',xmax else ycen = 0.5*(ymin + ymax) ymin = ycen - 0.5*dx/devaspectratio ymax = ycen + 0.5*dx/devaspectratio print*,' auto-adjusting ymin = ',ymin,' ymax = ',ymax endif endif call plot_wnad(xmin,xmax,ymin,ymax) else call plot_swin(xmin,xmax,ymin,ymax) endif ! ! adjust viewport to lie exactly on pixel boundaries ! if (useexactpixelboundaries) call plot_set_exactpixelboundaries() ! ! option to return before actually doing anything ! if (trim(title).eq.'NOPGBOX') return ! ! set options for call to pgbox (draws axes) and label axes where appropriate ! (options are exactly as in pgenv apart from axis=-3,-4 which i have added) ! yopts = '*' select case(axis) case(-4) xopts = 'BCT' case(-3) xopts = 'BCST' case(-2) xopts = ' ' case(-1) xopts = 'BC' case(0,4) xopts = 'BCST' case(1) xopts = 'ABCST' case(2) xopts = 'ABCGST' case(3) xopts = 'BCST' case(10) xopts = 'BCSTL' yopts = 'BCST' case(20) xopts = 'BCST' yopts = 'BCSTL' case(30) xopts = 'BCSTL' yopts = 'BCSTL' case default print*,'setpage: illegal axis argument.' xopts = 'BCNST' end select if (yopts.eq.'*') yopts = xopts if (plot_alt_y_axis) call string_delete(yopts,'C') ! ! label plot ! if (tile) then ! ! decide whether to number and label the y axis ! if (ix.eq.nx .and. axis.ge.0) then ! !--apply label to right hand side axis if used ! if (plot_alt_y_axis) then call plot_second_y_axis(yopts,just,axis,itransy,yscale,ylabeloffset,labelyalt) endif endif if (ix.eq.1 .and. axis.ge.0) then ! !--label "normal" y axis ! if (axis.eq.3) then yopts = '1N'//trim(yopts) else yopts = '1VN'//trim(yopts) call plot_annotate('L',ylabeloffset,0.5,0.5,labely) endif elseif (axis.ge.0) then !yopts = trim(yopts)//'N' endif ! ! decide whether to number and label the x axis ! if ((iy.eq.ny .or. lastplot .or. lastrow) .and. axis.ge.0) then xopts = 'N'//trim(xopts) if (axis.ne.3) call plot_annotate('B',xlabeloffset,0.5,0.5,labelx) endif ! ! plot the title if inside the plot boundaries ! if (titleoffset.lt.0.) call plot_annotate('t',-titleoffset,0.96,1.0,title) elseif (axis.ge.0) then ! !--label x axis only if on last row ! or if x axis quantities are different ! if (((ny*nx-iplot).lt.nx).or.(.not.isamexaxis).or.lastplot) then if (axis.ne.3) call plot_annotate('B',xlabeloffset,0.5,0.5,labelx) endif !--always plot numbers xopts = 'N'//trim(xopts) ! !--apply label to right hand side axis if used ! if (plot_alt_y_axis) then call plot_second_y_axis(yopts,just,axis,itransy,yscale,ylabeloffset,labelyalt) endif ! !--always label y axis ! if (axis.eq.3) then yopts = '1N'//trim(yopts) else yopts = '1VN'//trim(yopts) call plot_annotate('L',ylabeloffset,0.5,0.5,labely) endif ! !--always plot title ! call plot_annotate('T',-titleoffset,0.5,0.5,title) endif call plot_box(xopts,0.0,0,yopts,0.0,0) return end subroutine ! !--this subroutine is a cut down version of the above, which ONLY redraws the axes ! (so that axes can be redrawn on *top* of what has been plotted). ! ! inputs: ! axis : axes options (same as in PGENV, with axis=-4,-3,+3 added) ! subroutine redraw_axes(iaxis,just,yscale,itransy) use plotlib, only:plot_box implicit none integer, intent(in) :: iaxis,just,itransy character(len=10) :: xopts, yopts real, intent(in) :: yscale ! !--set plot axes (options are exactly as in PGENV, with axis=-4,-3,+3 added) ! yopts = '*' select case(iaxis) case(-4) xopts = 'BCT' case(-3) xopts = 'BCST' case(-2) xopts = ' ' case(-1) xopts = 'BC' case(0) xopts = 'BCST' case(1) xopts = 'ABCST' case(2) xopts = 'ABCGST' case(3) xopts = 'BCST' case(4) xopts = 'BCST' yopts = 'BST' case(10) xopts = 'BCSTL' yopts = 'BCST' case(20) xopts = 'BCST' yopts = 'BCSTL' case(30) xopts = 'BCSTL' yopts = 'BCSTL' case default print*,'redraw_axes: illegal AXIS argument.' xopts = 'BCST' end select if (yopts.eq.'*') yopts = xopts if (iaxis.eq.4) call plot_second_y_axis(yopts,just,iaxis,itransy,yscale) call plot_box(xopts,0.0,0,yopts,0.0,0) return end subroutine redraw_axes subroutine plot_second_y_axis(yopts,just,iaxis,itransy,yscale,ylabeloffset,labely) use plotlib, only:plot_box,plot_annotate,plot_qwin,plot_swin,plot_wnad use asciiutils, only:string_delete use transforms, only:transform,transform_inverse,transform_label implicit none character(len=*), intent(in) :: yopts real, intent(in) :: yscale real, intent(in), optional :: ylabeloffset character(len=*), intent(in), optional :: labely integer, intent(in) :: just,iaxis,itransy character(len=10) :: yoptsi character(len=120) :: labelyalt real :: xmin,xmax,ymin,ymax,yminalt,ymaxalt yoptsi = yopts call string_delete(yoptsi,'B') call string_delete(yoptsi,'N') !--save plot window settings call plot_qwin(xmin,xmax,ymin,ymax) !--scaling of y axis: multiplication in un-transformed space yminalt = ymin ymaxalt = ymax if (itransy.gt.0) call transform_inverse(yminalt,ymaxalt,itransy) yminalt = yminalt*yscale ymaxalt = ymaxalt*yscale if (itransy.gt.0) call transform(yminalt,ymaxalt,itransy) !--set plot window to new scaled y axis if (just.eq.1) then call plot_wnad(xmin,xmax,yminalt,ymaxalt) else call plot_swin(xmin,xmax,yminalt,ymaxalt) endif !--draw axes and label on right hand side of box if (iaxis.eq.3) then call plot_box(' ',0.0,0,'1MC'//trim(yoptsi),0.0,0) else call plot_box(' ',0.0,0,'1VMC'//trim(yoptsi),0.0,0) endif if (present(labely) .and. present(ylabeloffset)) then labelyalt = labely if (itransy.gt.0) labelyalt = transform_label(labely,itransy) call plot_annotate('R',ylabeloffset,0.5,0.5,labelyalt) endif !--reset plot window if (just.eq.1) then call plot_wnad(xmin,xmax,ymin,ymax) else call plot_swin(xmin,xmax,ymin,ymax) endif end subroutine plot_second_y_axis end module pagesetup splash/src/shapes.f90000644 000770 000000 00000061053 12371126445 015354 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! module which handles plotting of arbitrary shapes ! written by Daniel Price 2008 ! as part of the SPLASH SPH visualisation package !----------------------------------------------------------------- module shapes implicit none integer, parameter, private :: maxshapes = 32 integer, parameter, private :: maxshapetype = 7 integer :: nshapes integer, parameter, private :: lentext = 120 type shapedef integer :: itype integer :: icolour integer :: linestyle integer :: linewidth integer :: ifillstyle integer :: iunits integer :: iplotonpanel real :: xpos real :: ypos real :: xlen,ylen real :: angle,fjust real :: opacity character(len=lentext) :: text end type type(shapedef), dimension(maxshapes), public :: shape character(len=9), dimension(maxshapetype), & parameter, public :: labelshapetype = & (/'square ', & 'rectangle', & 'arrow ', & 'circle ', & 'line ', & 'text ', & 'f(x) '/) namelist /shapeopts/ nshapes,shape integer, parameter, private :: maxunits = 2 character(len=20), dimension(maxunits), & parameter, private :: labelunits = & (/'units of plot ', & 'viewport coordinates'/) ! 'inches ', & ! 'millimeters ', & ! 'pixels '/) procedure(check_shapes), pointer, private :: checkshapes => null() procedure(add_shape), pointer, private :: addshape => null() procedure(delete_shape), pointer, private :: delshape => null() real, parameter, private :: pi = 3.1415926536 contains !----------------------------------------------------------------- ! shape default settings !----------------------------------------------------------------- subroutine defaults_set_shapes implicit none nshapes = 0 shape(:)%itype = 0 shape(:)%icolour = 1 shape(:)%linestyle = 1 shape(:)%linewidth = 1 shape(:)%ifillstyle = 2 shape(:)%iunits = 1 shape(:)%iplotonpanel = 0 shape(:)%xpos = 0.5 shape(:)%ypos = 0.5 shape(:)%xlen = 1. shape(:)%ylen = 1. shape(:)%angle = 0. shape(:)%text = ' ' shape(:)%fjust = 0. shape(:)%opacity = 1. return end subroutine defaults_set_shapes !----------------------------------------------------------------- ! shape submenu !----------------------------------------------------------------- subroutine submenu_shapes() use promptlist, only:prompt_list implicit none checkshapes => check_shapes addshape => add_shape delshape => delete_shape call prompt_list(nshapes,maxshapes,'shape',checkshapes,addshape,delshape) end subroutine submenu_shapes !----------------------------------- ! print the current list of shapes !----------------------------------- subroutine check_shapes(nshape) implicit none integer, intent(in) :: nshape integer :: ishape print "(/,a)", ' Current list of plot annotations:' if (nshape.gt.0) then do ishape=1,nshape call print_shapeinfo(ishape,shape(ishape)%itype,shape(ishape)) enddo else print "(a)",' (none)' endif end subroutine check_shapes !---------------------------------------- ! pretty-print information about a shape !---------------------------------------- subroutine print_shapeinfo(inum,itype,shapein) implicit none integer, intent(in) :: inum,itype type(shapedef), intent(in), optional :: shapein character(len=20), parameter :: fmtstring = "('Shape ',i2,': ',a)" select case(itype) case(1) print "(10x,a)",' --' write(*,fmtstring,advance='no') inum,' | | '//labelshapetype(itype) if (present(shapein)) then print "(5x,es10.2,' x ',es10.2)",shapein%xlen,shapein%ylen else print* endif print "(10x,a)",' --' case(2) print "(10x,a)",' -----' write(*,fmtstring,advance='no') inum,' | | '//labelshapetype(itype) if (present(shapein)) then print "(5x,es10.2,' x ',es10.2)",shapein%xlen,shapein%ylen else print* endif print "(10x,a)",' -----' case(3) print "(10x,a)" write(*,fmtstring,advance='no') inum,' ------> '//labelshapetype(itype) if (present(shapein)) then print "(6x,'length = ',es10.2,', angle = ',f5.1,' deg.')",& shapein%xlen,shapein%angle else print* endif print "(10x,a)" case(4) print "(10x,a)",' ___ ' print "(10x,a)",' / \ ' write(*,fmtstring,advance='no') inum,' ( ) '//labelshapetype(itype) if (present(shapein)) then print "(6x,'radius = ',es10.2)",& shapein%xlen else print* endif print "(10x,a)",' \___/ ' case(5) print "(10x,a)" write(*,fmtstring,advance='no') inum,' -------- '//labelshapetype(itype) if (present(shapein)) then print "(6x,'length = ',es10.2)",shapein%xlen else print* endif print "(10x,a)" case(6) print "(10x,a)", ' ' write(*,fmtstring,advance='no') inum,' TEXT ' if (present(shapein)) then print "('""',a,'""')",trim(shapein%text) else print* endif print "(10x,a)", ' ' case(7) print "(10x,a)",' _ / ' write(*,fmtstring,advance='no') inum,' / \ / '//trim(labelshapetype(itype)) if (present(shapein)) then print "(' = ',a)",trim(shapein%text) else print* endif print "(10x,a)",'/ \_/ ' case default print "(a)" write(*,fmtstring,advance='no') inum,' '//labelshapetype(itype) print "(a)" end select end subroutine print_shapeinfo !------------------------------------------ ! utility routine to add new shape object !------------------------------------------ subroutine add_shape(istart,iend,nshape) use params, only:maxplot use prompting, only:prompt use exactfunction, only:check_function use plotlib, only:plotlib_maxlinestyle,plotlib_maxlinecolour,plotlib_maxfillstyle,plotlib_supports_alpha implicit none integer, intent(in) :: istart,iend integer, intent(inout) :: nshape integer :: i,ishape,itype,indexi,iunits,ierr,itry character(len=10) :: poslabel character(len=80) :: string itype = 1 ishape = istart + 1 if (ishape.gt.maxshapes) then print "(/,a,i2,a)",' *** Error, maximum number of shapes (',maxshapes,') reached, cannot add any more.' print "(a)", ' *** If you hit this limit, *please email me* so I can change the default limits!' print "(a)", ' *** (and then edit shapes.f90, changing the parameter "maxshapes" to something higher...)' return endif ! !--fill prompt string with list of shapes ! indexi = 1 do i=1,maxshapetype if (i.lt.10) then write(string(indexi:),"(1x,i1,') ',a)") i,trim(labelshapetype(i)) else write(string(indexi:),"(1x,i2,') ',a)") i,trim(labelshapetype(i)) endif indexi = len_trim(string) + 1 enddo print "(/,a)",trim(string) !print "(i2,a)",(i,') '//trim(labelshapetype(i)),i=1,maxshapetype) over_shapes: do while(ishape.le.iend .and. i.le.maxshapes) if (istart.eq.0 .or. shape(ishape)%itype.le.0 .or. shape(ishape)%itype.gt.maxshapetype) then call prompt('choose an object type (0=none) ',shape(ishape)%itype,0,maxshapetype) endif itype = shape(ishape)%itype if (itype.eq.0) then call delete_shape(ishape,nshape) exit over_shapes else call print_shapeinfo(ishape,itype) if (itype.eq.7) then shape(ishape)%iunits = 1 else !--choose units do i=1,maxunits print "(i1,')',1x,a)",i,trim(labelunits(i)) enddo call prompt('enter units to use for plotting shape',shape(ishape)%iunits,0,maxunits) endif iunits = shape(ishape)%iunits select case(itype) case(1) ! square call prompt('enter length of side (in '//trim(labelunits(iunits))//')',shape(ishape)%xlen,0.) shape(ishape)%ylen = shape(ishape)%xlen poslabel = ' centre' case(2) ! rectangle call prompt('enter x length of side (in '//trim(labelunits(iunits))//')',shape(ishape)%xlen,0.) call prompt('enter y length of side (in '//trim(labelunits(iunits))//')',shape(ishape)%ylen,0.) poslabel = ' centre' case(3) ! arrow call prompt('enter arrow length (in '//trim(labelunits(iunits))//')',shape(ishape)%xlen,0.) call prompt('enter angle in degrees (0 = horizontal) ',shape(ishape)%angle) call prompt('enter justification factor (0.0=tail at x,y 1.0=head at x,y)',shape(ishape)%fjust) poslabel = '' case(4) ! circle call prompt('enter radius (in '//trim(labelunits(iunits))//')',shape(ishape)%xlen,0.) poslabel = ' centre' case(5) ! line call prompt('enter line length (in '//trim(labelunits(iunits))//')',shape(ishape)%xlen,0.) call prompt('enter angle of line in degrees (0.0 = horizontal) ',shape(ishape)%angle) poslabel = ' starting' case(6) ! text call prompt('enter text string ',shape(ishape)%text) call prompt('enter angle for text in degrees (0 = horizontal) ',shape(ishape)%angle) call prompt('enter justification factor (0.0=left 1.0=right)',shape(ishape)%fjust) poslabel = ' starting' case(7) ! arbitrary function ierr = 1 itry = 1 do while(ierr /= 0 .and. itry.le.3) if (itry.gt.1) print "(a,i1,a)",'attempt ',itry,' of 3:' print "(a,6(/,11x,a),/)",' Examples: sin(2*pi*x)','sqrt(0.5*x)','x^2', & 'exp(-2*x**2)','log10(x/2)','exp(p),p=sin(pi*x)','cos(z/d),z=acos(d),d=x^2' call prompt('enter function f(x) to plot ',shape(ishape)%text) call check_function(shape(ishape)%text,ierr) if (ierr /= 0 .and. len(shape(ishape)%text).eq.len_trim(shape(ishape)%text)) then print "(a,i3,a)",' (errors are probably because string is too long, max length = ',len(shape(ishape)%text),')' endif itry = itry + 1 enddo if (ierr.ne.0) then print "(a)",' *** too many tries, aborting ***' ishape = ishape - 1 cycle over_shapes endif poslabel = ' starting' end select if (itype.ne.7) then call prompt('enter'//trim(poslabel)//' x position (in '//trim(labelunits(iunits))//') ',shape(ishape)%xpos) call prompt('enter'//trim(poslabel)//' y position (in '//trim(labelunits(iunits))//') ',shape(ishape)%ypos) endif if (itype.eq.1 .or. itype.eq.2 .or. itype.eq.4) then call prompt('enter fill style (1=solid,2=outline,3=hatch,4=crosshatch) for '// & trim(labelshapetype(itype)),shape(ishape)%ifillstyle,0,plotlib_maxfillstyle) endif if (itype.ne.6) then call prompt('enter line style (1=solid,2=dash,3=dotdash,4=dot,5=dashdot) for '// & trim(labelshapetype(itype)),shape(ishape)%linestyle,0,plotlib_maxlinestyle) endif if (itype.ne.6) then call prompt('enter line width for '//trim(labelshapetype(itype)),shape(ishape)%linewidth,0) endif call prompt('enter '//trim(labelshapetype(itype))//' colour (0=background, 1=foreground, 2-16=plot lib colour indices)', & shape(ishape)%icolour,0,plotlib_maxlinecolour) if (plotlib_supports_alpha) then call prompt('enter '//trim(labelshapetype(itype))//' opacity (0.0-1.0)', & shape(ishape)%opacity,0.,1.) endif print "(/,' 0 : plot on every panel ',/,"// & "' -1 : plot on first row only ',/,"// & "' -2 : plot on first column only ',/,"// & "' n : plot on nth panel only ')" !--make sure the current setting falls within the allowed bounds if (shape(ishape)%iplotonpanel.lt.-2 .or. & shape(ishape)%iplotonpanel.gt.maxplot) shape(:)%iplotonpanel = 0 call prompt('Enter selection ',shape(ishape)%iplotonpanel,-2,maxplot) if (ishape.gt.nshape) nshape = ishape ishape = ishape + 1 endif enddo over_shapes end subroutine add_shape !------------------------------------------ ! utility routine to delete a shape object !------------------------------------------ subroutine delete_shape(ishape,nshape) implicit none integer, intent(in) :: ishape integer, intent(inout) :: nshape integer :: i if (ishape.gt.0 .and. nshape.gt.0 .and. ishape.le.maxshapes) then do i=ishape+1,nshape shape(i-1) = shape(i) enddo print "(a)",'> deleted shape: '//trim(labelshapetype(shape(ishape)%itype)) !--restore defaults shape(nshape)%itype = 0 shape(nshape)%icolour = 1 shape(nshape)%linestyle = 1 shape(nshape)%linewidth = 1 shape(nshape)%ifillstyle = 2 shape(nshape)%iunits = 1 shape(nshape)%iplotonpanel = 0 shape(nshape)%xpos = 0.5 shape(nshape)%ypos = 0.5 shape(nshape)%xlen = 1. shape(nshape)%ylen = 1. shape(nshape)%angle = 0. shape(nshape)%text = ' ' shape(nshape)%fjust = 0. nshape = nshape - 1 endif end subroutine delete_shape !------------------------------------------------------------ ! actual routine that implements plotting of various shapes !------------------------------------------------------------ subroutine plot_shapes(ipanel,irow,icolumn,itransx,itransy,time) use exactfunction, only:exact_function use transforms, only:transform_inverse,transform use asciiutils, only:string_replace use plotlib, only:plot_qci,plot_qls,plot_qlw,plot_qfs,plot_qwin,plot_sci,plot_sfs,plot_slw, & plot_sci,plot_rect,plot_sls,plot_line,plot_arro,plot_circ,plot_ptxt,plot_numb,& plotlib_supports_alpha,plot_set_opacity implicit none integer, intent(in) :: ipanel,irow,icolumn,itransx,itransy real, intent(in) :: time integer :: icolourprev,linestyleprev,linewidthprev,ifillstyle integer :: i,j,ierr,iplotonthispanel,ndec,nc integer, parameter :: maxfuncpts = 1000 real :: xmin,xmax,ymin,ymax,dxplot,dyplot real :: xpos,ypos,xlen,ylen,anglerad,dx,dy,fjust real, dimension(2) :: xline,yline real, dimension(maxfuncpts) :: xfunc,yfunc character(len=lentext) :: text character(len=30) :: string ! !--store current settings ! call plot_qci(icolourprev) call plot_qls(linestyleprev) call plot_qlw(linewidthprev) call plot_qfs(ifillstyle) ! !--convert hpos and vpos to x, y to plot arrow ! call plot_qwin(xmin,xmax,ymin,ymax) dxplot = xmax - xmin dyplot = ymax - ymin ! !--query window size in a variety of other units ! do i=1,nshapes iplotonthispanel = shape(i)%iplotonpanel if (iplotonthispanel.eq.0 & .or.(iplotonthispanel.gt.0 .and. ipanel.eq.iplotonthispanel) & .or.(iplotonthispanel.eq.-1 .and. irow.eq.1) & .or.(iplotonthispanel.eq.-2 .and. icolumn.eq.1)) then call plot_sci(shape(i)%icolour) call plot_sls(shape(i)%linestyle) call plot_slw(shape(i)%linewidth) call plot_sfs(shape(i)%ifillstyle) if (plotlib_supports_alpha) call plot_set_opacity(shape(i)%opacity) anglerad = shape(i)%angle*(pi/180.) call convert_units(shape(i),xpos,ypos,xlen,ylen, & xmin,ymin,dxplot,dyplot,itransx,itransy) !call print_shapeinfo(i,shape(i)%itype,shape(i)) !print "(a)",'> plotting shape: '//trim(labelshapetype(shape(i)%itype)) select case(shape(i)%itype) case(1,2) ! square, rectangle if (xlen.gt.dxplot .or. ylen.gt.dyplot) then print "(2x,a)",'Error: shape size exceeds plot dimensions: not plotted' else call plot_rect(xpos-0.5*xlen,xpos+0.5*xlen,ypos-0.5*ylen,ypos + 0.5*ylen) endif case(3) ! arrow dx = xlen*cos(anglerad) dy = xlen*sin(anglerad) !--do not plot if length > size of plot if (dx.gt.dxplot .or. dy.gt.dyplot) then print "(2x,a)",'Error: arrow length exceeds plot dimensions: arrow not plotted' else fjust = shape(i)%fjust call plot_arro(xpos-fjust*dx,ypos-fjust*dy,xpos+(1.-fjust)*dx,ypos+(1.-fjust)*dy) endif case(4) ! circle if (xlen.gt.dxplot .or. xlen.gt.dyplot) then print "(2x,a)",'Error: circle radius exceeds plot dimensions: circle not plotted' else call plot_circ(xpos,ypos,xlen) endif case(5) ! line xline(1) = xpos yline(1) = ypos xline(2) = xpos + xlen*cos(anglerad) yline(2) = ypos + xlen*sin(anglerad) call plot_line(2,xline,yline) case(6) ! text text = trim(shape(i)%text) !--handle special characters in text strings (e.g. replace %t with time) if (index(text,'%t').ne.0) then ndec = 3 call plot_numb(nint(time/10.**(int(log10(time)-ndec))),int(log10(time)-ndec),1,string,nc) call string_replace(text,'%t',string(1:nc)) endif call plot_ptxt(xpos,ypos,shape(i)%angle,shape(i)%fjust,trim(text)) case(7) ! arbitrary function !--set x to be evenly spaced in transformed (plot) coordinates dx = (xmax-xmin)/real(maxfuncpts - 1) do j=1,maxfuncpts xfunc(j) = xmin + (j-1)*dx enddo !--transform x array back to untransformed space to evaluate f(x) if (itransx.gt.0) call transform_inverse(xfunc,itransx) call exact_function(shape(i)%text,xfunc,yfunc,0.,ierr) if (ierr.eq.0) then !--reset x values do j=1,maxfuncpts xfunc(j) = xmin + (j-1)*dx enddo !--transform y if necessary if (itransy.gt.0) call transform(yfunc,itransy) !--plot the line call plot_line(maxfuncpts,xfunc,yfunc) endif end select endif enddo call plot_sci(icolourprev) call plot_sls(linestyleprev) call plot_slw(linewidthprev) call plot_sfs(ifillstyle) if (plotlib_supports_alpha) call plot_set_opacity(1.0) end subroutine plot_shapes !------------------------------------------------------------ ! query function asking whether or not a point falls within ! a shape object !------------------------------------------------------------ integer function inshape(xpt,ypt,itransx,itransy) use plotlib, only:plot_qwin,plot_qtxt implicit none real, intent(in) :: xpt,ypt integer, intent(in) :: itransx,itransy integer :: i real :: xpos,ypos,xlen,ylen real :: xmin,ymin,xmax,ymax,dxplot,dyplot real, dimension(4) :: xbox,ybox call plot_qwin(xmin,xmax,ymin,ymax) dxplot = xmax - xmin dyplot = ymax - ymin inshape = 0 do i=1,nshapes call convert_units(shape(i),xpos,ypos,xlen,ylen, & xmin,ymin,dxplot,dyplot,itransx,itransy) select case(shape(i)%itype) case(1,2) ! square, rectangle case(3) ! arrow case(4) ! circle case(5) ! line case(6) ! text call plot_qtxt(xpos,ypos,shape(i)%angle,shape(i)%fjust,trim(shape(i)%text),xbox,ybox) if (xpt.gt.minval(xbox) .and. xpt.le.maxval(xbox) & .and. ypt.gt.minval(ybox) .and. ypt.le.maxval(ybox)) then inshape = i endif end select enddo end function inshape !--------------------------------------- ! routine to edit shapes interactively !--------------------------------------- subroutine edit_shape(i,xpt,ypt,itransx,itransy) use plotlib, only:plot_qwin implicit none integer, intent(in) :: i,itransx,itransy real, intent(in) :: xpt,ypt real :: xmin,xmax,ymin,ymax,dxplot,dyplot,xlen,ylen real :: xpos,ypos call plot_qwin(xmin,xmax,ymin,ymax) dxplot = xmax - xmin dyplot = ymax - ymin call convert_units(shape(i),xpos,ypos,xlen,ylen, & xmin,ymin,dxplot,dyplot,itransx,itransy) select case(shape(i)%itype) case(6) call edit_textbox(xpos,ypos,shape(i)%angle,shape(i)%text) case default end select end subroutine edit_shape !-------------------------------------------------------- ! utility routine to add a new text shape interactively !-------------------------------------------------------- subroutine add_textshape(xpt,ypt,itransx,itransy,ipanel,ierr) use plotlib, only:plot_qwin implicit none real, intent(in) :: xpt,ypt integer, intent(in) :: itransx,itransy,ipanel integer, intent(out) :: ierr integer :: i real :: xmin,xmax,ymin,ymax,xposi,yposi ierr = 0 nshapes = nshapes + 1 if (nshapes.gt.maxshapes) then print*,' *** cannot add shape: array limits reached, delete some shapes first ***' nshapes = maxshapes ierr = 1 return endif i = nshapes shape(i)%itype = 6 print*,' adding shape '//trim(labelshapetype(shape(i)%itype)) shape(i)%icolour = 1 shape(i)%linestyle = 1 shape(i)%linewidth = 1 shape(i)%ifillstyle = 2 shape(i)%iplotonpanel = ipanel ! !--position text relative to viewport ! shape(i)%iunits = 2 call plot_qwin(xmin,xmax,ymin,ymax) xposi = (xpt - xmin)/(xmax-xmin) yposi = (ypt - ymin)/(ymax-ymin) shape(i)%xpos = xposi shape(i)%ypos = yposi shape(i)%xlen = 1. shape(i)%ylen = 1. shape(i)%angle = 0. shape(i)%text = 'click to edit' shape(i)%fjust = 0. call edit_shape(i,xposi,yposi,itransx,itransy) end subroutine add_textshape !----------------------------------------------------------------- ! utility routine to convert between units used in shape plotting !----------------------------------------------------------------- subroutine convert_units(shape,xpos,ypos,xlen,ylen,xmin,ymin,dxplot,dyplot,itransx,itransy) use transforms, only:transform implicit none type(shapedef), intent(in) :: shape real, intent(out) :: xpos,ypos,xlen,ylen real, intent(in) :: xmin,ymin,dxplot,dyplot integer, intent(in) :: itransx,itransy xpos = shape%xpos ypos = shape%ypos xlen = shape%xlen ylen = shape%ylen select case(shape%iunits) case(2) ! translate from viewport coordinates into plot coordinates xpos = xmin + xpos*dxplot ypos = ymin + ypos*dyplot xlen = xlen*dxplot ylen = ylen*dyplot case(1) if (itransx.gt.0) then call transform(xpos,itransx) call transform(xlen,itransx) endif if (itransy.gt.0) then call transform(ypos,itransy) call transform(ylen,itransy) endif ! do nothing here case default ! should never happen print "(a)",' INTERNAL ERROR: unknown units whilst plotting shape' end select end subroutine convert_units !-------------------------------------------------------- ! utility routine to edit a text object interactively !-------------------------------------------------------- subroutine edit_textbox(xpt,ypt,angle,string) use plotlib, only:plot_stbg,plot_ptxt,plot_curs implicit none real, intent(in) :: xpt,ypt,angle character(len=1) :: mychar real :: xpt2,ypt2 character(len=*), intent(inout) :: string character(len=len(string)) :: oldstring integer :: i,ierr print*,'editing text box, esc or ctrl-c to quit' call plot_stbg(0) mychar = ' ' oldstring = string i = max(len_trim(string)+1,1) call plot_ptxt(xpt,ypt,angle,0.,string(1:i)//'_') xpt2 = xpt ypt2 = ypt ierr = plot_curs(xpt2,ypt2,mychar) do while (mychar.ne.achar(13) & ! carriage return .and. mychar.ne.achar(27) & ! ctrl-c .and. mychar.ne.achar(3)) ! esc if (mychar.eq.achar(8)) then ! backspace i = max(i - 1,1) string(i:i) = '_' call plot_ptxt(xpt,ypt,angle,0.,string(1:i)) string(i:i) = ' ' else if (trim(string).eq.'click to edit') then !print*,'erasing string' string = ' ' i = 1 endif string(i:i) = mychar call plot_ptxt(xpt,ypt,angle,0.,string(1:i)) i = min(i + 1,len(string)) if (i.eq.len(string)) print*,' reached end of string' endif ierr = plot_curs(xpt2,ypt2,mychar) enddo !--if ctrl-c or esc, restore original string if (mychar.eq.achar(3) .or. mychar.eq.achar(27)) then string = oldstring print*,'cancelled' else print*,'done: text = "'//trim(string)//'"' endif call plot_stbg(-1) end subroutine edit_textbox end module shapes splash/src/sort.f90000644 000770 000000 00000006446 12234042611 015053 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module sort implicit none public :: indexx private contains subroutine indexx(n, arr, indx) !************************************************************ ! * ! This is INDEXX using the quicksort algorithm. * ! * !************************************************************ implicit none integer, parameter :: m=7, nstack=500 integer, intent(in) :: n real, dimension(n), intent(in) :: arr integer, dimension(n), intent(out) :: indx integer :: i,j,k,l,ir,jstack,indxt,itemp integer, dimension(nstack) :: istack real :: a do j = 1, n indx(j) = j enddo jstack = 0 l = 1 ir = n 1 if (ir - l.lt.m) then do j = l + 1, ir indxt = indx(j) a = arr(indxt) do i = j - 1, 1, -1 if (arr(indx(i)).le.a) goto 2 indx(i + 1) = indx(i) end do i = 0 2 indx(i + 1) = indxt end do if (jstack.eq.0) return ir = istack(jstack) l = istack(jstack - 1) jstack = jstack - 2 else k = (l + ir)/2 itemp = indx(k) indx(k) = indx(l + 1) indx(l + 1) = itemp if (arr(indx(l + 1)).gt.arr(indx(ir))) then itemp = indx(l + 1) indx(l + 1) = indx(ir) indx(ir) = itemp endif if (arr(indx(l)).gt.arr(indx(ir))) then itemp = indx(l) indx(l) = indx(ir) indx(ir) = itemp endif if (arr(indx(l + 1)).gt.arr(indx(l))) then itemp = indx(l + 1) indx(l + 1) = indx(l) indx(l) = itemp endif i = l + 1 j = ir indxt = indx(l) a = arr(indxt) 3 continue i = i + 1 if (arr(indx(i)).lt.a) goto 3 4 continue j = j - 1 if (arr(indx(j)).gt.a) goto 4 if (j.lt.i) goto 5 itemp = indx(i) indx(i) = indx(j) indx(j) = itemp goto 3 5 indx(l) = indx(j) indx(j) = indxt jstack = jstack + 2 if (jstack.gt.nstack) then print*,'fatal error!!! stacksize exceeded in sort' print*,'(need to set parameter nstack higher in subroutine indexx ' print*,' this is in the file sort.f90)' stop endif if (ir - i + 1.ge.j - l) then istack(jstack) = ir istack(jstack - 1) = i ir = j - 1 else istack(jstack) = j - 1 istack(jstack - 1) = l l = i endif endif goto 1 end subroutine indexx end module sort splash/src/splash.f90000644 000770 000000 00000105175 12612005773 015365 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! ! The plotting API for SPLASH 2.0 was written by James Wetter ! wetter.j@gmail.com ! !----------------------------------------------------------------- program splash !--------------------------------------------------------------------------------- ! ! SPLASH - a plotting utility for SPH data in 1, 2 and 3 dimensions ! Copyright (C) 2005-2015 Daniel Price ! daniel.price@monash.edu ! ! -------------------------------------------------------------------------- ! ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or ! (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ! ! ------------------------------------------------------------------------- ! Version history/ Changelog: ! 2.6.0 : (22/10/15) ! SILO, falcON and .pbob data reads implemented; bug fixes in gadget-hdf5 reader; ! can recognise particle types in ascii read; more robust sphNG read; ! dust fraction recognised in phantom data read; Toomre Q works in physical units; ! bug fix with disappearing units labels; bug fix in shock tube exact solution; ! added splash calc delta; splash to ascii keeps precision; better power spectra ! 2.5.1 : (29/01/15) ! error bar style options; support for 5K displays; can plot vectors ! and render with colours if h not read; range restrictions apply during splash to grid; ! improved line-style legend; now up to 6 line styles; fixes to amuse-hdf5 read; ! phantom read handles star/dm particles; various bugs fixed ! 2.5.0 : (22/08/14) ! instant multiplots by giving multiple columns as y axis; ! ability to plot multiple exact solution files on same plot; ! compiles in parallel by default; support for tagged sphNG/Phantom format; ! AMUSE hdf5 format reader added; various bug fixes ! 2.4.1 : (01/04/14) ! Roche-lobe plotting vastly improved; newunit= issue fixed; ! bug fix with reading sink velocities from Phantom; other minor bug fixes. ! 2.4.0 : (21/02/14) ! time formatting in legend can include general functions like %(t + 1000); ! option to include sinks in opacity rendering; ! supports one-fluid dust visualisation; ! C-shock exact solution; better polytrope solution ! 2.3.1 : (11/11/13) ! SPLASH_COROTATE option to plot in frame corotating with sinks; ! bug fixes with handling of dead/accreted/boundary particles in sphNG/phantom; ! various other bugs fixed. ! 2.3.0 : (09/08/13) ! can customise time formatting in legend; improvements to legends; ! less verboseness; splash can read and plot pixel maps produced with -o ascii; ! 3D vector field plotting improved; bug fix with gfortran 4.8 ! 2.2.2 : (10/05/13) ! particle tracking by type implemented; ! can interpolate specific columns in splash to grid; ! SPLASH_CENTRE_ON_SINK option generic to all data reads; ! Aly Reheam format added; option for 2nd y axis on plots; ! bug fix with X11 linking on Ubuntu; can read gadget ICs files ! 2.2.1 : (21/02/13) ! minor bug with axes plotting fixed; ! Wendland kernels added; bugs with exact solution plotting fixed; ! bug fix with tracking of dark matter particles ! 2.2.0 : (16/11/12) ! option to use different kernels for interpolation; ! floating/inset colour bars added; ! splash to gadget conversion implemented; ! splash to grid works in 2D; ! improved interfaces to shapes and animation sequences ! automatically turns on dark matter particle plotting if no gas ! interactive mode help displayed automatically ! 2.1.1 : (31/08/12) ! irregular/circular particle selection using shift-left/middle click; ! improved h5part and GADGET HDF5 data reads; ! splash can be compiled in double precision; ! bug fixes with calculated quantities + change of coordinate systems; ! improved vector plot legend; option for box+numbers but no labels added ! 2.1.0 : (16/05/12) ! 3D vector field visualisation added; ! GADGET HDF5 read implemented; ! page sizes can be specified in pixels; ! limits can auto-adapt to device aspect ratio; ! more general exact solution from file option; ! tiling works with one colour bar per row; ! splash calc handles different particle types ! 2.0 : (29/08/11) ! new giza backend - antialiased lines; real fonts; pdf, eps and svg drivers; ! fewer build dependencies (only cairo, X11); ! support for semi-transparent text; ! Double rendering (with transparent background) implemented. ! 1.15.0 : (29/08/11) ! Multiplot with different particle types implemented; calculated quantities ! list is now pre-filled automatically; preliminary support for r-phi and r-z ! rendering; outlined solid markers implemented; better handling of multiple types; ! manual contour levels can be specified in splash.contours; parallel splash to grid; ! better support for non-square pixels; clipping of numbers at edge of viewport fixed ! 1.14.1 : (17/03/11) ! SEREN data read added; dragon read updated; build follows Gnu conventions ! on DEST and DESTDIR (needed for macports build); can have up to 12 particle types; ! exact solutions re-ordered; dusty wave exact solution added ! 1.14.0 : (06/12/10) ! Can flip between rendered quantities in interactive mode using 'f/F'; ! SPLASH_DEFAULTS variable can be set for system-wide defaults; ! can plot arbitrary functions of x,t as exact solution; asplash better ! handles blank lines in header and can specify time, gamma location with ! env. variables; added data read for the H5PART format; GADGET read ! across multiple files implemented; VINE read works with particle injection; ! error bars can be plotted for both x and y axis simultaneously; ! default rotation angles are set if 3D perspective turned on; ! new directory layout and more helpful error messages during build; ! PGPLOT linking is easier to get right. ! 1.13.1 : (26/02/10) ! bugs with new calc_quantities module fixed; generic library interface ! implemented so backend can be changed easily; bug fix with auto pixel selection; ! simpler foreground/background colour setting; added subgrid interpolation warning ! 1.13.0 : (25/02/10) ! function parser incorporated; calculated quantities can now be specified ! at runtime, arbitrary function plotting implemented as an exact ! solution; command-line SPH->grid conversion ("splash to grid") ! implemented; ctrl-t in interactive mode adds arbitrary text box; ! better line style/colour changing; bug fix with tiling and y-axis labels; ! various other bug fixes. ! 1.12.2 : (15/07/09) ! Variable marker sizes added, can plot particles as circles with ! size proportional to h; dark matter rendering with block-labelled ! GADGET format fixed; VINE read handles star particles; TIPSY read ! with ifort10.0.0 works; snsph read added; splash to phantom added; ! does not override labels for coords, vectors by default; bug fixes ! with contouring options; stability bug fixes with older compilers; ! more robust memory handling; bug fix with automatic pixel selection ! causing seg fault. ! 1.12.1 : (20/04/09) ! Can edit/delete text shapes interactively, also the colour bar label; can customise ! the label on projection plots; contour levels better defined; SPLASH_HMIN_CODEUNITS added; ! option for numeric labelling of contours; contour limits can be set separately ! to render limits for same quantity; minor bug fixes. ! 1.12.0 : (22/12/08) ! Command-line plotting implemented; ln transform added; bug fixes in GADGET read; ! Backspace over annotation (legends,titles,axes,colour bar) in interactive mode ! removes it; "splash calc" command line utility calculates time sequences of ! global quantities from a sequence of dump files; bug fix causing seg fault. ! 1.11.1 : (13/10/08) ! automatic number of pixels and exact pixel boundaries implemented; ! mass does not have to be read from dump file; frame changes are per-page ! not per-dump file for animation sequences; lower stacksize footprint; ! bug fix with circles of interaction; bug fixes with block-labelled GADGET read; ! Steve Foulkes data read added. ! 1.11.0 : (15/08/08) ! ability to use subset of particles in restricted parameter range(s); ! probability density function plot option; plot-hugging colour bars added; ! ability to annotate plot with a range of shapes; v,V,w and H implemented ! in interactive mode for >1 panel; various bug fixes (including one with vphi). ! 1.10.2 : (08/05/08) ! disc surface density / toomre q parameter plotting added; flash colour ! schemes added; splash to binary convert option, can change order in ! which particle types are plotted; splash.columns file overrides ! column label settings; vanaverbeke format read; various bug fixes. ! 1.10.1 : (11/03/08) ! "splash to" command line option converts binary dumps to ascii format; ! vector plots + rotation now implemented; block labelled GADGET format read; ! ring-spreading exact solution added. ! 1.10.0 : (28/11/07) ! horizontal colour bars implemented; -p, -o command line options; ! can have mixed types in data reads; TIPSY and DRAGON data reads; ! density weighted rendering; normalisation applies to column ! density plots; improved particle tracking; save as option; various bug fixes ! 1.9.2 : (12/09/07) ! improvements to ascii read including asplash -e option; ! smarter foreground/background colour changing for titles; ! min=max problem fixed (caught by splash not pgplot); ! fixed vector arrow length option; other minor changes and bug fixes ! 1.9.1 : (11/07/07) ! environment variables + improvements to gadget data read; better ! prompting; 3 new colour schemes; improved legend/title options; ! other minor changes ! 1.9.0 : (21/05/07) ! animation sequences implemented; origin settings now affect radius ! calculation and are relative to tracked particle; automatic line ! width choice for postscript devices; w key adapts vector arrows; ! vastly improved userguide ! 1.8.1 : (28/03/07) ! option to hide vector arrows where there are no particles added; ! smoother 3D plotting at low pixel numbers; ! (smoother vector plots); bug fixes with a); issues with ! round-off error with z integration of vectors fixed. ! 1.8.0 : (14/03/07) ! hidden particles not used in rendering; units for z integration added; ! a) & g) implemented in interactive mode for multiple-plots-per-page; ! improved cross section using x in interactive mode ! 1.7.2 : (19/02/07) ! Menu shortcuts implemented; bug fix/ more sensible transformation ! of angular vector components in different co-ordinate systems; ! improvements to interactive zoom and origin recentreing; ! improved colour-by-type option; restrictions on page size removed; ! minor bug fixes ! 1.7.1 : (04/01/07) ! command line options for defaults and limits files added; ! minor bug fixes ! 1.7.0 : (13/12/06) ! renamed SPLASH instead of SUPERSPHPLOT; much faster data read ! for gadget and sphNG reads (only required columns read); ! physical units can be saved to file; new menu formats; various ! other bug fixes. ! 1.6.2 (24/10/06) ! : fast particle plotting and streamline plotting implemented; ! more bug fixes with interactive mode on multiplots; various other bug fixes. ! 1.6.1 (24/8/06) ! : bug fixes to 1.6.0, further improvements to interactive mode on multiplots. ! 1.6.0 (10/8/06) ! : Interactive mode on multiple plots per page; highly optimised interpolation ! + parallel version; new Makefile; various bug fixes ! 1.5.4 (06/7/06) ! : Handles multiple SPH/non-SPH particle types; axes redrawn after rendering; ! minor bug fixes ! 1.5.3 (27/6/06) ! : minor bug fixes/improvements to multiple plots per page, colour bar labelling ! tiled plots, legend. Accelerated rendering option for projections. ! 1.5.2 (11/5/06) ! : S) option for saving limits and defaults; MUCH faster interactive ! replotting (no unnecessary re-rendering), a few other minor things ! 1.5.1 (26/4/06) ! : docs updated for v1.5, other minor changes ! 1.5.0 (17/3/06) ! : 3D perspective added, 3D opacity rendering, improved rotation, ! colour schemes, adjustable vector arrows (+legend), improved timestepping ! behaviour, speed enhancements, physical unit rescaling ! 1.0.5 (28/9/05) ! : error calculation for exact solutions, legend for plot markers, ! exact_densityprofiles added, more colour schemes, ! unit rescaling improved, other minor changes + bug fixes ! 1.0.4 (17/8/05) ! : better colour schemes; interactive colour scheme changing; ! various minor changes and bug fixes ! 1.0.3 (5/7/05) ! : rescale data option; better page setup; improved zooming; ! interactive particle tracking + various minor changes and bug fixes ! 1.0.2 : much improved ascii data read; better line plotting; zoom on ! powerspectrum plots + various bug fixes ! 1.0.1 : bug fixes relating to colour bars on multiplots ! 1.0 : first "official" release: version given to many people at IPAM ! meeting and put on web. ! ! ------------------------------------------------------------------------- ! ! Modules/subroutines as follows (in alphabetical order): ! ! allocate : allocates memory for main arrays ! calc_quantities : calculates additional quantities from particle data ! colours : colour schemes for rendering ! colourparts : colours particles ! defaults : writes/reads default options to/from file ! exact : module handling exact solution settings ! exact_fromfile : reads an exact solution tabulated in a file ! exact_mhdshock : some tabulated solutions for mhd shocks ! exact_polytrope : exact solution for a polytrope ! exact_rhoh : exact relation between density and smoothing length ! exact_sedov : exact solution for sedov blast wave ! exact_shock : exact solution for hydrodynamic shocks ! exact_wave : exact solution for a propagating sine wave ! exact_toystar1D : exact solution for the 1D toy star problem ! exact_toystar2D : exact solution for the 2D toy star problem ! fieldlines : module handling streamline plotting ! get_data : wrapper for main data read ! geometry : module handling different coordinate systems ! globaldata : various modules containing "global" variables ! interactive : drives interactive mode ! interpolate1D : interpolation of 1D SPH data to grid using kernel ! interpolate2D : interpolation of 2D SPH data to grid ! interpolate3D_xsec : 3D cross section interpolations ! interpolate3D_projection : 3D interpolation integrated through domain ! legends : plots (time) legend on plot ! limits : sets initial plot limits and writes to/reads from limits file ! menu : main menu ! options_data : sets options relating to current data ! options_limits : sets options relating to plot limits ! options_page : sets options relating to page setup ! options_particleplots : sets options relating to particle plots ! options_powerspec : sets options for power spectrum plotting ! options_render : sets options for render plots ! options_vector : sets options for vector plots ! options_xsecrotate : sets options for cross sections and rotation ! particleplot : subroutines for particle plotting ! plotstep : main subroutines which drive plotting of a single timestep ! powerspectrums : calculates power spectrum of 1D data (2 methods) ! read_data_dansph : reads data from my format of data files ! read_data_mbate : reads data from matthew bate's format of data files ! render : takes array of pixels and plots render map/contours etc ! rotate : subroutines controlling rotation of particles ! setpage : sets up the PGPLOT page (replaces call to PGENV/PGLAB) ! splash : main program, drives menu loop ! timestepping : controls stepping through timesteps ! titles : reads a list of titles to be used to label each timestep ! transform : applies various transformations to data (log10, 1/x, etc) ! ! File format is specified in the subroutine read_data ! ! See the svn logs for a full ChangeLog ! ! Plots can be of two types: co-ordinate plots or not ! ! 1) Co-ordinate plots have co-ordinates as x and y axis ! these plots can be rendered with any scalar or vector array. ! ! The rendering routines interpolate from the particles to either ! a 2D or 3D grid. In 3D you can either render to a 3D grid and take ! cross sections, or render to a 2D grid using a table of the integrated ! SPH kernel. This 2D rendering results in a map of the quantity ! integrated through the third co-ordinate. ! Rendering to a full 3D grid can be quite slow - it is used only ! if many cross sections are taken all at once from the same data. ! ! 2) other plots have a variety of options, with lines joining the particles ! and various exact solutions. Plot limits can be fixed or adaptive. ! ! multiplot enables you to set up multiple plots per page, mixing from any type. ! !---------------------------------------------------------------------------------- use filenames, only:rootname,nfiles,maxfile,defaultsfile,limitsfile, & fileprefix,set_filenames use getdata, only:get_data use geomutils, only:set_coordlabels use defaults, only:defaults_set_initial,defaults_set,defaults_read use limits, only:read_limits use kernels, only:ikernel,select_kernel_by_name,select_kernel use mainmenu, only:menu,allowrendering,set_extracols use mem_allocation, only:deallocate_all use projections3D, only:setup_integratedkernel use settings_data, only:buffer_data,lowmemorymode,debugmode,ndim,ncolumns,ncalc,nextra,numplot,ndataplots use system_commands, only:get_number_arguments,get_argument,get_environment use system_utils, only:lenvironment use asciiutils, only:read_asciifile,basename use write_pixmap, only:isoutputformat,iwritepixmap,pixmapformat,isinputformat,ireadpixmap,readpixformat use convert, only:convert_all use write_sphdata, only:issphformat use readwrite_griddata, only:isgridformat,print_gridformats use analysis, only:isanalysis use timestepping, only:timestep_loop use settings_page, only:interactive,device,nomenu implicit none integer :: i,ierr,nargs,ipickx,ipicky,irender,icontour,ivecplot logical :: ihavereadfilenames,evsplash,doconvert,useall,iexist character(len=120) :: string character(len=12) :: convertformat character(len=*), parameter :: version = 'v2.6.0 [22nd Oct. 2015]' ! ! initialise some basic code variables ! call defaults_set_initial ! ! default names for defaults file and limits file ! fileprefix = 'splash' call set_filenames(trim(fileprefix)) evsplash = .false. lowmemorymode = lenvironment('SPLASH_LOW_MEM') .or. lenvironment('SPLASH_LOWMEM') debugmode = lenvironment('SPLASH_DEBUG') ! ! read all arguments off command line ! call get_number_arguments(nargs) ! ! extract command line arguments and filenames ! i = 0 nfiles = 0 iwritepixmap = .false. ireadpixmap = .false. doconvert = .false. useall = .false. nomenu = .false. ipickx = 0 ipicky = 0 irender = 0 icontour = 0 ivecplot = 0 do while (i < nargs) i = i + 1 call get_argument(i,string) if (string(1:1).eq.'-') then select case(trim(string(2:))) case('x') i = i + 1 call get_argument(i,string) read(string,*,iostat=ierr) ipickx if (ierr /= 0 .or. ipickx <= 0) call print_usage(quit=.true.) nomenu = .true. case('y') i = i + 1 call get_argument(i,string) read(string,*,iostat=ierr) ipicky if (ierr /= 0 .or. ipicky <= 0) call print_usage(quit=.true.) nomenu = .true. case('render','r','ren') i = i + 1 call get_argument(i,string) read(string,*,iostat=ierr) irender if (ierr /= 0 .or. irender < 0) call print_usage(quit=.true.) nomenu = .true. case('contour','c','cont','con') i = i + 1 call get_argument(i,string) read(string,*,iostat=ierr) icontour if (ierr /= 0 .or. icontour < 0) call print_usage(quit=.true.) case('vec','vecplot') i = i + 1 call get_argument(i,string) read(string,*,iostat=ierr) ivecplot if (ierr /= 0 .or. ivecplot < 0) call print_usage(quit=.true.) nomenu = .true. case('dev','device') i = i + 1 call get_argument(i,device) case('l') i = i + 1 call get_argument(i,limitsfile) case('d','f') i = i + 1 call get_argument(i,defaultsfile) case('p') i = i + 1 call get_argument(i,string) if (len_trim(string).gt.0) then fileprefix = trim(string) call set_filenames(trim(fileprefix)) endif case('o','writepix','wpix') i = i + 1 call get_argument(i,string) if (isoutputformat(string)) then iwritepixmap = .true. pixmapformat = trim(string) else stop endif case('readpix','rpix') i = i + 1 call get_argument(i,string) if (isinputformat(string)) then ireadpixmap = .true. readpixformat = trim(string) else stop endif case('e','ev') evsplash = .true. fileprefix = 'evsplash' call set_filenames(trim(fileprefix)) case('lowmem','lm') lowmemorymode = .true. case('nolowmem','nlm') lowmemorymode = .false. case('-help') call print_usage print "(/,a)",' Basic splash usage is explained in the userguide,' print "(a,/)",' located in the directory splash/docs/splash.pdf' stop case default call print_usage if (string(2:2).ne.'v') print "(a)",'unknown command line argument '''//trim(string)//'''' stop end select elseif (trim(string).eq.'to' .or. trim(string).eq.'allto') then ! !--for converting SPH formats ! if (trim(string).eq.'allto') useall = .true. i = i + 1 call get_argument(i,string) if (isgridformat(string)) then doconvert = .true. convertformat = trim(string) elseif (issphformat(string)) then doconvert = .true. convertformat = trim(string) else call print_gridformats() stop endif elseif (trim(string).eq.'calc') then ! !--for performing analysis on a sequence of dump files ! i = i + 1 call get_argument(i,string) if (isanalysis(string)) then doconvert = .true. convertformat = trim(string) else stop endif elseif (len_trim(string).gt.0) then nfiles = nfiles + 1 if (nfiles.le.maxfile) then rootname(nfiles) = trim(string) endif endif enddo ! ! print header ! call print_header ! ! set default options (used if defaults file does not exist) ! call defaults_set(evsplash) ! ! read default options from file if it exists ! call defaults_read(defaultsfile) ! ! look for a system-wide defaults file if the environment ! variable SPLASH_DEFAULTS is set, no local file is present ! and no alternative prefix has been set. ! inquire(file=defaultsfile,exist=iexist) if (.not.iexist .and. trim(fileprefix).eq.'splash') then call get_environment('SPLASH_DEFAULTS',string) if (len_trim(string).ne.0) then i = index(string,'.defaults') if (i.gt.0) then defaultsfile = trim(string) else defaultsfile = trim(string)//'.defaults' endif print "(a)",' Using SPLASH_DEFAULTS='//trim(defaultsfile) call defaults_read(defaultsfile) call set_filenames(trim(fileprefix)) endif endif ! ! check that we have got filenames ! if (nfiles.gt.0) then if (nfiles.gt.maxfile) then print*,' WARNING: number of files >= array size: setting nfiles = ',maxfile nfiles = maxfile endif endif if (nfiles.ge.1 .and. rootname(1)(1:1).ne.' ') then ihavereadfilenames = .true. if (nfiles.gt.1) print*,nfiles,' filenames read from command line' else ihavereadfilenames = .false. !print "(a)",' no filenames read from command line' call read_asciifile(trim(fileprefix)//'.filenames',nfiles,rootname) !print*,nfiles,' filenames read from '//trim(fileprefix)//'.filenames file' if (nfiles.gt.0) then ihavereadfilenames = .true. else call get_argument(0,string) print "(/,a/,/,5x,a)",' Usage: ',trim(basename(string))//' snap_0* (or use '& //trim(fileprefix)//'.filenames to list files)' print "(5x,a,/)",trim(basename(string))//' --help (for all command line options)' stop endif endif if (lowmemorymode) print "(a)",' << running in low memory mode >>' if (ikernel.eq.0) then !--if no kernel has been set call get_environment('SPLASH_KERNEL',string) if (len_trim(string).gt.0) then call select_kernel_by_name(string) else call select_kernel(0) endif else call select_kernel(ikernel) endif if (doconvert) then ! ! batch convert all dump files into the output format ! call convert_all(convertformat,ihavereadfilenames,useall) else ! ! read data from file ! if (buffer_data) then call get_data(-1,ihavereadfilenames) else call get_data(1,ihavereadfilenames,firsttime=.true.) endif ! ! setup kernel table for fast column density plots in 3D ! call setup_integratedkernel ! ! read plot limits from file (overrides get_data limits settings) ! call read_limits(trim(limitsfile),ierr) if (nomenu) then ! ! initialise the things we would need if we called menu directly ! call set_extracols(ncolumns,ncalc,nextra,numplot,ndataplots) call set_coordlabels(numplot) interactive = .false. ! ! check command line plot invocation ! if (ipicky.gt.0 .and. ipicky.le.numplot+1) then if (ipicky.le.numplot .and. (ipickx.eq.0 .or. ipickx.gt.numplot)) then print "(a)",' ERROR: x plot not set or out of bounds (use -x col)' stop endif if (irender.gt.0) then if (.not.allowrendering(ipicky,ipickx)) then print "(a)",' ERROR: cannot render with x, y choice (must be coords)' stop endif if (icontour.gt.numplot .or. icontour.lt.0) then print "(a)",' ERROR: contour plot choice out of bounds' stop endif elseif (icontour.gt.0) then print "(a)",' ERROR: -cont also requires -render setting' stop endif else if (irender.gt.0 .and. ndim.ge.2) then ipicky = 2 ipickx = 1 if (.not.allowrendering(ipicky,ipickx)) then print "(a)",' ERROR: cannot render' stop endif if (icontour.gt.numplot .or. icontour.lt.0) then print "(a)",' ERROR: contour plot choice out of bounds' stop endif else print "(a)",' ERROR: y plot not set or out of bounds (use -y col)' stop endif endif call timestep_loop(ipicky,ipickx,irender,icontour,ivecplot) ! ! if we invoked an interactive device, enter the menu as usual, otherwise finish ! if (interactive) call menu else ! ! enter main menu ! call menu endif endif ! ! deallocate all memory (not strictly necessary) ! call deallocate_all contains !------------------------------------------------------ ! this subroutine prints the splash screen on startup !------------------------------------------------------ subroutine print_header implicit none print 10 10 format( & " _ _ _ _ _ ",/, & " _(_) ___ _ __ | | __ _ ___| |__ (_) _ (_)",/, & " _ (_) _ / __| '_ \| |/ _` / __| '_ \ _ (_) ",/, & " (_) _ (_) \__ \ |_) | | (_| \__ \ | | | _ (_) _ ",/, & " (_) _ |___/ .__/|_|\__,_|___/_| |_| (_) _ (_) ",/, & " (_) (_)|_| (_) (_) (_)(_) (_)(_) (_)(_) ") print 20 20 format(/, & ' ( B | y ) ( D | a | n | i | e | l ) ( P | r | i | c | e )',/) print "(a)",' ( '//trim(version)//' Copyright (C) 2005-2015 )' print 30 30 format(/, & ' * SPLASH comes with ABSOLUTELY NO WARRANTY.',/, & ' This is free software; and you are welcome to redistribute it ',/, & ' under certain conditions (see LICENCE file for details). *',/,/, & ' Updates/userguide: http://users.monash.edu.au/~dprice/splash ',/, & ' Email: daniel.price@monash.edu or splash-users@googlegroups.com',/, & ' Please cite Price (2007), PASA, 24, 159-173 (arXiv:0709.0832) if you ',/, & ' use SPLASH in print and don''t forget to send pics for the gallery.',/) end subroutine print_header subroutine print_usage(quit) use filenames, only:tagline implicit none logical, intent(in), optional :: quit logical :: ltemp print "(a)",trim(tagline) print "(a,/)",trim(version) print "(a,/)",'Usage: splash file1 file2 file3...' print "(a,/,a,/)",'Usage with flags: splash [-p fileprefix] [-d defaultsfile] [-l limitsfile] [-ev] ', & '[-lowmem] [-o format] [-x col] [-y col] [-render col] [-cont col] file1 file2 ...' print "(a,/)",'Command line options:' print "(a)",' -p fileprefix : change prefix to ALL settings files read/written by splash ' print "(a)",' -d defaultsfile : change name of defaults file read/written by splash' print "(a)",' -l limitsfile : change name of limits file read/written by splash' print "(a)",' -e, -ev : use default options best suited to ascii evolution files (ie. energy vs time)' print "(a)",' -lm, -lowmem : use low memory mode [applies only to sphNG data read at present]' print "(a)",' -o pixformat : dump pixel map in specified format (use just -o for list of formats)' print "(/,a,/)",'Command line plotting mode:' print "(a)",' -x column : specify x plot on command line (ie. do not prompt for x)' print "(a)",' -y column : specify y plot on command line (ie. do not prompt for y)' print "(a)",' -r[ender] column : specify rendered quantity on command line (ie. no render prompt)' print "(a)",' (will take columns 1 and 2 as x and y if -x and/or -y not specified)' print "(a)",' -vec[tor] column : specify vector plot quantity on command line (ie. no vector prompt)' print "(a)",' -c[ontour] column : specify contoured quantity on command line (ie. no contour prompt)' print "(a)",' -dev device : specify plotting device on command line (ie. do not prompt)' print "(a)" ltemp = issphformat('none') call print_gridformats() print "(a)" ltemp = isanalysis('none') if (present(quit)) then if (quit) stop endif end subroutine print_usage end program splash splash/src/system_f2003.f90000644 000770 000000 00000003375 11622211702 016217 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- ! ! this module contains wrappers for all of the ! system and compiler dependent routines ! ! these are called from the main program by their generic names, ! and in here the actual call to the system is performed ! ! THIS ONE IS FOR FORTRAN 2003 COMPILERS ! module system_commands implicit none contains subroutine get_number_arguments(nargs) integer, intent(out) :: nargs nargs = COMMAND_ARGUMENT_COUNT() end subroutine get_number_arguments subroutine get_argument(iarg,argstring) integer, intent(in) :: iarg character(len=*), intent(out) :: argstring call GET_COMMAND_ARGUMENT(iarg,argstring) end subroutine get_argument subroutine get_environment(variable,value) character(len=*), intent(in) :: variable character(len=*), intent(out) :: value call GET_ENVIRONMENT_VARIABLE(variable,value) end subroutine get_environment end module system_commands splash/src/system_unix.f90000644 000770 000000 00000003336 11622211702 016445 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- ! ! this module contains wrappers for all of the ! system and compiler dependent routines ! ! these are called from the main program by their generic names, ! and in here the actual call to the system is performed ! ! THIS ONE IS FOR MANY UNIX COMPILERS ! module system_commands implicit none contains subroutine get_number_arguments(nargs) integer, intent(out) :: nargs integer :: iargc nargs = iargc() end subroutine get_number_arguments subroutine get_argument(iarg,argstring) integer, intent(in) :: iarg character(len=*), intent(out) :: argstring call getarg(iarg,argstring) end subroutine get_argument subroutine get_environment(variable,value) character(len=*), intent(in) :: variable character(len=*), intent(out) :: value call getenv(variable,value) end subroutine get_environment end module system_commands splash/src/system_unix_NAG.f90000644 000770 000000 00000003403 11622211702 017125 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- ! ! this module contains wrappers for all of the ! system and compiler dependent routines ! ! these are called from the main program by their generic names, ! and in here the actual call to the system is performed ! ! THIS VERSION IS FOR THE NAG f95 COMPILER ! module system_commands use f90_unix ! uncomment this for NAG f95 compiler implicit none contains subroutine get_number_arguments(nargs) integer, intent(out) :: nargs nargs = iargc() end subroutine get_number_arguments subroutine get_argument(iarg,argstring) integer, intent(in) :: iarg character(len=*), intent(out) :: argstring call getarg(iarg,argstring) end subroutine get_argument subroutine get_environment(variable,value) character(len=*), intent(in) :: variable character(len=*), intent(out) :: value call getenv(variable,value) end subroutine get_environment end module system_commands splash/src/system_utils.f90000644 000770 000000 00000012644 12113107723 016627 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- ! ! this module contains certain useful utilities which ! depend on system commands (in the system_commands module) ! module system_utils use system_commands, only:get_environment implicit none public :: ienvironment,lenvironment,renvironment,lenvstring,ienvstring contains ! !--this routine returns an integer variable ! from an environment variable setting ! ! if the errval argument is present then this is the ! value assigned when an error has occurred ! (default is zero) ! integer function ienvironment(variable,errval) implicit none character(len=*), intent(in) :: variable character(len=30) :: string integer, intent(in), optional :: errval call get_environment(variable,string) if (present(errval)) then ienvironment = ienvstring(string,errval) else ienvironment = ienvstring(string) endif end function ienvironment ! !--this routine returns a floating point (real) variable ! from an environment variable setting ! ! if the errval argument is present then this is the ! value assigned when an error has occurred ! (default is zero) ! real function renvironment(variable,errval) implicit none character(len=*), intent(in) :: variable character(len=30) :: string real, intent(in), optional :: errval integer :: ierr call get_environment(variable,string) if (len_trim(string).gt.0) then read(string,*,iostat=ierr) renvironment else ierr = 1 endif if (ierr /= 0) then if (present(errval)) then renvironment = errval else renvironment = 0. endif endif end function renvironment ! !--this routine returns a logical variable ! from an environment variable setting ! logical function lenvironment(variable) implicit none character(len=*), intent(in) :: variable character(len=30) :: string call get_environment(variable,string) lenvironment = lenvstring(string) end function lenvironment ! !--utility routine to determine whether a string ! should be interpreted as true or false ! logical function lenvstring(string) implicit none character(len=*), intent(in) :: string if (string(1:1).eq.'y'.or.string(1:1).eq.'Y' & .or.string(1:1).eq.'t'.or.string(1:1).eq.'T' & .or.trim(string).eq.'on'.or.trim(string).eq.'ON' & .or.trim(string).eq.'1') then lenvstring = .true. else lenvstring = .false. endif end function lenvstring integer function ienvstring(string,errval) implicit none character(len=*), intent(in) :: string integer, intent(in), optional :: errval character(len=5) :: fmtstring integer :: ierr if (len_trim(string).gt.0) then !--use a formatted read - this is to avoid a compiler bug ! should in general be more robust anyway write(fmtstring,"(a,i2,a)",iostat=ierr) '(i',len_trim(string),')' read(string,fmtstring,iostat=ierr) ienvstring else ierr = 1 endif if (ierr /= 0) then if (present(errval)) then ienvstring = errval else ienvstring = 0 endif endif end function ienvstring ! !--this routine returns an arbitrary number of ! comma separated strings ! subroutine envlist(variable,nlist,list) implicit none character(len=*), intent(in) :: variable integer, intent(out) :: nlist character(len=*), dimension(:), intent(out), optional :: list character(len=120) :: string character(len=10) :: dummy integer :: i1,i2,ierr logical :: notlistfull !--set list to blank strings if argument is present if (present(list)) then list = ' ' endif !--get envlist from the environment call get_environment(variable,string) !--split the string on commas i1 = 1 i2 = index(string,',')-1 if (i2.eq.-1) i2 = len_trim(string) nlist = 0 ierr = 0 notlistfull = .true. !--for each comma separated string, add a list member do while(i2.ge.i1 .and. notlistfull .and. ierr.eq.0) nlist = nlist + 1 !print*,'i1,i2,stringfrag= ',i1,i2,trim(string(i1:)) if (present(list)) then read(string(i1:i2),"(a)",iostat=ierr) list(nlist) notlistfull = (nlist.lt.size(list)) else read(string(i1:i2),"(a)",iostat=ierr) dummy ! to get ierr at end of string notlistfull = .true. endif i1 = i2 + 2 i2 = index(string(i1:),',') if (i2.eq.0) then i2 = len_trim(string) else i2 = i2 + i1 - 2 endif enddo return end subroutine envlist end module system_utils splash/src/timestepping.f90000644 000770 000000 00000032222 12612005773 016573 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- module timestepping implicit none public :: timestep_loop private contains ! ! This subroutine drives the main plotting loop ! subroutine timestep_loop(ipicky,ipickx,irender,icontourplot,ivecplot) use filenames, only:nsteps,ifileopen use particle_data, only:iamtype,npartoftype,masstype,time,gamma,dat,time_was_read use settings_data, only:istartatstep,iendatstep,nfreq,DataIsBuffered, & iUsesteplist,isteplist,ncolumns,ipartialread use settings_page, only:interactive,nstepsperpage,iColourEachStep,iChangeStyles,nomenu use timestep_plotting, only:initialise_plotting,plotstep use plotlib, only:plot_close implicit none integer, intent(in) :: ipicky,ipickx,irender,icontourplot,ivecplot integer :: ipos, istep, ilocindat, iadvance, istepsonpage, istepprev logical :: ipagechange call initialise_plotting(ipicky,ipickx,irender,icontourplot,ivecplot) !---------------------------------------------------------------------------- ! loop over timesteps (flexible to allow going forwards/backwards in ! interactive mode) ! ! bookkeeping is as follows: ! ipos : current step number or position in steplist array ! ilocindat : current or requested location in the dat array ! (usually 1, but can be > 1 if more than one step per file ! or data is buffered to memory) ! (requested location is sent to get_nextstep which skips files ! or steps appropriately and sets actual location) ! istep : current step number ! (as if all steps were in memory in sequential order) ! istepsonpage : number of steps which have been plotted on current page ! this is used because steps are coloured/marked differently ! from this routine (call to colour_timestep) ! !---------------------------------------------------------------------------- ipos = istartatstep iadvance = nfreq ! amount to increment timestep by (changed in interactive) istepsonpage = 0 istep = istartatstep istepprev = 0 !--if the current file has only been partially read, ! make sure we read the file again now that we may have different plotting options if (ipartialread) ifileopen = 0 over_timesteps: do while (ipos.le.iendatstep) ipos = max(ipos,1) !--can't go further back than ipos=1 if (iUseStepList) then istep = isteplist(ipos) if (istep.gt.nsteps) then print*,'ERROR: step > nsteps in step list, setting step = last' istep = nsteps elseif (istep.le.0) then !--this should never happen stop 'internal error: corrupted step list: please send bug report' endif else istep = ipos if (istep.ge.nsteps) then istep = nsteps iendatstep = istep ipos = min(ipos,iendatstep) endif endif ! !--make sure we have data for this timestep ! if (DataIsBuffered) then !--if data is in memory, we just go to the position in dat if (istep.gt.nsteps) then print*,'error: step # > nsteps, setting step = last' istep = nsteps endif ilocindat = istep else !--otherwise read file containing this step into memory and get position in dat array ! (note that nsteps can change in get_nextstep, so may need to re-evaluate ! whether we are on the last step or not, and adjust iendatstep to last step) ! call get_nextstep(istep,ilocindat) if (.not.iUseStepList .and. istep.ge.nsteps) then !--reset step position to last useable timestep (ie. nsteps) istep = nsteps iendatstep = istep !--use interactive halt at last step (ie. set position = last position) if (interactive) then ipos = min(ipos,iendatstep) !--if istep has changed, may need to re-read step ! (get_nextstep does nothing if istep is the same) call get_nextstep(istep,ilocindat) endif endif !--this is a general "catch all" when step cannot be located if (ilocindat.le.0) then print*,'ERROR: could not locate timestep' exit over_timesteps endif endif ! !--write timestepping log ! if (.not.time_was_read(time(ilocindat))) then print 32, istep elseif (time(ilocindat).lt.1.e-2 .or. time(ilocindat).gt.1.e2) then print 33, time(ilocindat),istep else print 34, time(ilocindat),istep endif 32 format (5('-'),' t = (not read), dump #',i5,1x,18('-')) 33 format (5('-'),' t = ',es9.2,', dump #',i5,1x,18('-')) 34 format (5('-'),' t = ',f8.2,', dump #',i5,1x,18('-')) istepsonpage = istepsonpage + 1 ! if ((nstepsperpage.gt.1 .and. istepsonpage > 1 .and. istepsonpage.le.nstepsperpage).or.nstepsperpage.eq.0) then if ((nstepsperpage.gt.1 .and. istepsonpage.le.nstepsperpage).or.nstepsperpage.eq.0) then ipagechange = .false. else istepsonpage = 1 ipagechange = .true. endif !--colour the timestep if appropriate if ((nstepsperpage.eq.0 .or. nstepsperpage.gt.1) .and. (iColourEachStep .or. iChangeStyles)) then call colour_timestep(istepsonpage,iColourEachStep,iChangeStyles) else !--otherwise set default colours for each particle type ! (do not call if repeating same step so interactive colours stick for same step) if (istep.ne.istepprev) call colourparts_default(npartoftype(:,ilocindat),iamtype(:,ilocindat)) istepprev = istep endif ! print*,'ipos = ',ipos,' istep = ',istep,' iposindat = ',ilocindat call plotstep(ipos,istep,istepsonpage,irender,icontourplot,ivecplot,iamtype(:,ilocindat), & npartoftype(:,ilocindat),masstype(:,ilocindat),dat(:,:,ilocindat), & time(ilocindat),gamma(ilocindat),ipagechange,iadvance) ! !--increment timestep -- iadvance can be changed interactively ! if (iadvance.eq.-666) exit over_timesteps ! this is the interactive quit signal ipos = ipos + iadvance ! if ipos goes over iendatstep, this ends the loop enddo over_timesteps if (.not.interactive) then if (nomenu) then !--gracefully exit print "(/,a,/)",'Finished plotting: Many thankyous for your kind custom.' else ! prepare to return to main menu print*,'press return to finish' read* !--if somehow the data has become corrupted (e.g. last file full of rubbish) ! read in the first dump again if (ncolumns.le.0) then print*,'data is corrupted: re-reading first data file' call get_nextstep(1,ilocindat) endif endif endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! call plot_close return end subroutine timestep_loop !------------------------------------------------------------------- ! works out whether or not we need to read another dump into memory !------------------------------------------------------------------- recursive subroutine get_nextstep(istep,iposinfile) use filenames, only:nstepsinfile,nfiles,ifileopen,nsteps use getdata, only:get_data implicit none integer, intent(in) :: istep integer, intent(out) :: iposinfile integer :: ifile,nstepstotal,nstepsprev ! !--request is for step istep ! need to determine which file step i is in, ! whether or not it is already in memory (and read it if not) ! and finally determine position of requested step in dat array ! ifile = 0 nstepstotal = 0 nstepsprev = 0 iposinfile = 1 ! this should always be overwritten anyway do while (nstepstotal.lt.istep .and. ifile.lt.nfiles) ifile = ifile + 1 nstepsprev = nstepstotal nstepstotal = nstepstotal + nstepsinfile(ifile) enddo if (nstepstotal.ge.istep) then !--set position in dat array depending on how many steps are in the file iposinfile = istep - nstepsprev else !--this is where we cannot locate the timestep in the data (not enough steps) ! ie. ifile > nfiles print*,'reached last useable timestep' iposinfile = 0 return endif ! print*,'step ',istep,' in file ',ifile,' nsteps = ',nsteps ! print*,'position in file = ',iposinfile if (istep.gt.nsteps) then iposinfile = 0 return endif ! !--if data is not stored in memory, read next step from file ! At the moment assumes number of steps in each file are the same ! !--neither or these two error conditions should occur if (ifile.gt.nfiles) then print*,'*** get_nextstep: error: ifile > nfiles' elseif (ifile.lt.1) then print*,'*** get_nextstep: error: request for file < 1' elseif (ifile.ne.ifileopen) then ! !--read next data file and determine position in file ! call get_data(ifile,.true.) ! !--because nstepsinfile is predicted for files which have ! not been opened, we may have the situation where ! iposinfile does not point to a real timestep (ie. iposinfile > nstepsinfile). ! In this case we query the step again with our better knowledge of nstepsinfile. ! if (iposinfile.gt.nstepsinfile(ifile)) then print*,'not enough steps in file... trying next file' call get_nextstep(istep,iposinfile) endif endif return end subroutine get_nextstep !------------------------------------------------------------- ! colours all the particles a given colour for this timestep ! and/or changes the marker type for type 1 particles !------------------------------------------------------------- subroutine colour_timestep(istep,iChangeColours,iChangeStyles) use particle_data, only:icolourme use settings_part, only:linecolourthisstep,linestylethisstep,imarktype use settings_page, only:maxlinestyle,modlinestyle,maxcolour,modcolour use plotlib, only:plotlib_maxlinestyle,plotlib_maxlinecolour implicit none integer, intent(in) :: istep logical, intent(in) :: iChangeColours, iChangeStyles integer :: icolour,imarkernumber if (iChangeColours) then if (allocated(icolourme)) then icolour = istep + 1 icolour = (icolour-2)/modcolour + 1 if (icolour.gt.plotlib_maxlinecolour) then print "(a,i2,a)",'warning: step colour > ',plotlib_maxlinecolour,': re-using colours' icolour = mod(icolour-1,plotlib_maxlinecolour) + 1 endif icolour = mod(icolour-1,min(maxcolour,plotlib_maxlinecolour)) + 1 icolourme = icolour linecolourthisstep = icolour else print "(a)",'***error: array not allocated in colour_timestep***' endif endif if (iChangeStyles) then !--modlinestyle should not be greater than max line styles in plotting library linestylethisstep = mod((istep-1)/modlinestyle,min(maxlinestyle,plotlib_maxlinestyle)) + 1 imarkernumber = istep select case(imarkernumber) case(1) imarktype(1) = 4 case(2) imarktype(1) = 17 case(3) imarktype(1) = 2 case(4) imarktype(1) = 3 case(5:16) imarktype(1) = imarkernumber case(17:) imarktype(1) = imarkernumber + 1 end select endif return end subroutine colour_timestep !--------------------------------------------------------------------------------------- ! colours all the particles using the default colour for their type !--------------------------------------------------------------------------------------- subroutine colourparts_default(npartoftype,iamtype) use params, only:int1 use settings_data, only:ntypes use particle_data, only:icolourme use settings_part, only:idefaultcolourtype implicit none integer, dimension(:), intent(in) :: npartoftype integer(kind=int1), dimension(:), intent(in) :: iamtype integer :: i,index1,index2,itype if (size(iamtype).gt.1) then do i=1,sum(npartoftype(1:ntypes)) itype = iamtype(i) if (itype.gt.0 .and. itype.le.ntypes) then if (idefaultcolourtype(itype).ge.0) then icolourme(i) = idefaultcolourtype(itype) endif endif enddo else index1 = 1 do itype=1,ntypes index2 = index1 + npartoftype(itype) - 1 if (idefaultcolourtype(itype).ge.0) then icolourme(index1:index2) = idefaultcolourtype(itype) endif index1 = index2 + 1 enddo endif end subroutine colourparts_default end module timestepping splash/src/timing.f90000644 000770 000000 00000010475 12156555263 015367 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !---------------------------------------------------------------- ! ! This module contains utilities for code timings ! !---------------------------------------------------------------- module timing implicit none integer, private :: istarttime(6) real, private :: starttime data starttime/-1./ public :: wall_time,print_time private contains !-------------------------------------------------------------------- !+ ! sets initial time !+ !-------------------------------------------------------------------- subroutine initialise_timing implicit none integer :: iday,imonth,iyear,ihour,imin,isec,imsec,ivalues(8) character(len=8) :: date character(len=5) :: zone character(len=10) :: time call date_and_time(date,time,zone,ivalues) iyear = ivalues(1) imonth = ivalues(2) iday = ivalues(3) ihour = ivalues(5) imin = ivalues(6) isec = ivalues(7) imsec = ivalues(8) istarttime(1) = iyear istarttime(2) = imonth istarttime(3) = iday istarttime(4) = ihour istarttime(5) = imin istarttime(6) = isec !istarttime(7) = imsec starttime = iday*86400. + ihour*3600. + imin*60. + isec + imsec*0.001 return end subroutine initialise_timing !-------------------------------------------------------------------- !+ ! Get time used since begining !+ !-------------------------------------------------------------------- subroutine wall_time(t) implicit none real, intent(out) :: t integer :: i,iday,imonth,ihour,imin,isec,imsec,ivalues(8) character(len=8) :: date character(len=5) :: zone character(len=10) :: time !--do self-initialisation the first time it is called if (starttime.lt.0.) call initialise_timing call date_and_time(date,time,zone,ivalues) iday = ivalues(3) ihour = ivalues(5) imin = ivalues(6) isec = ivalues(7) imsec = ivalues(8) if (ivalues(2).lt.istarttime(2)) then ivalues(2) = ivalues(2) + 12 endif do i = istarttime(2), ivalues(2) - 1 imonth = mod(i,12) if (imonth.eq.4 .or. imonth.eq.6 .or. imonth.eq.9 .or. imonth.eq.11) then iday = iday + 30 elseif (imonth.eq.2) then iday = iday + 28 else iday = iday + 31 endif end do t = iday*86400. + ihour*3600. + imin*60. + isec + imsec*0.001 - starttime return end subroutine wall_time !-------------------------------------------------------------------- ! ! print a time, nicely formatted into hours, mins, seconds ! !-------------------------------------------------------------------- subroutine print_time(time,string,iunit) implicit none real, intent(in) :: time character(len=*), intent(in), optional :: string integer, intent(in), optional :: iunit character(len=64) :: newstring integer :: nhr,nmin,lunit real :: trem trem = time nhr = int(trem/3600.) if (nhr.gt.0) trem = trem - nhr*3600. nmin = int(trem/60.) if (nmin.gt.0) trem = trem - nmin*60. if (present(string)) then newstring = trim(string(1:min(len(newstring),len_trim(string)))) else newstring = 'completed in' endif if (present(iunit)) then lunit = iunit else lunit = 6 endif if (nhr.gt.0) then write(lunit,"(1x,a,1x,i3,a,i2,a,f6.2,a)") & trim(newstring),nhr,' hr, ',nmin,' min, ',trem,' s' elseif (nmin.gt.0) then write(lunit,"(1x,a,1x,i2,a,f6.2,a)") & trim(newstring),nmin,' min, ',trem,' s' else write(lunit,"(1x,a,1x,f6.2,a)") trim(newstring),trem,' s' endif return end subroutine print_time end module timing splash/src/titles.f90000644 000770 000000 00000005372 11622211702 015364 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- module titles implicit none integer, parameter, private :: maxtitles = 50 integer, parameter, private :: maxsteplegend = 100 integer, parameter, public :: lensteplegend = 60 integer, parameter, public :: lenpagetitles = 60 character(len=lenpagetitles), dimension(maxtitles), public :: pagetitles character(len=lensteplegend), dimension(maxsteplegend), public :: steplegend public :: read_titles, read_steplegend private contains ! !--reads a list of titles (one per line), to be used to label each plot on page ! subroutine read_titles(ntitles) use asciiutils, only:read_asciifile use filenames, only:fileprefix implicit none integer, intent(out) :: ntitles character(len=50) :: titlefile logical :: iexist titlefile = trim(fileprefix)//'.titles' !--also allow obsolete title filename inquire(file=titlefile,exist=iexist) if (.not.iexist) then inquire(file='titlelist',exist=iexist) if (iexist) titlefile='titlelist' endif ntitles = 0 call read_asciifile(titlefile,ntitles,pagetitles) if (ntitles.gt.0) print "(a)",'read plot titles from file '//trim(titlefile) return end subroutine read_titles ! !--reads a list of labels (one per line) to be used in the timestep legend ! (ie. for multiple timesteps on same page) ! subroutine read_steplegend(nsteptitles) use asciiutils, only:read_asciifile use filenames, only:fileprefix implicit none integer, intent(out) :: nsteptitles character(len=50) :: legendfile logical :: iexist legendfile = trim(fileprefix)//'.legend' !--also allow obsolete legend filename inquire(file=legendfile,exist=iexist) if (.not.iexist) then inquire(file='legend',exist=iexist) if (iexist) legendfile='legend' endif nsteptitles = 0 call read_asciifile(legendfile,nsteptitles,steplegend) if (nsteptitles.gt.0) print "(a)"//'read legend text from file '''//trim(legendfile)//'''' return end subroutine read_steplegend end module titles splash/src/transform.f90000644 000770 000000 00000047553 11622211702 016102 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2009 Daniel Price. All rights reserved. ! Contact: daniel.price@sci.monash.edu.au ! !----------------------------------------------------------------- !------------------------------------------------------------------------ ! ! module containing subroutines for applying transformations to data ! prior to plotting. ! ! the transformations are: ! ! 1) log10(x) ! 2) |x| ! 3) 1/x ! 4) sqrt(x) ! 5) x^2 ! 6) ln(x) ! ! * combinations of transformations are done when the ! input number is > 10 (e.g. 321 means 1/x, then abs, then log10) ! ! subroutines contained within this module are the following: ! ! transform : applies transformation to a one dimensional array ! transform2 : applies the transformation to a two dimensional array ! transform_limits : transforms the plot limits appropriately ! transform_label : changes the plot label appropriately ! ! Written for use in supersphplot/splash by ! Daniel Price, Institute of Astronomy, Cambridge, UK 2002-2004 ! University of Exeter, UK 2004- ! dprice@astro.ex.ac.uk ! !------------------------------------------------------------------------ module transforms integer, parameter, public :: ntrans = 6 ! this is the number of different transformations real, parameter, private :: zerolog = 1.e-12 ! this is minimum set if xmin = 0 and log public :: transform,transform_inverse,trans public :: transform_limits,transform_limits_inverse,transform_label public :: convert_to_ln_fac public :: islogged private interface transform module procedure transform,transform_limits,transform2,transforma end interface transform !--function interface interface trans module procedure transformarray end interface trans interface transform_inverse module procedure transform_inverse,transform_limits_inverse,transforma_inverse end interface transform_inverse contains !------------------------------------------------------------------------ ! ! subroutine returns log, 1/x of a given array ! ! * can specify up to 9 individual operations to perform ! * combinations of transformations are done when the ! input number is > 10 (e.g. 321 means 1/x, then abs, then log10) ! !------------------------------------------------------------------------ subroutine transform(array,itrans,errval) implicit none integer, intent(in) :: itrans real, dimension(:), intent(inout) :: array real, intent(in), optional :: errval real, dimension(size(array)) :: arraytemp real :: errvali character(len=20) :: string integer :: i ! !--errval is the value to be set for errors ! (default is zero if not present) ! if (present(errval)) then errvali = errval else errvali = 0. endif ! !--extract the digits from the input number ! if (itrans.gt.0) then write(string,*) itrans ! !--do a transformation for each digit ! arraytemp = array do i=1,len_trim(string) ! !--perform transformation appropriate to this digit ! select case(string(i:i)) case('1') where (arraytemp > 0. .and. arraytemp.ne.errvali) arraytemp = log10(arraytemp) elsewhere arraytemp = errvali end where case('2') where (arraytemp.ne.errvali) arraytemp = abs(arraytemp) end where case('3') where (arraytemp .ne. 0. .and. arraytemp.ne.errvali) arraytemp = 1./arraytemp elsewhere arraytemp = errvali end where case('4') where (arraytemp .gt. 0. .and. arraytemp.ne.errvali) arraytemp = sqrt(arraytemp) elsewhere arraytemp = errvali end where case('5') where (arraytemp.ne.errvali) arraytemp = arraytemp**2 end where case('6') where (arraytemp > 0. .and. arraytemp.ne.errvali) arraytemp = log(arraytemp) elsewhere arraytemp = errvali end where end select enddo array = arraytemp endif end subroutine transform !------------------------------------------------------------------------ ! ! interface to above for a single real number ! !------------------------------------------------------------------------ subroutine transforma(aa,itrans,errval) implicit none integer, intent(in) :: itrans real, intent(inout) :: aa real, intent(in), optional :: errval real, dimension(1) :: array array(1) = aa if (present(errval)) then call transform(array,itrans,errval=errval) else call transform(array,itrans) endif aa = array(1) return end subroutine transforma !------------------------------------------------------------------------ ! ! function interface: returns array valued function ! !------------------------------------------------------------------------ function transformarray(array,itrans,errval) implicit none integer, intent(in) :: itrans real, intent(in), dimension(:) :: array real, dimension(size(array)) :: transformarray real, intent(in), optional :: errval transformarray = array if (present(errval)) then call transform(transformarray,itrans,errval=errval) else call transform(transformarray,itrans) endif return end function transformarray !------------------------------------------------------------------------ ! ! inverse transform ! !------------------------------------------------------------------------ subroutine transform_inverse(array,itrans,errval) implicit none integer, intent(in) :: itrans real, dimension(:), intent(inout) :: array real, intent(in), optional :: errval real, dimension(size(array)) :: arraytemp real :: errvali character(len=20) :: string integer :: i ! !--errval is the value to be set for errors ! (default is zero if not present) ! if (present(errval)) then errvali = errval else errvali = 0. endif ! !--extract the digits from the input number ! if (itrans.gt.0) then write(string,*) itrans ! !--do a transformation for each digit ! arraytemp = array do i=len_trim(string),1,-1 ! !--perform transformation appropriate to this digit ! select case(string(i:i)) case('1') where (arraytemp.ne.errvali) arraytemp = 10**arraytemp end where case('3') where (arraytemp .ne. 0. .and. arraytemp.ne.errvali) arraytemp = 1./arraytemp elsewhere arraytemp = errvali end where case('4') where (arraytemp.ne.errvali) arraytemp = arraytemp**2 end where case('5') where (arraytemp .gt. 0. .and. arraytemp.ne.errvali) arraytemp = sqrt(arraytemp) elsewhere arraytemp = errvali end where case('6') where (arraytemp.ne.errvali) arraytemp = exp(arraytemp) end where end select enddo array = arraytemp endif end subroutine transform_inverse !------------------------------------------------------------------------ ! ! interface to above for a single real number ! !------------------------------------------------------------------------ subroutine transforma_inverse(aa,itrans,errval) implicit none integer, intent(in) :: itrans real, intent(inout) :: aa real, intent(in), optional :: errval real, dimension(1) :: array array(1) = aa if (present(errval)) then call transform_inverse(array,itrans,errval=errval) else call transform_inverse(array,itrans) endif aa = array(1) return end subroutine transforma_inverse !------------------------------------------------------------------------ ! ! same as transform but for a two dimensional array ! applies the transformation to the same array as was input ! !------------------------------------------------------------------------ subroutine transform2(array,itrans,errval) implicit none integer, intent(in) :: itrans real, dimension(:,:), intent(inout) :: array real, intent(in), optional :: errval real, dimension(size(array(:,1)),size(array(1,:))) :: arraytemp real :: errvali character(len=20) :: string integer :: i ! !--errval is the value to be set for errors ! (default is zero if not present) ! if (present(errval)) then errvali = errval else errvali = 0. endif ! !--extract the digits from the input number ! if (itrans.gt.0) then write(string,*) itrans ! !--do a transformation for each digit ! arraytemp = array do i=1,len_trim(string) ! !--perform transformation appropriate to this digit ! select case(string(i:i)) case('1') where (arraytemp > 0. .and. arraytemp.ne.errvali) arraytemp = log10(arraytemp) elsewhere arraytemp = errvali end where case('2') where (arraytemp.ne.errvali) arraytemp = abs(arraytemp) end where case('3') where (arraytemp .ne. 0. .and. arraytemp.ne.errvali) arraytemp = 1./arraytemp elsewhere arraytemp = errvali end where case('4') where (arraytemp .gt. 0. .and. arraytemp.ne.errvali) arraytemp = sqrt(arraytemp) elsewhere arraytemp = errvali end where case('5') where (arraytemp.ne.errvali) arraytemp = arraytemp**2 end where case('6') where (arraytemp > 0. .and. arraytemp.ne.errvali) arraytemp = log(arraytemp) elsewhere arraytemp = errvali end where end select enddo array = arraytemp endif end subroutine transform2 !------------------------------------------------------------------------ ! ! same as transform but for the plot limits ! (min can become max and vice versa) ! !------------------------------------------------------------------------ subroutine transform_limits(xmin,xmax,itrans) implicit none integer, intent(in) :: itrans real, intent(inout) :: xmin,xmax real :: xmintemp,xmaxtemp character(len=20) :: string integer :: i ! !--extract the digits from the input number ! if (itrans.gt.0) then write(string,*) itrans ! !--do a transformation for each digit ! xmintemp = xmin xmaxtemp = xmax do i=1,len_trim(string) ! !--perform transformation appropriate to this digit ! select case(string(i:i)) case('1') if (xmintemp > 0) then xmintemp = log10(xmintemp) elseif (xmintemp.eq.0) then print*,' log10(xmin = 0): min set to ',zerolog xmintemp = log10(zerolog) endif if (xmaxtemp > 0) then xmaxtemp = log10(xmaxtemp) elseif (xmaxtemp.eq.0) then print*,' log10(xmax = 0): max set to ',zerolog xmaxtemp = log10(zerolog) endif case('2') if ((xmintemp.lt.0. .and. xmaxtemp.gt.0.) & .or.(xmaxtemp.lt.0. .and. xmintemp.gt.0.)) then ! !--minimum is zero if limits have opposite signs ! xmaxtemp = max(abs(xmintemp),abs(xmaxtemp)) xmintemp = 0. else ! !--or just take magnitude ! xmintemp = abs(xmintemp) xmaxtemp = abs(xmaxtemp) endif case('3') if (xmintemp .ne. 0) then xmintemp = 1./xmintemp else xmintemp = 0. endif if (xmaxtemp .ne. 0) then xmaxtemp = 1./xmaxtemp else xmaxtemp = 0. endif case('4') if (xmintemp .ge. 0) then xmintemp = sqrt(xmintemp) else xmintemp = 0. endif if (xmaxtemp .ge. 0) then xmaxtemp = sqrt(xmaxtemp) else xmaxtemp = 0. endif case('5') xmintemp = xmintemp**2 xmaxtemp = xmaxtemp**2 case('6') if (xmintemp > 0) then xmintemp = log(xmintemp) elseif (xmintemp.eq.0) then print*,' ln(xmin = 0): min set to ',zerolog xmintemp = log(zerolog) endif if (xmaxtemp > 0) then xmaxtemp = log(xmaxtemp) elseif (xmaxtemp.eq.0) then print*,' ln(xmax = 0): max set to ',zerolog xmaxtemp = log(zerolog) endif end select enddo xmin = min(xmintemp,xmaxtemp) xmax = max(xmintemp,xmaxtemp) endif end subroutine transform_limits !------------------------------------------------------------------------ ! ! inverse transform for the plot limits ! (so that we can change the transformed limits and set the ! untransformed limits accordingly) ! !------------------------------------------------------------------------ subroutine transform_limits_inverse(xmin,xmax,itrans) implicit none integer, intent(in) :: itrans real, intent(inout) :: xmin,xmax real :: xmintemp,xmaxtemp,xtemp character(len=20) :: string integer :: i ! !--extract the digits from the input number ! if (itrans.gt.0) then write(string,*) itrans ! !--do a transformation for each digit ! xmintemp = xmin xmaxtemp = xmax do i=len_trim(string),1,-1 ! do digits in reverse ! !--perform transformation appropriate to this digit ! select case(string(i:i)) case('1') xmintemp = 10**xmintemp xmaxtemp = 10**xmaxtemp case('2') ! !--if minimum is zero give limits opposite signs ! (but same magnitude), otherwise do nothing ! if (xmintemp.eq.0.) then xtemp = max(abs(xmintemp),abs(xmaxtemp)) xmintemp = -xtemp xmaxtemp = xtemp endif case('3') if (xmintemp .ne. 0) then xmintemp = 1./xmintemp else xmintemp = 0. endif if (xmaxtemp .ne. 0) then xmaxtemp = 1./xmaxtemp else xmaxtemp = 0. endif case('4') xmintemp = xmintemp**2 xmaxtemp = xmaxtemp**2 case('5') if (xmintemp.gt.0) then xmintemp = sqrt(xmintemp) else xmintemp = 0. endif if (xmaxtemp.gt.0) then xmaxtemp = sqrt(xmaxtemp) else xmaxtemp = 0. endif case('6') xmintemp = exp(xmintemp) xmaxtemp = exp(xmaxtemp) end select enddo xmin = min(xmintemp,xmaxtemp) xmax = max(xmintemp,xmaxtemp) endif end subroutine transform_limits_inverse !------------------------------------------------------------------------ ! ! function to adjust the label of a plot if log, 1/x etc ! ! Note: *cannot* put print or write statements into this function ! as it is used in the middle of write or print statements ! this means that finding the digits is a bit trickier ! !------------------------------------------------------------------------ function transform_label(label,itrans) implicit none integer, intent(in) :: itrans character(len=*), intent(in) :: label integer :: itransmulti,i,ndigits integer, dimension(5) :: digit character(len=len(label)+20) :: transform_label character(len=len(label)+20) :: temp_label ! !--extract the digits from the input number ! if (itrans.gt.0) then call get_digits(itrans,digit,ndigits) temp_label = label ! !--do a transformation for each digit ! do i=1,ndigits itransmulti = digit(i) ! !--perform transformation appropriate to this digit ! select case(itransmulti) case(1) temp_label = 'log '//trim(temp_label) case(2) temp_label = '|'//trim(temp_label)//'|' case(3) temp_label = '1/'//trim(temp_label) case(4) temp_label = 'sqrt('//trim(temp_label)//')' case(5) temp_label = trim(temp_label)//'\u2\d' case(6) temp_label = 'ln '//trim(temp_label) case default temp_label = trim(temp_label) end select enddo transform_label = temp_label else transform_label = label endif end function transform_label !------------------------------------------------------------------------ ! get_digits: for an integer i returns number of digits it contains ! and a list of these *without* using write statements ! ! i : integer to split into digits ! nmax : dimensions of digits array ! digits(nmax) : array of digits ! ndigits : number of digits in i !------------------------------------------------------------------------ subroutine get_digits(i,digits,ndigits) implicit none integer, intent(in) :: i integer, intent(out) :: ndigits integer, intent(out), dimension(:) :: digits integer :: j,isubtract,idigit ndigits = 0 isubtract = 0 do j=size(digits),0,-1 if (i.ge.10**j) then ndigits = ndigits + 1 idigit = (i - isubtract)/10**j digits(ndigits) = idigit isubtract = isubtract + digits(ndigits)*10**j endif enddo end subroutine get_digits !------------------------------------------------------------------------ ! function returning the correction factor by which to multiply ! to convert the log in the transform to a natural log !------------------------------------------------------------------------ real function convert_to_ln_fac(itrans) implicit none integer, intent(in) :: itrans character(len=20) :: string integer :: i real :: xtemp ! !--default conversion factor is unity ! xtemp = 1.0 ! !--extract the digits from the input number ! if (itrans.gt.0) then write(string,*) itrans do i=len_trim(string),1,-1 ! do digits in reverse ! !--perform transformation appropriate to this digit ! select case(string(i:i)) ! !--correction factor is ln(10.) but can be ! 1./ln(10.), sqrt(1./ln(10.), etc. depending ! on other transformations ! case('1') xtemp = log(10.)*xtemp case('2') xtemp = abs(xtemp) case('3') xtemp = 1./xtemp case('4') xtemp = sqrt(xtemp) case('5') xtemp = xtemp**2 !case('6') ! xtemp = xtemp end select enddo endif convert_to_ln_fac = xtemp end function convert_to_ln_fac !--------------------------------------- ! query function to return whether the ! transformation involves a log or not !--------------------------------------- logical function islogged(itrans) implicit none integer, intent(in) :: itrans character(len=20) :: string write(string,"(i8)") itrans islogged = (index(string,'1').ne.0 .or. index(string,'6').ne.0) end function islogged end module transforms splash/src/units.f90000644 000770 000000 00000024331 12226712365 015232 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !-------------------------------------------------------------------- ! module containing subroutines to do with setting of physical units !-------------------------------------------------------------------- module settings_units use params use labels, only:unitslabel,labelzintegration implicit none real, dimension(0:maxplot), public :: units real, public :: unitzintegration real(doub_prec), public :: unit_interp public :: set_units,read_unitsfile,write_unitsfile,defaults_set_units private contains ! !--initialise the units arrays to some harmless default values ! subroutine defaults_set_units implicit none units(:) = 1.0 unitzintegration = 1.0 unit_interp = 1.0d0 unitslabel(:) = ' ' labelzintegration = ' ' return end subroutine defaults_set_units ! !--set units ! subroutine set_units(ncolumns,numplot,UnitsHaveChanged) use prompting, only:prompt use labels, only:label,ix,ih,iamvec,labelvec use settings_data, only:ndim,ndimV implicit none integer, intent(in) :: ncolumns,numplot logical, intent(out) :: UnitsHaveChanged integer :: icol real :: unitsprev,dunits logical :: applytoall icol = 1 do while(icol.ge.0) icol = -1 call prompt('enter column to change units (-2=reset all,-1=quit,0=time)',icol,-2,numplot) if (icol.ge.0) then unitsprev = units(icol) if (icol.gt.ncolumns) then print "(a)",' WARNING: calculated quantities are automatically calculated in physical units ' print "(a)",' this means that units set here will be re-scalings of these physical values' endif if (icol.eq.0) then call prompt('enter time units (new=old*units)',units(icol)) else call prompt('enter '//trim(label(icol))//' units (new=old*units)',units(icol)) endif if (abs(units(icol)).gt.tiny(units)) then if (abs(units(icol) - unitsprev).gt.tiny(units)) UnitsHaveChanged = .true. if (len_trim(unitslabel(icol)).eq.0) then !--suggest a label amendment if none already set dunits = 1./units(icol) if (dunits.gt.100 .or. dunits.lt.1.e-1) then write(unitslabel(icol),"(1pe8.1)") dunits else write(unitslabel(icol),"(f5.1)") dunits endif unitslabel(icol) = ' [ x '//trim(adjustl(unitslabel(icol)))//' ]' endif !--label amendment can be overwritten call prompt('enter label amendment ',unitslabel(icol)) else UnitsHaveChanged = .true. units(icol) = 1.0 unitslabel(icol) = ' ' endif if (UnitsHaveChanged .and. icol.gt.0) then ! !--prompt to apply same units to coordinates and h for consistency ! if (any(ix(1:ndim).eq.icol) .or. (icol.eq.ih .and. ih.gt.0)) then applytoall = .true. !--try to make prompts apply to whichever situation we have if (ndim.eq.1) then if (icol.eq.ix(1) .and. ih.gt.0) then call prompt(' Apply these units to h?',applytoall) else call prompt(' Apply these units to '//trim(label(ix(1)))//'?',applytoall) endif elseif (any(ix(1:ndim).eq.icol) .and. ih.gt.0) then call prompt(' Apply these units to all coordinates and h?',applytoall) else call prompt(' Apply these units to all coordinates?',applytoall) endif if (applytoall) then units(ix(1:ndim)) = units(icol) unitslabel(ix(1:ndim)) = unitslabel(icol) if (ih.gt.0) then units(ih) = units(icol) unitslabel(ih) = unitslabel(icol) endif endif ! !--set units for z integration in 3D ! so for example can have x,y,z in kpc but column density in g/cm^2 ! if (abs(unitzintegration-1.0).le.tiny(unitzintegration)) then unitzintegration = units(icol) labelzintegration = unitslabel(icol) endif if (ndim.eq.3) then call prompt(' Enter unit for ''z'' in 3D column integrated plots ',unitzintegration) call prompt(' Enter label for z integration unit (e.g. [cm])',labelzintegration) endif endif ! !--also sensible to apply same units to all components of a vector ! if (ndimV.gt.1 .and. iamvec(icol).gt.0) then applytoall = .true. call prompt(' Apply these units to all components of '//trim(labelvec(icol))//'?',applytoall) if (applytoall) then where (iamvec(1:ncolumns).eq.iamvec(icol)) units(1:ncolumns) = units(icol) unitslabel(1:ncolumns) = unitslabel(icol) end where endif endif endif elseif (icol.eq.-2) then UnitsHaveChanged = .true. print "(/a)",' resetting all units to unity...' units = 1.0 unitslabel = ' ' endif print* enddo end subroutine set_units ! !--save units for all columns to a file ! subroutine write_unitsfile(unitsfile,ncolumns) implicit none character(len=*), intent(in) :: unitsfile integer, intent(in) :: ncolumns integer :: i,ierr print "(1x,a)",'saving units to '//trim(unitsfile) open(unit=77,file=unitsfile,status='replace',form='formatted',iostat=ierr) if (ierr /=0) then print "(1x,a)",'ERROR: cannot write units file' else write(77,*,iostat=ierr) units(0),';',trim(unitslabel(0)),' ;',unitzintegration,';',trim(labelzintegration) do i=1,ncolumns write(77,*,iostat=ierr) units(i),';',trim(unitslabel(i)) if (ierr /= 0) then print "(1x,a)",'ERROR whilst writing units file' close(unit=77) return endif enddo endif close(unit=77) return end subroutine write_unitsfile ! !--read units for all columns from a file ! subroutine read_unitsfile(unitsfile,ncolumns,ierr,iverbose) use settings_data, only:ndim implicit none character(len=*), intent(in) :: unitsfile integer, intent(in) :: ncolumns integer, intent(out) :: ierr integer, intent(in), optional :: iverbose character(len=2*len(unitslabel)+40) :: line integer :: i,itemp,isemicolon,isemicolon2,isemicolon3 logical :: ierrzunits,iexist,verbose if (present(iverbose)) then verbose= (iverbose.gt.0) else verbose = .true. endif ierr = 0 ierrzunits = .false. inquire(file=unitsfile,exist=iexist) if (.not.iexist) then if (verbose) print "(1x,a)",trim(unitsfile)//' not found' ierr = 1 return endif open(unit=78,file=unitsfile,status='old',form='formatted',err=997) if (verbose) print "(a)",' read '//trim(unitsfile) do i=0,maxplot ! read all units possibly present in file ! ! read a line from the file ! read(78,"(a)",err=998,end=999) line ! ! now get units from the first part of the line ! read(line,*,iostat=itemp) units(i) if (itemp /= 0) print*,'error reading units for column ',i ! ! units label is what comes after the semicolon ! isemicolon = index(line,';') if (i.eq.0) then !--time line also contains unit of z integration isemicolon2 = index(line(isemicolon+1:),';') if (isemicolon2.gt.0) then isemicolon2 = isemicolon + isemicolon2 unitslabel(i) = trim(line(isemicolon+1:isemicolon2-1)) isemicolon3 = isemicolon2 + index(line(isemicolon2+1:),';') read(line(isemicolon2+1:isemicolon3-1),*,iostat=itemp) unitzintegration if (itemp /= 0) then print*,'error reading unit for z integration' ierrzunits = .true. else labelzintegration = trim(line(isemicolon3+1:)) endif else ierrzunits = .true. print*,'error: could not read z integration unit from units file' if (isemicolon.gt.0) then unitslabel(i) = trim(line(isemicolon+1:)) else print*,'error reading units label for column ',i endif endif else if (isemicolon.gt.0) then unitslabel(i) = trim(line(isemicolon+1:)) else print*,'error reading units label for column ',i endif endif ! print*,i,'units = ',units(i),'label = ',unitslabel(i) enddo if (ierrzunits .and. ndim.eq.3) then unitzintegration = units(3) labelzintegration = unitslabel(3) endif close(unit=78) return 997 continue if (verbose) print*,trim(unitsfile),' not found' ierr = 1 return 998 continue print*,'*** error reading units from '//trim(unitsfile) ierr = 2 if (ierrzunits .and. ndim.eq.3) then unitzintegration = units(3) labelzintegration = unitslabel(3) endif close(unit=78) return 999 continue !--only give error if we really do not have enough columns ! (on first call nextra is not set) if (i.le.ncolumns) then print "(1x,a,i2)",'end of file in '//trim(unitsfile)//': units read to column ',i ierr = -1 endif if (ierrzunits .and. ndim.eq.3) then unitzintegration = units(3) labelzintegration = unitslabel(3) endif close(unit=78) return end subroutine read_unitsfile end module settings_units splash/src/write_data_gadget.f90000644 000770 000000 00000015040 12303206671 017515 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2014 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! Module implementing "splash to gadget" operation, writing ! a binary dump file suitable for input to the GADGET code !----------------------------------------------------------------- module write_data_gadget implicit none character(len=10), parameter, public :: formatname='gadget' public :: write_sphdata_gadget private contains subroutine write_sphdata_gadget(time,dat,iamtype,ntotal,ntypes,npartoftype, & masstype,ncolumns,filename) use labels, only:ih,ivx,ix,iutherm,irho,ipmass use settings_data, only:ndim use limits, only:lim use params, only:int1 implicit none integer, intent(in) :: ntotal,ntypes,ncolumns integer, intent(in), dimension(:) :: npartoftype real, intent(in) :: time real, intent(in), dimension(ntotal,ncolumns) :: dat integer(kind=int1), intent(in), dimension(:) :: iamtype real, intent(in), dimension(:) :: masstype character(len=*), intent(in) :: filename integer, parameter :: idump = 83 character(len=len(filename)+10) :: outfile integer, dimension(6) :: nall,ncrap,noftype real(kind=8), dimension(6) :: massoftype real(kind=8) :: boxsize,dtime real(kind=8), parameter :: dumz = 0.d0 real(kind=4), dimension(15) :: unused integer, parameter :: iflagsfr = 0, iflagfeedback = 0, iflagcool = 0 integer, parameter :: nfiles = 1 integer :: ierr,i,j,nmasses,ngas,itype integer, dimension(:), allocatable :: iorder ! !--define output file name ! outfile=trim(filename)//'.gadget' ! !--check if we have enough data to write a GADGET dump ! if (ndim.lt.3) then print "(a)",' ERROR: ndim < 3 but must be 3 for GADGET data -- cannot write PHANTOM dump, skipping...' return endif if (any(ix(:).le.0)) then print "(a)",' ERROR: position labels not set -- cannot write GADGET dump, skipping...' return endif if (ivx.le.0) then print "(a)",' ERROR: velocity not found in data -- cannot write GADGET dump, skipping...' return endif if (iutherm.le.0) then print "(a)",' ERROR: thermal energy not found in data -- cannot write GADGET dump, skipping...' return endif if (irho.le.0) then print "(a)",' ERROR: density not found in data -- cannot write GADGET dump, skipping...' return endif if (ih.le.0) then print "(a)",' ERROR: smoothing length not found in data -- cannot write GADGET dump, skipping...' return endif ! !--open dumpfile ! write(*,"(/,/,'--------> TIME = ',f10.4,"// & "': writing GADGET snapshot file ',a,' <--------',/)") time,trim(outfile) print "(a)", ' WARNING: conversion to GADGET format is LIMITED in scope...' print "(a)", ' Currently converts only basic hydro quantities (x,v,m,u,rho,h) ' print "(a)", ' and header quantities may be guessed/fudged ...your mileage may vary' print "(a,/)",' (if you use this functionality and want it improved, just let me know)' print "(a,i2)",' writing to unit ',idump open(unit=idump,file=outfile,status='replace',form='unformatted',iostat=ierr) if (ierr /= 0) then write(*,*) 'error: can''t create new dumpfile ',trim(outfile) return endif massoftype(:) = 0. nall(:) = 0 noftype(:) = 0 massoftype(1:ntypes) = masstype(1:ntypes) nall(1:ntypes) = npartoftype(1:ntypes) noftype(1:ntypes) = npartoftype(1:ntypes) ncrap(:) = 0 boxsize = abs(lim(ix(1),2) - lim(ix(1),1)) unused(:) = 0 dtime = time write(idump,err=100) noftype(1:6),massoftype(1:6),dtime,dumz, & iflagsfr,iflagfeedback,nall(1:6),iflagcool,nfiles,boxsize, & dumz,dumz,dumz,iflagsfr,iflagsfr,ncrap(1:6),iflagsfr,unused(:) ! !--work out how many particle masses to write ! nmasses = 0 do j=1,6 if (massoftype(j).le.0.) then nmasses = nmasses + noftype(j) endif enddo print*,'nmasses = ',nmasses ngas = npartoftype(1) print*,'ngas = ',ngas if (ntotal > ngas .and. (size(iamtype).gt.1)) then !--must print the particles ordered by type allocate(iorder(ntotal),stat=ierr) j = 0 do itype=1,min(ntypes,6) if (npartoftype(itype).gt.0) then do i=1,ntotal if (iamtype(i).eq.itype) then j = j + 1 iorder(j) = i endif enddo endif enddo if (j.lt.ntotal) then print*,' ERROR: too many particle types in conversion to gadget format' do i=j+1,ntotal iorder(i) = i enddo endif write(idump,err=100) ((dat(iorder(i),ix(j)),j=1,3),i=1,ntotal) write(idump,err=100) ((dat(iorder(i),j),j=ivx,ivx+2),i=1,ntotal) write(idump,err=100) (iorder(i),i=1,ntotal) ! particle id write(idump,err=100) (dat(iorder(i),ipmass), i=1,nmasses) write(idump,err=100) (dat(iorder(i),iutherm),i=1,ngas) write(idump,err=100) (dat(iorder(i),irho), i=1,ngas) write(idump,err=100) (2.*dat(iorder(i),ih), i=1,ngas) deallocate(iorder) else write(idump,err=100) ((dat(i,ix(j)),j=1,3),i=1,ntotal) write(idump,err=100) ((dat(i,j),j=ivx,ivx+2),i=1,ntotal) write(idump,err=100) (i,i=1,ntotal) ! particle id write(idump,err=100) (dat(i,ipmass), i=1,nmasses) write(idump,err=100) (dat(i,iutherm),i=1,ngas) write(idump,err=100) (dat(i,irho), i=1,ngas) write(idump,err=100) (2.*dat(i,ih), i=1,ngas) endif print*,'finished writing file -- OK' close(unit=idump) return 100 continue write(*,*) 'error whilst writing dumpfile '//trim(outfile) close(unit=idump) end subroutine write_sphdata_gadget end module write_data_gadget splash/src/write_data_phantom.f90000644 000770 000000 00000022350 12530607476 017744 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! Module implementing "splash to phantom" operation, writing ! a binary dump file suitable for input to the PHANTOM code !----------------------------------------------------------------- module write_data_phantom implicit none character(len=10), parameter, public :: formatname='phantom' public :: write_sphdata_phantom private contains subroutine write_sphdata_phantom(time,gamma,dat,ntotal,ntypes,npartoftype, & masstype,ncolumns,filename) use labels, only:labeltype,ih,ivx,iBfirst,ipmass,ix,iutherm use settings_units, only:units use settings_data, only:ndim,UseTypeInRenderings use params, only:int8,doub_prec,sing_prec implicit none integer, intent(in) :: ntotal,ntypes,ncolumns integer, intent(in) :: npartoftype(:) real, intent(in) :: time,gamma real, intent(in) :: dat(ntotal,ncolumns) real, intent(in) :: masstype(:) character(len=*), intent(in) :: filename integer, parameter :: i_int = 1, & i_int1 = 2, & i_int2 = 3, & i_int4 = 4, & i_int8 = 5, & i_real = 6, & i_real4 = 7, & i_real8 = 8 integer, parameter :: idump = 83 character(len=len(filename)+10) :: outfile integer, parameter :: intval1=690706,intval2=780806 integer, parameter :: idimhead = 22 integer(kind=int8) :: nparttot,npartoftypetot(5),number8 integer :: nums(8) integer :: narraylengths,nblocks,nblockarrays integer :: i,j,ierr,i1,index1,number,npart real :: rheader(idimhead) real(doub_prec) :: udist,umass,utime,umagfd real :: r1,hfact logical :: mhd ! !--define output file name ! outfile=trim(filename)//'.tmp' narraylengths = 2 nblocks = 1 ! not parallel dump hfact = 1.2 ! must be specified in phantom dumps ! !--check if we have enough data to write a PHANTOM dump ! if (ndim < 3) then print "(a)",' ERROR: ndim < 3 but must be 3 for PHANTOM data -- cannot write PHANTOM dump, skipping...' return endif if (any(ix(:) <= 0)) then print "(a)",' ERROR: position labels not set -- cannot write PHANTOM dump, skipping...' return endif if (ivx <= 0) then print "(a)",' ERROR: velocity not found in data -- cannot write PHANTOM dump, skipping...' return endif if (ih <= 0) then print "(a)",' ERROR: smoothing length not found in data -- cannot write PHANTOM dump, skipping...' return endif mhd = .false. if (iBfirst > 0) then mhd = .true. narraylengths = 4 endif !--fill rheader and check that we have equal mass particles rheader(:) = 0. rheader(1) = time rheader(3) = gamma rheader(6) = hfact if (ipmass > 0) then index1 = 1 do i=1,ntypes rheader(14+i) = dat(index1,ipmass) if (npartoftype(i) > 0) then if (any(dat(index1:index1+npartoftype(i)-1,ipmass).ne.dat(index1,ipmass))) then print*,' ERROR: unequal mass particles detected but PHANTOM only accepts equal mass, skipping...' return endif index1 = index1 + npartoftype(i) endif enddo else do i=1,ntypes rheader(14+i) = masstype(i) enddo endif write(*,"(/,/,'--------> TIME = ',f10.4,"// & "': full dump written to file ',a,' on unit ',i2,' <--------',/)") & time,trim(outfile),idump open(unit=idump,file=outfile,status='new',form='unformatted',iostat=ierr) if (ierr /= 0) then write(*,*) 'error: can''t create new dumpfile '//trim(outfile) return endif ! !--write full dump Phantom/sphNG file ! i1 = intval1 r1 = real(intval2) write (idump, err=100) intval1,r1,intval2,i1,intval1 write (idump, err=100) fileident('F','Phantom',mhd=mhd) npart = npartoftype(1) npartoftypetot(:) = 0 do i=2,ntypes if (all(UseTypeInRenderings(1:i))) then npart = npart + npartoftype(i) if (npartoftype(i) > 0) print "(a)",' WARNING: assuming '// & trim(labeltype(i))//' particles are same as gas particles' if (rheader(15) <= 0.) then rheader(15) = masstype(i) rheader(15+i) = 0. elseif (abs(masstype(i)-rheader(15)) < tiny(masstype)) then print*,' WARNING! WARNING! mass of '//trim(labeltype(i))// & ' particles differs from '//trim(labeltype(1))//' particles' print*,' Assuming all particles have '//trim(labeltype(1))//' particle mass' endif endif enddo npartoftypetot(1) = npart nparttot = npart ! !--single values ! !--default int number = 7 write (idump, err=100) number write (idump, err=100) int(nparttot),(int(npartoftypetot(i)),i=1,5),nblocks !--int*1, int*2, int*4 number = 0 do i = 1, 3 write (idump, err=100) number end do !--int*8 number = 1 + ntypes write (idump, err=100) number write (idump, err=100) nparttot,npartoftypetot(1:ntypes) !--default real write (idump, err=100) idimhead write (idump, err=100) rheader(1:idimhead) !--real*4 number = 0 write (idump, err=100) number !--real*8 udist = units(ix(1)) utime = units(0) if (ipmass > 0) then umass = units(ipmass) else print "(a)",' WARNING: units for mass unknown, written as 1.0' umass = 1.0d0 endif if (iBfirst > 0) then umagfd = units(iBfirst) number = 4 write (idump, err=100) number write (idump, err=100) udist, umass, utime, umagfd else number = 3 write (idump, err=100) number write (idump, err=100) udist, umass, utime endif nblockarrays = narraylengths*nblocks write (idump, err=100) nblockarrays ! !--array length 1 header ! number8 = npart nums(:) = 0 if (iutherm.gt.0) then nums(i_real) = 7 else nums(i_real) = 6 endif nums(i_real4) = 1 write (idump, err=100) number8, (nums(i), i=1,8) ! !--array length 2 header ! number8 = 0 nums(:) = 0 write (idump, err=100) number8, (nums(i), i=1,8) ! !--array length 3 header ! if (narraylengths >= 3) then number8 = 0 nums(1:8) = 0 write (idump, err=100) number8, (nums(i), i=1,8) endif ! !--array length 4 header ! if (narraylengths >= 4) then if (mhd) then number8 = npart else number8 = 0 endif nums(:) = 0 if (mhd) nums(i_real4) = 3 write (idump, err=100) number8, (nums(i), i=1,8) endif ! !--array length 1 arrays ! !--default int !--int*1 !--int*2 !--int*4 !--int*8 !--default real do j = 1, 3 write (idump, err=100) (dat(i,ix(j)), i=1, npart) end do do j = 1, 3 write (idump, err=100) (dat(i,ivx+j-1), i=1, npart) end do if (iutherm.gt.0) then write (idump, err=100) (dat(i,iutherm), i=1, npart) endif !--real*4 ! dump smoothing length as a real*4 to save space write (idump, err=100) (real(dat(i,ih),kind=sing_prec), i=1, npart) if (mhd) then do j=1,3 write(idump,err=100) (real(dat(i,iBfirst+j-1),kind=sing_prec),i=1, npart) enddo endif close(unit=idump) return 100 continue write(*,*) 'error whilst writing dumpfile '//trim(outfile) close(unit=idump) end subroutine write_sphdata_phantom !-------------------------------------------------------------------- !+ ! contruct header string based on compile-time options ! these are for information only (ie. not important for restarting) !+ !-------------------------------------------------------------------- character(len=100) function fileident(firstchar,codestring,mhd) implicit none character(len=1), intent(in) :: firstchar character(len=*), intent(in), optional :: codestring logical, intent(in), optional :: mhd character(len=10) :: datestring, timestring, string logical :: gotmhd ! !--print date and time stamp in file header ! call date_and_time(datestring,timestring) datestring = datestring(7:8)//'/'//datestring(5:6)//'/'//datestring(1:4) timestring = timestring(1:2)//':'//timestring(3:4)//':'//timestring(5:) string = ' ' if (present(codestring)) then fileident = firstchar//':'//trim(codestring) else fileident = firstchar//':Phantom' endif gotmhd = .false. if (present(mhd)) gotmhd = mhd if (gotmhd) then fileident = trim(fileident)//' (mhd'//trim(string)//') : '//trim(datestring)//' '//trim(timestring) else fileident = trim(fileident)//' (hydro'//trim(string)//'): ' & //trim(datestring)//' '//trim(timestring) endif end function fileident end module write_data_phantom splash/src/write_griddata.F90000644 000770 000000 00000034243 12160063460 017014 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2012 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! Module implementing "splash to grid" operation, writing ! 3D gridded data in various output formats !----------------------------------------------------------------- module readwrite_griddata implicit none public :: isgridformat,print_gridformats public :: open_gridfile_w,open_gridfile_r public :: write_grid,read_gridcolumn ! !--generic interface for reading grid column data ! into 1D and 3D arrays ! interface read_gridcolumn module procedure read_gridcolumn3D,read_gridcolumn1D end interface read_gridcolumn private contains !----------------------------------------------------------------- ! utility to check if a format selection is valid !----------------------------------------------------------------- logical function isgridformat(string) use asciiutils, only:lcase implicit none character(len=*), intent(in) :: string isgridformat = .false. select case(trim(lcase(string))) case('grid') isgridformat = .true. case('gridascii') isgridformat = .true. case('gridbinary','gridbin') isgridformat = .true. case('gridascii2') isgridformat = .true. end select end function isgridformat !----------------------------------------------------------------- ! print usage if format selection not valid !----------------------------------------------------------------- subroutine print_gridformats implicit none print "(/,a)",' Grid conversion mode ("splash to X dumpfiles"): ' print "(a)",' splash to grid : interpolate basic SPH data (density, plus velocity if present in data)' print "(a)",' to 2D or 3D grid, write grid data to file (using default output=ascii)' print "(a)",' to gridascii : as above, grid data written in ascii format' print "(a)",' to gridascii2 : grid data written in ascii format, all in one file' print "(a)",' to gridbinary : as above, grid data in simple unformatted binary format:' print "(a)",' write(unit) nx,ny,nz,ncolumns,time [ 4 bytes each ]' print "(a)",' write(unit) (((rho(i,j,k),i=1,nx),j=1,ny),k=1,nz) [ 4 bytes each ]' print "(a)",' write(unit) (((vx(i,j,k), i=1,nx),j=1,ny),k=1,nz) [ 4 bytes each ]' print "(a)",' write(unit) (((vy(i,j,k), i=1,nx),j=1,ny),k=1,nz) [ 4 bytes each ]' print "(a)",' write(unit) (((...(i,j,k),i=1,nx),j=1,ny),k=1,nz) [ 4 bytes each ]' print "(a)",' allto grid : as above, interpolating *all* columns to the grid (and output file)' print "(a)",' allto gridascii : as above, with ascii output' print "(a)",' allto gridbinary : as above, with binary output' return end subroutine print_gridformats !------------------------------------------------------ ! open grid file for (write) output, write header !------------------------------------------------------ subroutine open_gridfile_w(iunit,filenamein,outformat,ndim,ncolumns,npixels,time,ierr) use asciiutils, only:lcase implicit none integer, intent(in) :: iunit character(len=*), intent(in) :: filenamein,outformat character(len=len(filenamein)+10) :: filename integer, intent(in) :: ndim,ncolumns integer, dimension(ndim), intent(in) :: npixels real, intent(in) :: time integer, intent(out) :: ierr ! !--Only have to do something here for formats ! that have all columns in the same file ! ierr = 0 select case(trim(lcase(outformat))) case('gridascii','grid') ! !--ascii output uses individual files ! print "(/,a,i2)",'-----> WRITING TO ASCII OUTPUT FILES' case('gridbinary','gridbin') ! !--simple unformatted binary format ! filename = trim(filenamein)//'.grid' print "(/,a,i2)",'----> WRITING TO '//trim(filename)//' on unit ',iunit print "(a)", ' (using unformatted binary format)' open(unit=iunit,file=trim(filename),form='unformatted',status='replace',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR opening '//trim(filename)//' for output!' return endif write(iunit,iostat=ierr) npixels(1:ndim),ncolumns,time if (ierr /= 0) then print "(a)",' ERROR writing header to file!' return endif case('gridascii2') print "(/,a,i2)",'-----> WRITING TO ASCII OUTPUT FILES (WITH X, Y, Z, COL)' case('hdf5') case default ! return error if bad format print "(a)",' ERROR: unknown output format '''//trim(outformat)//''' in open_gridfile' ierr = 1 return end select end subroutine open_gridfile_w !------------------------------------------------------ ! open grid file for reading, read header !------------------------------------------------------ subroutine open_gridfile_r(iunit,filename,informat,ndim,ncolumns,npixels,time,ierr) use asciiutils, only:lcase implicit none integer, intent(in) :: iunit,ndim character(len=*), intent(in) :: filename character(len=*), intent(inout) :: informat integer, intent(out) :: ncolumns integer, dimension(ndim), intent(out) :: npixels real, intent(out) :: time integer, intent(out) :: ierr ! !--read only implemented for binary grid format at present ! ierr = 0 select case(trim(lcase(informat))) case('gridbinary','gridbin') ! !--simple unformatted binary format ! print "(/,a,i2)",'----> READING '//trim(filename)//' on unit ',iunit print "(a)", ' (using unformatted binary format)' open(unit=iunit,file=trim(filename),form='unformatted',status='old',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR opening '//trim(filename)//' for reading!' return endif read(iunit,iostat=ierr) npixels(1:ndim),ncolumns,time if (ierr /= 0) then print "(a)",' ERROR reading header to file!' return endif case default ! return error if bad format print "(a)",' ERROR: cannot read grid format '''//trim(informat)//''' in open_gridfile_r' ierr = 1 return end select end subroutine open_gridfile_r !------------------------------------------------------ ! write a particular column to the grid output file !------------------------------------------------------ subroutine write_grid(iunit,filenamein,outformat,ndim,npixels,label,time,& pixwidth,xmin,ierr,dat3D,dat2D) use asciiutils, only:ucase,lcase,safename use filenames, only:tagline implicit none integer, intent(in) :: iunit character(len=*), intent(in) :: filenamein,outformat integer, intent(in) :: ndim integer, dimension(ndim), intent(in) :: npixels character(len=*), intent(in) :: label real, intent(in) :: time,pixwidth real, dimension(3), intent(in) :: xmin integer, intent(out) :: ierr character(len=len(filenamein)+20) :: filename real, dimension(:,:,:), intent(in), optional :: dat3D real, dimension(:,:), intent(in), optional :: dat2D integer :: i,j,k real :: xi,yi,zi ierr = 0 if (ndim.eq.3 .and. .not.present(dat3D)) then print "(a)",' ERROR in call to write_grid: ndim=3 but 3D grid not passed' ierr = 1 elseif (ndim.eq.2 .and. .not.present(dat2D)) then print "(a)",' ERROR in call to write_grid: ndim=2 but 2D grid not passed' ierr = 1 elseif (.not.(ndim.eq.2 .or. ndim.eq.3)) then print "(a,i2,a)",' ERROR in call to write_grid: cannot write grid for ',ndim,' dimensions' ierr = 2 endif if (ierr /= 0) return select case(trim(lcase(outformat))) case('gridascii','grid') filename = trim(filenamein)//'_'//trim(safename(label))//'_grid.dat' print "(a)",'-----> WRITING '//trim(ucase(label))//' to '//trim(filename) ! !--open ascii file ! open(unit=iunit,file=trim(filename),form='formatted',status='replace',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR OPENING FILE FOR WRITING' return endif write(iunit,"(a)",err=100) '# '//trim(tagline) write(iunit,"(a)",err=100) & '# '//trim(filename)//' produced using "splash to '//trim(outformat)// & '" on file '//trim(filenamein) write(iunit,"(a)",err=100) '#' write(iunit,"(a)",err=100) '# time:' write(iunit,"(a,es15.7)",iostat=ierr) '# ',time write(iunit,"(a)",err=100) '#' write(iunit,"(a)",err=100) '# file contains:' write(iunit,"(a,i1,a)",err=100) '# '//trim(label)//' interpolated to ',ndim,'D grid ' write(iunit,"(a)",err=100) '#' write(iunit,"(a)",err=100) '# written in the form: ' if (ndim.eq.3) then write(iunit,"(a)",err=100) '# do k=1,nz' write(iunit,"(a)",err=100) '# do j=1,ny' write(iunit,"(a)",err=100) '# write(*,*) (dat(i,j,k),i=1,nx)' write(iunit,"(a)",err=100) '# enddo' write(iunit,"(a)",err=100) '# enddo' else write(iunit,"(a)",err=100) '# do j=1,ny' write(iunit,"(a)",err=100) '# write(*,*) (dat(i,j),i=1,nx)' write(iunit,"(a)",err=100) '# enddo' endif write(iunit,"(a)",err=100) '#' write(iunit,"(a)",err=100) '# grid dimensions:' if (present(dat3D)) then write(iunit,"(a)",err=100) '# nx ny nz' write(iunit,*,err=100) npixels(1:ndim) do k=1,npixels(3) do j=1,npixels(2) write(iunit,"(2048(es14.6,1x))",err=100) (dat3D(i,j,k),i=1,npixels(1)) enddo enddo elseif (present(dat2D)) then write(iunit,"(a)",err=100) '# nx ny' write(iunit,*,err=100) npixels(1:ndim) do j=1,npixels(2) write(iunit,"(2048(es14.6,1x))",err=100) (dat2D(i,j),i=1,npixels(1)) enddo endif close(unit=iunit) return case('gridbinary','gridbin') print "(a)",'-----> WRITING '//trim(ucase(label)) if (present(dat3D)) then write(iunit,iostat=ierr) (((dat3D(i,j,k),i=1,npixels(1)),j=1,npixels(2)),k=1,npixels(3)) elseif (present(dat2D)) then write(iunit,iostat=ierr) ((dat2D(i,j),i=1,npixels(1)),j=1,npixels(2)) endif case('gridascii2') filename = trim(filenamein)//'_'//trim(safename(label))//'_grid.dat' print "(a)",'-----> WRITING '//trim(ucase(label))//' to '//trim(filename) ! !--open ascii file ! open(unit=iunit,file=trim(filename),form='formatted',status='replace',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR OPENING FILE FOR WRITING' return endif write(iunit,"(a)",err=100) '# '//trim(tagline) write(iunit,"(a)",err=100) & '# '//trim(filename)//' produced using "splash to '//trim(outformat)// & '" on file '//trim(filenamein) write(iunit,"(a)",err=100) '# grid dimensions:' if (present(dat3D)) then write(iunit,"(a)",err=100) '# nx ny nz' write(iunit,"(a,3(i5,1x))",err=100) '# ',npixels(1:3) write(iunit,"('#',4('[',a13,']'))",err=100) 'x','y','z',trim(label) do k=1,npixels(3) write(*,"('.')",ADVANCE='NO') zi = xmin(3) + (k-0.5)*pixwidth do j=1,npixels(2) yi = xmin(2) + (j-0.5)*pixwidth do i=1,npixels(1) xi = xmin(1) + (i-0.5)*pixwidth write(iunit,"(4(es14.6,1x))") xi,yi,zi,dat3D(i,j,k) enddo enddo enddo elseif (present(dat2D)) then write(iunit,"(a)",err=100) '# nx ny ' write(iunit,"(a,2(i5,1x))",err=100) '# ',npixels(1:2) write(iunit,"('#',3('[',a13,']'))",err=100) 'x','y',trim(label) do j=1,npixels(2) write(*,"('.')",ADVANCE='NO') yi = xmin(2) + (j-0.5)*pixwidth do i=1,npixels(1) xi = xmin(1) + (i-0.5)*pixwidth write(iunit,"(3(es14.6,1x))") xi,yi,dat2D(i,j) enddo enddo endif write(*,*) case('hdf5') case default print "(a)",' ERROR: unknown output format '''//trim(outformat)//''' in write_grid' return end select return ! !--error handling during write ! 100 continue print "(a)",' ERROR writing grid file' close(unit=iunit) return end subroutine write_grid !------------------------------------------------------------------ ! read a particular column from the grid output file into 3D array !------------------------------------------------------------------ subroutine read_gridcolumn3D(iunit,dat,npixels,ierr) implicit none integer, intent(in) :: iunit real, dimension(:,:,:), intent(out) :: dat integer, dimension(3), intent(in) :: npixels integer, intent(out) :: ierr integer :: i,j,k print "(a,i4,'x',i4,'x',i4,a)",'-----> READING ',npixels(:),' data points' read(iunit,iostat=ierr) (((dat(i,j,k),i=1,npixels(1)),j=1,npixels(2)),k=1,npixels(3)) end subroutine read_gridcolumn3D !------------------------------------------------------------------ ! read a particular column from the grid output file into 1D array !------------------------------------------------------------------ subroutine read_gridcolumn1D(iunit,dat,ngrid,ierr) implicit none integer, intent(in) :: iunit real, dimension(:), intent(out) :: dat integer, intent(in) :: ngrid integer, intent(out) :: ierr integer :: i print "(a,i10,a)",'-----> READING ',ngrid,' data points' read(iunit,iostat=ierr) (dat(i),i=1,ngrid) end subroutine read_gridcolumn1D end module readwrite_griddata splash/src/write_pixmap.f90000644 000770 000000 00000037143 12160267353 016604 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2013 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! module containing output routines for writing pixel map ! to output file in various formats ! ! (c) D. Price 21/09/07 ! Added read routines June 2009 !----------------------------------------------------------------- module write_pixmap use filenames, only:fileprefix,tagline implicit none logical, public :: iwritepixmap = .false. logical, public :: ireadpixmap = .false. character(len=5), public :: pixmapformat = ' ' character(len=5), public :: readpixformat = ' ' public :: isoutputformat,writepixmap,write_pixmap_ppm public :: isinputformat,readpixmap private contains !----------------------------------------------------------------- ! utility to check if an output format selection is valid !----------------------------------------------------------------- logical function isoutputformat(string) implicit none character(len=*), intent(in) :: string isoutputformat = .false. select case(trim(string)) case('ascii','ppm') isoutputformat = .true. end select if (.not.isoutputformat) then print "(a)",' possible formats for -o option: ' print "(a)",' -o ppm : dump pixel map to ppm file' print "(a)",' -o ascii : dump pixel map to ascii file' print "(a)",' use -p to change the prefix for the filenames' endif return end function isoutputformat !----------------------------------------------------------------- ! utility to check if an input format selection is valid !----------------------------------------------------------------- logical function isinputformat(string) implicit none character(len=*), intent(in) :: string isinputformat = .false. select case(trim(string)) case('ascii','ftn','ftn512','chf') isinputformat = .true. end select if (.not.isinputformat) then print "(a)",' possible formats for -readpix option: ' print "(a)",' -readpix ascii : read pixel maps from ascii file' print "(a)",' -readpix ftn : read pixel maps from unformatted fortran file "read(1) dat(:,:)"' print "(a)",' -readpix ftn512 : read pixel maps from unformatted fortran file "read(1) dat(1:512,1:512)"' endif return end function isinputformat !----------------------------------------------------------------- ! wrapper routine for all output formats !----------------------------------------------------------------- subroutine writepixmap(datpix,npixx,npixy,xmin,ymin,dx,datmin,datmax,label,labu,istep,xsec,dumpfile) implicit none integer, intent(in) :: npixx,npixy real, intent(in), dimension(npixx,npixy) :: datpix real, intent(in) :: xmin,ymin,dx,datmin,datmax logical, intent(in) :: xsec character(len=*), intent(in) :: label,labu,dumpfile integer, intent(in) :: istep select case(trim(pixmapformat)) case('ascii') call write_pixmap_ascii(datpix,npixx,npixy,xmin,ymin,dx,datmin,datmax,label,labu,istep,xsec,dumpfile) case('ppm') call write_pixmap_ppm(datpix,npixx,npixy,xmin,ymin,dx,datmin,datmax,label,istep) ! case('fits') ! call write_pixmap_fits(datpix,npixx,npixy,xmin,ymin,dx,datmin,datmax,label) case default print "(a)",' ERROR: invalid output format for pixel map ' end select end subroutine writepixmap !----------------------------------------------------------------- ! output pixmap as an ascii file !----------------------------------------------------------------- subroutine write_pixmap_ascii(datpix,npixx,npixy,xmin,ymin,dx,datmin,datmax,label,labu,istep,xsec,dumpfile) use labels, only:shortlabel implicit none integer, intent(in) :: npixx,npixy,istep real, intent(in), dimension(npixx,npixy) :: datpix real, intent(in) :: xmin,ymin,dx,datmin,datmax logical, intent(in) :: xsec character(len=*), intent(in) :: label,labu,dumpfile character(len=10) :: stringx,stringy character(len=30) :: fmtstring character(len=len(dumpfile)+10) :: filename integer :: ierr,j integer, parameter :: iunit = 166 ! !--write ascii file ! !write(filename,"(a,i5.5,a)") trim(fileprefix)//'_',istep,'.dat' call get_pixmap_filename(filename,dumpfile,shortlabel(label,labu),'.pix',xsec) open(unit=iunit,file=filename,status='replace',form='formatted',iostat=ierr) if (ierr /=0) then print*,'error opening '//trim(filename) return endif write(*,"(a)",ADVANCE='NO') '> writing pixel map to file '//trim(filename)//' ...' write(stringx,"(i10)") npixx write(stringy,"(i10)") npixy write(iunit,"(a)",err=66) '# '//trim(adjustl(filename))//' created by '//trim(tagline) write(iunit,"(a)",err=66) '# Contains 2D pixel array '//trim(adjustl(stringx))//' x '//trim(adjustl(stringy))//' written as ' write(iunit,"(a)",err=66) '# do j=1,'//trim(adjustl(stringy)) write(iunit,"(a)",err=66) '# write(*,*) dat(1:'//trim(adjustl(stringx))//',j)' write(iunit,"(a)",err=66) '# enddo' write(iunit,"(a,1pe14.6,a,1pe14.6)",err=66) '# '//trim(label)//': min = ',datmin,' max = ',datmax write(iunit,"(a,1pe14.6,a,1pe14.6)",err=66) '# x axis: min = ',xmin,' max = ',xmin+(npixx-1)*dx write(iunit,"(a,1pe14.6,a,1pe14.6)",err=66) '# y axis: min = ',ymin,' max = ',ymin+(npixy-1)*dx write(iunit,"(a)",err=66) '# '//trim(adjustl(stringx))//' '//trim(adjustl(stringy)) write(fmtstring,"(a,i6,a)",iostat=ierr) '(',npixx,'(1pe14.6))' if (ierr /= 0) then do j=1,npixy write(iunit,*,err=66) datpix(1:npixx,j) enddo else do j=1,npixy write(iunit,fmtstring,err=66) datpix(1:npixx,j) enddo endif close(iunit) print "(a)",'OK' return 66 continue print "(a)",' ERROR during write ' close(iunit) return end subroutine write_pixmap_ascii !----------------------------------------------------------------- ! output pixmap as a raw .ppm file !----------------------------------------------------------------- subroutine write_pixmap_ppm(datpix,npixx,npixy,xmin,ymin,dx,datmin,datmax,label,istep,brightness) use colours, only:rgbtable,ncolours implicit none integer, intent(in) :: npixx,npixy real, intent(in), dimension(npixx,npixy) :: datpix real, intent(in), dimension(npixx,npixy), optional :: brightness real, intent(in) :: xmin,ymin,dx,datmin,datmax character(len=*), intent(in) :: label integer, intent(in) :: istep character(len=120) :: filename real, dimension(3) :: rgbi,drgb real :: dati,ddatrange,datfraci,ftable integer :: ipix,jpix,ir,ib,ig,ierr,maxcolour,indexi integer, parameter :: iunit = 167 ! !--check for errors ! if (abs(datmax-datmin).gt.tiny(datmin)) then ddatrange = 1./abs(datmax-datmin) else print "(a)",'error: datmin=datmax : pointless writing ppm file' return endif ! !--write PPM-- ! write(filename,"(a,i5.5,a)") trim(fileprefix)//'_',istep,'.ppm' open(unit=iunit,file=filename,status='replace',form='formatted',iostat=ierr) if (ierr /=0) then print*,'error opening ppm file' return endif write(*,"(a)",ADVANCE='NO') '> writing pixel map to file '//trim(filename)//' ...' ! !--PPM header ! maxcolour = 255 write(iunit,"(a)",err=66) 'P3' write(iunit,"(a)",err=66) '# '//trim(adjustl(filename))//' created by '//trim(tagline) write(iunit,"(a,1pe14.6,a,1pe14.6)",err=66) '# '//trim(label)//': min = ',datmin,' max = ',datmax write(iunit,"(a,1pe14.6,a,1pe14.6)",err=66) '# x axis: min = ',xmin,' max = ',xmin+(npixx-1)*dx write(iunit,"(a,1pe14.6,a,1pe14.6)",err=66) '# y axis: min = ',ymin,' max = ',ymin+(npixy-1)*dx write(iunit,"(i4,1x,i4)",err=66) npixx, npixy write(iunit,"(i3)",err=66) maxcolour !--pixel information do jpix = npixy,1,-1 do ipix = 1,npixx dati = datpix(ipix,jpix) datfraci = (dati - datmin)*ddatrange datfraci = max(datfraci,0.) datfraci = min(datfraci,1.) !--define colour for current particle ftable = datfraci*ncolours indexi = int(ftable) + 1 indexi = min(indexi,ncolours) if (indexi.lt.ncolours) then !--do linear interpolation from colour table drgb(:) = rgbtable(:,indexi+1) - rgbtable(:,indexi) rgbi(:) = rgbtable(:,indexi) + (ftable - int(ftable))*drgb(:) else rgbi(:) = rgbtable(:,indexi) endif if (present(brightness)) then rgbi(:) = rgbi(:)*min(brightness(ipix,jpix),1.0) endif ir = max(min(int(rgbi(1)*maxcolour),maxcolour),0) ig = max(min(int(rgbi(2)*maxcolour),maxcolour),0) ib = max(min(int(rgbi(3)*maxcolour),maxcolour),0) write(iunit,"(i3,1x,i3,1x,i3,2x)",err=66) ir,ig,ib enddo enddo close(unit=iunit) print "(a)",'OK' return 66 continue print "(a)",' ERROR during write ' close(iunit) return end subroutine write_pixmap_ppm !----------------------------------------------------------------- ! read in pixels from file !----------------------------------------------------------------- subroutine readpixmap(datpix,npixx,npixy,dumpfile,label,istep,xsec,ierr) use asciiutils, only:nheaderlines implicit none real, intent(out), dimension(:,:), allocatable :: datpix integer, intent(out) :: npixx,npixy,ierr character(len=*), intent(in) :: dumpfile character(len=*), intent(in) :: label integer, intent(in) :: istep logical, intent(in) :: xsec integer :: i,j,nheader,nerr integer, parameter :: iunit = 168 character(len=128) :: filename character(len=2) :: char logical :: iexist ierr = 0 select case(trim(adjustl(readpixformat))) case('ascii') ! splash pixmap output files call check_for_pixmap_files(filename,dumpfile,label,'.pix',istep,xsec,iexist) if (.not.iexist) then print "('*',a,'*',/,72('*'))",' Create a file with one of these names (or a soft link) and try again ' ierr = 1 return endif open(unit=iunit,file=filename,status='old',form='formatted',iostat=ierr) if (ierr /=0) then print*,'error opening '//trim(filename) return else npixx = 0 npixy = 0 nheader = nheaderlines(iunit) rewind(iunit) do i=1,nheader-1 read(iunit,*,iostat=ierr) enddo read(iunit,*,iostat=ierr) char,npixx,npixy if (ierr /= 0 .or. npixx.le.0 .or. npixy.le.0) then print*,'ERROR reading size of pixel map, got nx = ',npixx,' ny = ',npixy,& ', skipped ',nheader,' header lines' else print "(a,i5,a,i5,a)",' reading',npixx,' x',npixy,' pixel map from '//trim(filename) endif allocate(datpix(npixx,npixy),stat=ierr) if (ierr /= 0) then print "(a)",' ERROR allocating memory for pixel map' close(iunit) return endif nerr = 0 do j=1,npixy read(iunit,*,iostat=ierr) datpix(1:npixx,j) if (ierr /= 0) nerr = nerr + 1 enddo if (nerr /= 0) print "(a,i3,a,i3)",' WARNING: ',nerr,' errors reading pixel map from '//trim(filename)//' on unit ',iunit close(iunit) endif case('ftn','ftn512','chf') ! Christoph Federrath files npixx = 512 npixy = 512 ! !--cycle through possible filenames ! call check_for_pixmap_files(filename,dumpfile,label,'.pix',istep,xsec,iexist) if (.not.iexist) then print "('*',a,'*',/,72('*'))",' Create a file with one of these names (or a soft link) and try again ' ierr = 1 return endif open(unit=iunit,file=filename,status='old',form='unformatted',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR: cannot open '//trim(filename) ierr = 2 return else print "(a)",' reading pixel map from '//trim(filename) allocate(datpix(npixx,npixy),stat=ierr) read(iunit,iostat=ierr) datpix if (ierr /= 0) print "(a,i3)",' WARNING: ERRORS reading pixel map from '//trim(filename)//' on unit ',iunit close(iunit) endif case default if (len_trim(readpixformat).le.0) then print "(a)",' ERROR: pixel format not set prior to read_pixmap call' else print "(a)",' ERROR: unknown pixmap format '//trim(adjustl(readpixformat)) endif ierr = 1 end select end subroutine readpixmap !----------------------------------------------------------------- ! look for pixel map files matching a variety of naming schemes !----------------------------------------------------------------- subroutine get_pixmap_filename(filename,dumpfile,label,ext,xsec) use asciiutils, only:basename,safename character(len=*), intent(out) :: filename character(len=*), intent(in) :: dumpfile,label,ext logical, intent(in) :: xsec if (xsec) then filename = trim(basename(dumpfile))//'_'//trim(safename(label))//'_slice'//trim(ext) else filename = trim(basename(dumpfile))//'_'//trim(safename(label))//'_proj'//trim(ext) endif end subroutine get_pixmap_filename !----------------------------------------------------------------- ! look for pixel map files matching a variety of naming schemes !----------------------------------------------------------------- subroutine check_for_pixmap_files(filename,dumpfile,label,ext,istep,xsec,iexist) use asciiutils, only:safename,basename implicit none character(len=*), intent(out) :: filename character(len=*), intent(in) :: dumpfile,label,ext integer, intent(in) :: istep logical, intent(in) :: xsec logical, intent(out) :: iexist character(len=len(dumpfile)) :: dumpfilei integer :: i,maxnames logical :: printinfo dumpfilei = dumpfile iexist = .false. i = 0 maxnames = 5 printinfo = .false. do while (.not.iexist .and. i.lt.maxnames) i = i + 1 select case(i) case(1) if (xsec) then filename = trim(dumpfilei)//'_'//trim(safename(label))//'_slice'//trim(ext) else filename = trim(dumpfilei)//'_'//trim(safename(label))//'_proj'//trim(ext) endif case(2) filename = trim(dumpfilei)//'_'//trim(safename(label))//trim(ext) case(3) if (xsec) then filename = trim(dumpfilei)//'_slice'//trim(ext) else filename = trim(dumpfilei)//'_proj'//trim(ext) endif case(4) filename = trim(dumpfilei)//trim(ext) case(5) write(filename,"(a,i5.5,a)") trim(fileprefix)//'_',istep,trim(ext) end select ! !--query to see if file exists ! if (printinfo) then print "('*',a,'*')",' no file '//filename(1:60)//'' else inquire(file=filename,exist=iexist) endif if (.not.iexist) then ! !--try the same files again but in the current directory ! instead of the directory in which the dump files are located ! if (i.eq.maxnames) then if (len_trim(dumpfilei).ne.len_trim(basename(dumpfile))) then i = 0 dumpfilei = basename(dumpfile) elseif (.not.printinfo) then print "(72('*'),/,'*',a,12x,'*')", & ' ERROR: could not find any '//trim(ext)//' files with matching names:' dumpfilei = dumpfile printinfo = .true. i = 0 endif endif endif enddo end subroutine check_for_pixmap_files end module write_pixmap splash/src/write_sphdata.f90000644 000770 000000 00000024303 12531264150 016716 0ustar00dpricewheel000000 000000 !----------------------------------------------------------------- ! ! This file is (or was) part of SPLASH, a visualisation tool ! for Smoothed Particle Hydrodynamics written by Daniel Price: ! ! http://users.monash.edu.au/~dprice/splash ! ! SPLASH comes with ABSOLUTELY NO WARRANTY. ! This is free software; and you are welcome to redistribute ! it under the terms of the GNU General Public License ! (see LICENSE file for details) and the provision that ! this notice remains intact. If you modify this file, please ! note section 2a) of the GPLv2 states that: ! ! a) You must cause the modified files to carry prominent notices ! stating that you changed the files and the date of any change. ! ! Copyright (C) 2005-2015 Daniel Price. All rights reserved. ! Contact: daniel.price@monash.edu ! !----------------------------------------------------------------- !----------------------------------------------------------------- ! module containing output routines for writing SPH data ! as read by SPLASH to output file in various formats ! ! (c) D. Price 22/01/08 !----------------------------------------------------------------- module write_sphdata public :: issphformat,write_sphdump private contains !----------------------------------------------------------------- ! utility to check if a format selection is valid !----------------------------------------------------------------- logical function issphformat(string) implicit none character(len=*), intent(in) :: string issphformat = .false. select case(trim(string)) case('ascii','ASCII') issphformat = .true. case('binary','BINARY') issphformat = .true. case('rsph','RSPH') issphformat = .true. case('phantom','PHANTOM') issphformat = .true. case('gadget','GADGET') issphformat = .true. end select if (.not.issphformat) then print "(a)",' convert mode ("splash to X dumpfiles"): ' print "(a,/)",' splash to ascii : convert SPH data to ascii file dumpfile.ascii' print "(a)", ' to binary : convert SPH data to simple unformatted binary dumpfile.binary ' print "(a)", ' write(1) time,npart,ncolumns' print "(a)", ' do i=1,npart' print "(a)", ' write(1) dat(1:ncolumns),itype' print "(a)", ' enddo' print "(a)", ' to phantom : convert SPH data to binary dump file for PHANTOM' print "(a)", ' to gadget : convert SPH data to default GADGET snapshot file format' endif return end function issphformat subroutine write_sphdump(time,gamma,dat,npart,ntypes,npartoftype,masstype,itype,ncolumns,filename,outformat) use labels, only:labeltype,label,unitslabel,irho,ipmass,ix use settings_units, only:units use settings_data, only:ndim,icoords,icoordsnew,xorigin use params, only:int1,maxplot,doub_prec use write_data_phantom, only:write_sphdata_phantom use write_data_gadget, only:write_sphdata_gadget use filenames, only:tagline use geomutils, only:change_coords implicit none integer, intent(in) :: npart,ntypes,ncolumns integer, intent(in), dimension(:) :: npartoftype integer(kind=int1), intent(in), dimension(:) :: itype real, intent(in) :: time,gamma real, intent(in), dimension(npart,ncolumns) :: dat real, intent(in), dimension(:) :: masstype character(len=*), intent(in) :: filename,outformat integer, parameter :: iunit = 83 integer, parameter :: maxline = 1000 integer :: ierr,i,idim,i1,i2 character(len=40) :: fmtstring,fmtstring2,fmtstringlab,outfile real(kind=doub_prec), dimension(maxplot) :: vals real, dimension(3) :: x0,v0 logical :: change_coordsys select case(trim(outformat)) case ('ascii','ASCII') print "(/,5('-'),'>',a,i2,a,1x,'<',5('-'),/)",' WRITING TO FILE '//trim(filename)//'.ascii WITH ',ncolumns,' COLUMNS' !--format the header lines to go in the ascii file if (kind(1.)==8) then write(fmtstring,"(i10,a)") ncolumns,'(es23.15,1x)' else write(fmtstring,"(i10,a)") ncolumns,'(es15.7,1x)' endif fmtstring2 = '('//trim(adjustl(fmtstring))//',i1)' fmtstring = '('//trim(adjustl(fmtstring))//')' write(fmtstringlab,"(i10,a)") ncolumns,'(a15,1x),a' fmtstringlab = '(''#'',1x,'//trim(adjustl(fmtstringlab))//')' open(unit=iunit,file=trim(filename)//'.ascii',status='replace',form='formatted',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR OPENING FILE FOR WRITING' return endif write(iunit,"(a)",err=100) '# '//trim(filename)//'.ascii, created by '//trim(tagline) write(iunit,"('#')",err=100) write(iunit,"('#',1x,'time:',13x,'time unit (',a,')')",err=100) trim(unitslabel(0)) write(iunit,"('#',2(1x,1pe15.7))",err=100) time,units(0) write(iunit,"('#')",err=100) write(iunit,"('#',1x,'npart:',6(1x,a12))",err=100) (trim(labeltype(i)),i=1,ntypes) write(iunit,"('#',7x,6(1x,i12))",err=100) npartoftype(1:ntypes) write(iunit,"('# units:')",err=100) write(iunit,"('#'"//fmtstring(2:),err=100) units(1:ncolumns) write(iunit,fmtstringlab,err=100) unitslabel(1:ncolumns) write(iunit,"('#')",err=100) ! !--write body ! change_coordsys = (icoordsnew.ne.icoords .and. ndim.gt.0 .and. all(ix(1:ndim).gt.0)) x0 = xorigin(:) ! note that it is not currently possible to do splash to ascii v0 = 0. ! with coords set relative to a tracked particle, so just use xorigin if (size(itype).gt.1) then write(iunit,fmtstringlab,iostat=ierr) label(1:ncolumns),'itype' do i=1,npart vals(1:ncolumns) = dat(i,1:ncolumns) if (change_coordsys) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) write(iunit,fmtstring2,err=100) vals(1:ncolumns),itype(i) enddo else write(iunit,fmtstringlab,iostat=ierr) label(1:ncolumns) if (change_coordsys) then do i=1,npart vals(1:ncolumns) = dat(i,1:ncolumns) call change_coords(vals,ncolumns,ndim,icoords,icoordsnew,x0,v0) write(iunit,fmtstring,err=100) vals(1:ncolumns) enddo else do i=1,npart write(iunit,fmtstring,err=100) dat(i,1:ncolumns) enddo endif endif close(iunit) return 100 continue close(iunit) print*,'ERROR WRITING ASCII FILE' return case ('binary','BINARY') ! !--This is the most basic binary (ie. unformatted) file format I could think of, ! as an alternative to ascii for large files. ! print "(/,5('-'),'>',a,i2,a,1x,'<',5('-'),/)",' WRITING TO FILE '//trim(filename)//'.binary WITH ',ncolumns,' COLUMNS' open(unit=iunit,file=trim(filename)//'.binary',status='replace',form='unformatted',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR OPENING FILE FOR WRITING' return endif write(iunit,iostat=ierr) time,npart,ncolumns if (ierr /= 0) then print "(a)",' ERROR WRITING HEADER LINE TO BINARY FILE ' endif ! !--write body ! if (size(itype).gt.1) then do i=1,npart write(iunit,err=200) dat(i,1:ncolumns),int(itype(i)) enddo else do i=1,npart write(iunit,err=200) dat(i,1:ncolumns) enddo endif close(iunit) return 200 continue close(iunit) print*,'ERROR WRITING BINARY FILE' return case ('rsph','RSPH') ! !--Files for Steinar Borve's RSPH format ! if (ndim.lt.2) then print "(a)",' ERROR: cannot write RSPH format for < 2D' return endif outfile = 'rsph2D_pos.dat' print "(a)",' writing to '//trim(outfile) open(unit=iunit,file=outfile,status='replace',form='formatted',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR OPENING '//trim(outfile)//' FOR WRITING' return endif write(iunit,"(i1)") ndim write(iunit,"(a)") 'position' write(iunit,"(i4)") maxline write(iunit,*) (minval(dat(1:npart,ix(i))),i=1,ndim) write(iunit,*) (maxval(dat(1:npart,ix(i))),i=1,ndim) write(iunit,*) time write(iunit,*) npart do idim=1,2 i1 = 1 i2 = 0 do while (i2 < npart) i2 = min(i2 + maxline,npart) write(iunit,*) dat(i1:i2,ix(idim)) i1 = i2 + 1 enddo enddo close(unit=iunit) outfile = 'rsph2D_rho.dat' print "(a)",' writing to '//trim(outfile) open(unit=iunit,file=outfile,status='replace',form='formatted',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR OPENING FILE FOR WRITING' return endif write(iunit,"(i1)") ndim write(iunit,"(a)") 'density' write(iunit,"(i4)") maxline write(iunit,*) (minval(dat(1:npart,ix(i))),i=1,ndim) write(iunit,*) (maxval(dat(1:npart,ix(i))),i=1,ndim) i1 = 1 i2 = 0 do while (i2 < npart) i2 = min(i2 + maxline,npart) write(iunit,*) dat(i1:i2,irho) i1 = i2 + 1 enddo close(unit=iunit) outfile = 'rsph2D_siz.dat' print "(a)",' writing to '//trim(outfile) open(unit=iunit,file=outfile,status='replace',form='formatted',iostat=ierr) if (ierr /= 0) then print "(a)",' ERROR OPENING FILE FOR WRITING' return endif write(iunit,"(i1)") ndim write(iunit,"(a)") 'size' write(iunit,"(i4)") maxline write(iunit,*) (minval(dat(1:npart,ix(i))),i=1,ndim) write(iunit,*) (maxval(dat(1:npart,ix(i))),i=1,ndim) i1 = 1 i2 = 0 do while (i2 < npart) i2 = min(i2 + maxline,npart) write(iunit,*) ((dat(i,ipmass)/dat(i,irho))**(1./ndim),i=i1,i2) i1 = i2 + 1 enddo close(unit=iunit) case('phantom','PHANTOM') call write_sphdata_phantom(time,gamma,dat,npart,1,npartoftype(1:1),& masstype,ncolumns,filename) case('gadget','GADGET') call write_sphdata_gadget(time,dat,itype,npart,ntypes,npartoftype,& masstype,ncolumns,filename) case default print "(a)",' ERROR: unknown output format '''//trim(outformat)//''' in write_sphdump' return end select end subroutine write_sphdump end module write_sphdata splash/src/H5Part/COPYING000644 000770 000000 00000007343 11352542473 015712 0ustar00dpricewheel000000 000000 *** Copyright Notice *** H5Part Copyright (c) 2006-2009, The Regents of the University of California, through Lawrence Berkeley National Laboratory (subject to receipt of any required approvals from the U.S. Dept. of Energy) and the Paul Scherrer Institut (Switzerland). All rights reserved. If you have questions about your rights to use or distribute this software, please contact Berkeley Lab's Technology Transfer Department at TTD@lbl.gov referring to "H5Part (LBNL Ref CR-2255)" NOTICE. This software was developed under partial funding from the U.S. Department of Energy. As such, the U.S. Government has been granted for itself and others acting on its behalf a paid-up, nonexclusive, irrevocable, worldwide license in the Software to reproduce, prepare derivative works, and perform publicly and display publicly. Beginning five (5) years after the date permission to assert copyright is obtained from the U.S. Department of Energy, and subject to any subsequent five (5) year renewals, the U.S. Government is granted for itself and others acting on its behalf a paid-up, nonexclusive, irrevocable, worldwide license in the Software to reproduce, prepare derivative works, distribute copies to the public, perform publicly and display publicly, and to permit others to do so. *** License agreement *** H5Part Copyright (c) 2006-2009, The Regents of the University of California, through Lawrence Berkeley National Laboratory (subject to receipt of any required approvals from the U.S. Dept. of Energy) and the Paul Scherrer Institut (Switzerland). All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: (1) Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. (2) Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. (3) Neither the name of the University of California, Lawrence Berkeley National Laboratory, U.S. Dept. of Energy, Paul Scherrer Institut (Switzerland) nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. You are under no obligation whatsoever to provide any bug fixes, patches, or upgrades to the features, functionality or performance of the source code ("Enhancements") to anyone; however, if you choose to make your Enhancements available either publicly, or directly to Lawrence Berkeley National Laboratory, without imposing a separate written license agreement for such Enhancements, then you hereby grant the following license: a non-exclusive, royalty-free perpetual license to install, use, modify, prepare derivative works, incorporate into other computer software, distribute, and sublicense such enhancements or derivative works thereof, in binary and source code form. splash/src/H5Part/H5Part.F90000644 000770 000000 00000063717 11357372406 016253 0ustar00dpricewheel000000 000000 !------------------------------------------------------------- ! ! Fortran 90 interface to H5Part, using ! the Fortran 2003 C interoperability module (iso_c_binding) ! ! Written by Daniel Price 08/04/10 ! daniel.price@sci.monash.edu.au ! ! We first specify the interfaces to the C interface routines ! used to handle the H5partfile container object. However, all ! string conversion is done in the Fortran, not in the C. ! !------------------------------------------------------------- module h5part use, intrinsic :: iso_c_binding, only:c_char,c_int,c_int64_t,c_double,c_float implicit none integer(kind=c_int64_t), parameter, public :: H5PART_INT64 = 1 integer(kind=c_int64_t), parameter, public :: H5PART_INT32 = 2 integer(kind=c_int64_t), parameter, public :: H5PART_FLOAT64 = 3 integer(kind=c_int64_t), parameter, public :: H5PART_FLOAT32 = 4 integer(kind=c_int64_t), parameter, public :: H5PART_CHAR = 5 integer(kind=c_int64_t), parameter, public :: H5PART_STRING = 6 character(len=7), dimension(6), parameter, public :: & h5part_type = (/'INT64 ',& 'INT32 ',& 'FLOAT64',& 'FLOAT32',& 'CHAR ',& 'STRING '/) ! ! interfaces provided by this module ! public :: h5pt_openr,h5pt_openw,h5pt_opena,h5pt_close public :: h5pt_openr_align,h5pt_openw_align,h5pt_opena_align #ifdef PARALLEL_IO public :: h5pt_openr_par,h5pt_openw_par,h5pt_opena_par public :: h5pt_openr_par_align,h5pt_openw_par_align,h5pt_opena_par_align #endif public :: h5pt_setnpoints,h5pt_setnpoints_strided public :: h5pt_getnpoints public :: h5pt_setstep,h5pt_getnsteps,h5pt_getndatasets public :: h5pt_getdatasetname,h5pt_getdatasetinfo public :: h5pt_setview,h5pt_setview_indices public :: h5pt_getview public :: h5pt_resetview,h5pt_hasview public :: h5pt_set_verbosity_level public :: h5pt_writedata public :: h5pt_readdata ! ! the type-specific routines are also public ! (could make these private to allow only ! the generic interface to be used) ! public :: h5pt_writedata_r8,h5pt_writedata_r4, & h5pt_writedata_i8,h5pt_writedata_i4 public :: h5pt_readdata_r8,h5pt_readdata_r4, & h5pt_readdata_i8,h5pt_readdata_i4 private ! ! generic interface for writing data of any type ! interface h5pt_writedata module procedure h5pt_writedata_i4,h5pt_writedata_i8, & h5pt_writedata_r4,h5pt_writedata_r8 end interface h5pt_writedata ! ! generic interface for reading data of any type ! interface h5pt_readdata module procedure h5pt_readdata_i4,h5pt_readdata_i8, & h5pt_readdata_r4,h5pt_readdata_r8 end interface h5pt_readdata !--------------------------- ! ! interfaces to c routines ! !--------------------------- interface ! ! Opening and closing files ! integer(kind=c_int64_t) function h5ptc_openr( filename ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for reading end function integer(kind=c_int64_t) function h5ptc_openw ( filename ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for writing end function integer(kind=c_int64_t) function h5ptc_opena ( filename ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for appending end function integer(kind=c_int64_t) function h5ptc_openr_align ( filename, align ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for reading integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes end function integer(kind=c_int64_t) function h5ptc_openw_align ( filename, align ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for writing integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes end function integer(kind=c_int64_t) function h5ptc_opena_align ( filename, align ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for appending integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes end function integer(kind=c_int64_t) function h5pt_close ( filehandle ) bind(C,name="h5ptc_close") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function #ifdef PARALLEL_IO ! ! Opening files (parallel I/O) ! integer(kind=c_int64_t) function h5ptc_openr_par ( filename, mpi_communicator ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for reading integer, intent(in) :: mpi_communicator !< the MPI communicator used by the program end function integer(kind=c_int64_t) function h5ptc_openw_par ( filename, mpi_communicator ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for writing integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program end function integer(kind=c_int64_t) function h5ptc_opena_par ( filename, mpi_communicator ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for appending integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program end function integer(kind=c_int64_t) function h5ptc_openr_par_align ( filename, mpi_communicator, align ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for reading integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes end function integer(kind=c_int64_t) function h5ptc_openw_par_align ( filename, mpi_communicator, align, flags ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for writing integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes character(kind=c_char), dimension(1), intent(in) :: flags !< additional flags end function integer(kind=c_int64_t) function h5ptc_opena_par_align ( filename, mpi_communicator, align, flags ) bind(C) import character(kind=c_char), dimension(1), intent(in) :: filename !< the filename to open for appending integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes character(kind=c_char), dimension(1), intent(in) :: flags !< additional flags end function #endif ! ! Setting up the data model ! (where no strings are passed these are just interfaces to the c routines that convert the filehandle) ! integer(kind=c_int64_t) function h5pt_setnpoints ( filehandle, npoints ) bind(C,name="h5ptc_setnpoints") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: npoints !< the number of particles on *this* processor end function integer(kind=c_int64_t) function h5pt_setnpoints_strided ( filehandle, npoints, stride ) & bind(C,name="h5ptc_setnpoints_strided") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: npoints !< the number of particles on *this* processor integer(kind=c_int64_t), intent(in) :: stride !< the stride value (e.g. the number of fields in the particle data array) end function integer(kind=c_int64_t) function h5pt_setstep (filehandle,step) bind(C,name="h5ptc_setstep") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: step !< a timestep value >= 1 end function integer(kind=c_int64_t) function h5pt_getnsteps (filehandle) bind(C,name="h5ptc_getnsteps") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function integer(kind=c_int64_t) function h5pt_getndatasets (filehandle) bind(C,name="h5ptc_getndatasets") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function integer(kind=c_int64_t) function h5pt_getnpoints (filehandle) bind(C,name="h5ptc_getnpoints") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function integer(kind=c_int64_t) function h5ptc_getdatasetname (filehandle,index,name,l_name) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: index !< index of dataset to query (starting from 0) character(kind=c_char), dimension(1), intent(out) :: name !< buffer to read the dataset name into integer(kind=c_int64_t), intent(in) :: l_name !< size of name end function integer(kind=c_int64_t) function h5ptc_getdatasetinfo (filehandle,index,name,data_type,nelem,l_name) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: index !< index of dataset to query (starting from 0) character(kind=c_char), dimension(1), intent(out) :: name !< buffer to read the dataset name into integer(kind=c_int64_t), intent(out) :: data_type !< type of data in dataset integer(kind=c_int64_t), intent(out) :: nelem !< number of elements integer(kind=c_int64_t), intent(in) :: l_name !< size of name end function ! ! Setting and getting views ! (as no strings are passed these are just interfaces to the c routines that convert the filehandle) ! integer(kind=c_int64_t) function h5pt_setview (filehandle,start,end) bind(C,name="h5ptc_setview") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: start !< offset of the first particle in the view integer(kind=c_int64_t), intent(in) :: end !< offset of the last particle in the view (inclusive) end function integer(kind=c_int64_t) function h5pt_setview_indices (filehandle,indices,nelem) bind(C,name="h5ptc_setview_indices") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: indices(*) !< list of indicies to select in this view integer(kind=c_int64_t), intent(in) :: nelem !< number of particles in the list end function integer(kind=c_int64_t) function h5pt_resetview (filehandle) bind(C,name="h5ptc_resetview") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function integer(kind=c_int64_t) function h5pt_hasview (filehandle) bind(C,name="h5ptc_hasview") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function integer(kind=c_int64_t) function h5pt_getview (filehandle,start,end) bind(C,name="h5ptc_getview") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(out) :: start !< buffer to store the offset of the first particle in the view integer(kind=c_int64_t), intent(out) :: end !< buffer to store the offset of the last particle in the view (inclusive) end function ! ! Reading and writing datasets ! integer(kind=c_int64_t) function h5ptc_writedata_r8 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset real(kind=c_double), intent(in) :: data(*) !< the array of float64 data to write end function integer(kind=c_int64_t) function h5ptc_readdata_r8 (filehandle,name,data) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset real(kind=c_double), intent(out) :: data(*) !< array to read float64 data into end function integer(kind=c_int64_t) function h5ptc_writedata_r4 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset real(kind=c_float), intent(in) :: data(*) !< the array of float32 data to write end function integer(kind=c_int64_t) function h5ptc_readdata_r4 (filehandle,name,data) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset real(kind=c_float), intent(out) :: data(*) !< array to read float32 data into end function integer(kind=c_int64_t) function h5ptc_writedata_i8 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset integer(kind=c_int64_t), intent(in) :: data(*) !< the array of int64 data to write end function integer(kind=c_int64_t) function h5ptc_readdata_i8 (filehandle,name,data) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset integer(kind=c_int64_t), intent(out) :: data(*) !< array to read int64 data into end function integer(kind=c_int64_t) function h5ptc_writedata_i4 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset integer(kind=c_int), intent(in) :: data(*) !< the array of int32 data to write end function integer(kind=c_int64_t) function h5ptc_readdata_i4 (filehandle,name,data) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the dataset integer(kind=c_int), intent(out) :: data(*) !< array to read int32 data into end function ! ! routines where no conversion of anything is needed: i.e. just call H5Part C routines directly ! integer(kind=c_int64_t) function h5pt_set_verbosity_level ( level ) bind(C,name="H5PartSetVerbosityLevel") import integer(kind=c_int64_t), intent(in) :: level !< the level from 0 (no output) to 5 (most detailed) end function end interface contains !--------------------------------------------------------------------------- ! ! wrappers for functions with string arguments: ! converts strings into C strings ! !--------------------------------------------------------------------------- integer(kind=c_int64_t) function h5pt_openr( filename ) implicit none character(len=*), intent(in) :: filename !< the filename to open for reading h5pt_openr = h5ptc_openr( cstring(filename) ) end function integer(kind=c_int64_t) function h5pt_openw ( filename ) implicit none character(len=*), intent(in) :: filename !< the filename to open for writing h5pt_openw = h5ptc_openw ( cstring(filename) ) end function integer(kind=c_int64_t) function h5pt_opena ( filename ) implicit none character(len=*), intent(in) :: filename !< the filename to open for appending h5pt_opena = h5ptc_opena ( cstring(filename) ) end function integer(kind=c_int64_t) function h5pt_openr_align ( filename, align ) implicit none character(len=*), intent(in) :: filename !< the filename to open for reading integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes h5pt_openr_align = h5ptc_openr_align ( cstring(filename), align ) end function integer(kind=c_int64_t) function h5pt_openw_align ( filename, align ) implicit none character(len=*), intent(in) :: filename !< the filename to open for writing integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes h5pt_openw_align = h5ptc_openw_align ( cstring(filename), align ) end function integer(kind=c_int64_t) function h5pt_opena_align ( filename, align ) implicit none character(len=*), intent(in) :: filename !< the filename to open for appending integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes h5pt_opena_align = h5ptc_opena_align ( cstring(filename), align ) end function #ifdef PARALLEL_IO ! ! opening files (parallel I/O) ! integer(kind=c_int64_t) function h5pt_openr_par ( filename, mpi_communicator ) implicit none character(len=*), intent(in) :: filename !< the filename to open for reading integer, intent(in) :: mpi_communicator !< the MPI communicator used by the program h5pt_openr_par = h5ptc_openr_par ( cstring(filename), mpi_communicator ) end function integer(kind=c_int64_t) function h5pt_openw_par ( filename, mpi_communicator ) implicit none character(len=*), intent(in) :: filename !< the filename to open for writing integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program h5pt_openw_par = h5ptc_openw_par ( cstring(filename), mpi_communicator ) end function integer(kind=c_int64_t) function h5pt_opena_par ( filename, mpi_communicator ) implicit none character(len=*), intent(in) :: filename !< the filename to open for appending integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program h5pt_opena_par = h5ptc_opena_par ( cstring(filename), mpi_communicator ) end function integer(kind=c_int64_t) function h5pt_openr_par_align ( filename, mpi_communicator, align ) implicit none character(len=*), intent(in) :: filename !< the filename to open for reading integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes h5pt_openr_par_align = h5ptc_openr_par_align ( cstring(filename), mpi_communicator, align ) end function integer(kind=c_int64_t) function h5pt_openw_par_align ( filename, mpi_communicator, align, flags ) implicit none character(len=*), intent(in) :: filename !< the filename to open for writing integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes character(len=*), intent(in) :: flags !< additional flags h5pt_openw_par_align = h5ptc_openw_par_align ( cstring(filename), mpi_communicator, align, cstring(flags) ) end function integer(kind=c_int64_t) function h5pt_opena_par_align ( filename, mpi_communicator, align, flags ) implicit none character(len=*), intent(in) :: filename !< the filename to open for appending integer, intent(in) :: mpi_communicator !< the MPI_Communicator used by the program integer(kind=c_int64_t), intent(in) :: align !< alignment value in bytes character(len=*), intent(in) :: flags !< additional flags h5pt_opena_par_align = h5ptc_opena_par_align ( cstring(filename), mpi_communicator, align, cstring(flags) ) end function #endif ! ! Setting up the data model ! integer(kind=c_int64_t) function h5pt_getdatasetname (filehandle,index,name) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: index !< index of dataset to query (starting from 0) character(len=*), intent(out) :: name !< buffer to read the dataset name into integer(kind=c_int64_t) :: l_name l_name = len(name) h5pt_getdatasetname = h5ptc_getdatasetname(filehandle,index,name,l_name) name = fstring(name) end function h5pt_getdatasetname integer(kind=c_int64_t) function h5pt_getdatasetinfo(filehandle,idx,name,data_type,nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: idx !< index of dataset to query (starting from 0) character(len=*), intent(out) :: name !< buffer to read the dataset name into integer(kind=c_int64_t), intent(out) :: data_type !< type of data in dataset integer(kind=c_int64_t), intent(out) :: nelem !< number of elements integer(kind=c_int64_t) :: l_name l_name = len(name) h5pt_getdatasetinfo = h5ptc_getdatasetinfo(filehandle,idx,name,data_type,nelem,l_name) name = fstring(name) end function h5pt_getdatasetinfo ! ! Reading and writing datasets ! integer(kind=c_int64_t) function h5pt_writedata_r8 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset real(kind=c_double), intent(in) :: data(*) !< the array of float64 data to write h5pt_writedata_r8 = h5ptc_writedata_r8 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_readdata_r8 ( filehandle, name, data) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset real(kind=c_double), intent(out) :: data(*) !< array to read float64 data into h5pt_readdata_r8 = h5ptc_readdata_r8 ( filehandle, cstring(name), data) end function integer(kind=c_int64_t) function h5pt_writedata_r4 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset real(kind=c_float), intent(in) :: data(*) !< the array of float32 data to write h5pt_writedata_r4 = h5ptc_writedata_r4 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_readdata_r4 ( filehandle, name, data) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset real(kind=c_float), intent(out) :: data(*) !< array to read float32 data into h5pt_readdata_r4 = h5ptc_readdata_r4 ( filehandle, cstring(name), data) end function integer(kind=c_int64_t) function h5pt_writedata_i8 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset integer(kind=c_int64_t), intent(in) :: data(*) !< the array of int64 data to write h5pt_writedata_i8 = h5ptc_writedata_i8 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_readdata_i8 ( filehandle, name, data) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset integer(kind=c_int64_t), intent(out) :: data(*) !< array to read int64 data into h5pt_readdata_i8 = h5ptc_readdata_i8 ( filehandle, cstring(name), data) end function integer(kind=c_int64_t) function h5pt_writedata_i4 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset integer(kind=c_int), intent(in) :: data(*) !< the array of int32 data to write h5pt_writedata_i4 = h5ptc_writedata_i4 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_readdata_i4 (filehandle,name,data) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the dataset integer(kind=c_int), intent(out) :: data(*) !< array to read int32 data into h5pt_readdata_i4 = h5ptc_readdata_i4 ( filehandle, cstring(name), data) end function !--------------------------------------------------------------------------- ! ! function to safely convert a string to c format (ie. with a terminating ! ascii null character) ! !--------------------------------------------------------------------------- function cstring(string) implicit none character(len=*), intent(in) :: string character(len=len(string)+1) :: cstring cstring = trim(string)//char(0) end function cstring !--------------------------------------------------------------------------- ! ! function to safely convert a string from c format (ie. with a terminating ! ascii null character) back to a normal Fortran string ! !--------------------------------------------------------------------------- function fstring(string) implicit none character(len=*), intent(in) :: string !< the name of the dataset character(len=len(string)) :: fstring integer :: idx idx = index(string,char(0)) if (idx.gt.1) then fstring = string(1:idx-1) else fstring = '' endif end function fstring end module h5part splash/src/H5Part/H5PartAttrib.f90000644 000770 000000 00000064114 11357372333 017450 0ustar00dpricewheel000000 000000 !------------------------------------------------------------- ! ! Fortran 90 interface to H5Part, using ! the Fortran 2003 C interoperability module (iso_c_binding) ! ! Written by Daniel Price 08/04/10 ! daniel.price@sci.monash.edu.au ! ! We first specify the interfaces to the C interface routines ! used to handle the H5partfile container object. However, all ! string conversion is done in the Fortran, not in the C. ! ! This module contains the attributes interface ! !------------------------------------------------------------- module h5partattrib use, intrinsic :: iso_c_binding, only:c_char,c_int,c_int64_t,c_double,c_float implicit none ! ! interfaces provided by this module ! public :: h5pt_getnfileattribs,h5pt_getfileattribinfo public :: h5pt_getnstepattribs,h5pt_getstepattribinfo public :: h5pt_writefileattrib,h5pt_readfileattrib public :: h5pt_writestepattrib,h5pt_readstepattrib ! ! the type-specific routines are also public ! (could make these private to allow only ! the generic interface to be used) ! public :: h5pt_writefileattrib_i4,h5pt_writefileattrib_i8, & h5pt_writefileattrib_r4,h5pt_writefileattrib_r8, & h5pt_writefileattrib_string public :: h5pt_readfileattrib_i4,h5pt_readfileattrib_i8, & h5pt_readfileattrib_r4,h5pt_readfileattrib_r8, & h5pt_readfileattrib_string public :: h5pt_writestepattrib_i4,h5pt_writestepattrib_i8, & h5pt_writestepattrib_r4,h5pt_writestepattrib_r8, & h5pt_writestepattrib_string public :: h5pt_readstepattrib_i4,h5pt_readstepattrib_i8, & h5pt_readstepattrib_r4,h5pt_readstepattrib_r8, & h5pt_readstepattrib_string private ! ! generic interface for writing file attributes of any type ! interface h5pt_writefileattrib module procedure h5pt_writefileattrib_i4,h5pt_writefileattrib_i8, & h5pt_writefileattrib_r4,h5pt_writefileattrib_r8, & h5pt_writefileattrib_string end interface h5pt_writefileattrib ! ! generic interface for reading file attributes of any type ! interface h5pt_readfileattrib module procedure h5pt_readfileattrib_i4,h5pt_readfileattrib_i8, & h5pt_readfileattrib_r4,h5pt_readfileattrib_r8, & h5pt_readfileattrib_string end interface h5pt_readfileattrib ! ! generic interface for writing step attributes of any type ! interface h5pt_writestepattrib module procedure h5pt_writestepattrib_i4,h5pt_writestepattrib_i8, & h5pt_writestepattrib_r4,h5pt_writestepattrib_r8, & h5pt_writestepattrib_string end interface h5pt_writestepattrib ! ! generic interface for reading step attributes of any type ! interface h5pt_readstepattrib module procedure h5pt_readstepattrib_i4,h5pt_readstepattrib_i8, & h5pt_readstepattrib_r4,h5pt_readstepattrib_r8, & h5pt_readstepattrib_string end interface h5pt_readstepattrib !--------------------------- ! ! interfaces to c routines ! !--------------------------- interface ! ! file attributes: interfaces to c routines ! integer(kind=c_int64_t) function h5pt_getnfileattribs (filehandle) bind(C,name="h5ptc_getnfileattribs") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function integer(kind=c_int64_t) function h5ptc_getfileattribinfo (filehandle,idx,name,nelem,l_name) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: idx !< index of the attribute to query (starting from 0) character(kind=c_char), dimension(1), intent(out) :: name !< buffer to read the attribute name into integer(kind=c_int64_t), intent(out) :: nelem !< number of elements in the attribute's array integer(kind=c_int64_t), intent(in) :: l_name !< size of name end function integer(kind=c_int64_t) function h5ptc_writefileattrib_r8 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readfileattrib_r8 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(out) :: data(*) !< buffer to read value into end function integer(kind=c_int64_t) function h5ptc_writefileattrib_r4 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readfileattrib_r4 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(out) :: data(*) !< buffer to read value into end function integer(kind=c_int64_t) function h5ptc_writefileattrib_i8 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readfileattrib_i8 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(out) :: data(*) !< buffer to read value into end function integer(kind=c_int64_t) function h5ptc_writefileattrib_i4 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readfileattrib_i4 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(out) :: data(*) !< buffer to read value into end function integer(kind=c_int64_t) function h5ptc_writefileattrib_string (filehandle,name,value) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute character(kind=c_char), dimension(1), intent(in) :: value !< the string value to store end function integer(kind=c_int64_t) function h5ptc_readfileattrib_string (filehandle,name,value) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute character(kind=c_char), dimension(1), intent(out) :: value !< buffer to read the string value into end function ! ! step attributes: interfaces to c routines ! integer(kind=c_int64_t) function h5pt_getnstepattribs (filehandle) bind(C,name="h5ptc_getnstepattribs") import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open end function integer(kind=c_int64_t) function h5ptc_getstepattribinfo (filehandle,idx,name,nelem,l_name) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: idx !< index of the attribute to query (starting from 0) character(kind=c_char), dimension(1), intent(out) :: name !< buffer to read the attribute name into integer(kind=c_int64_t), intent(out) :: nelem !< number of elements in the attribute's array integer(kind=c_int64_t), intent(in) :: l_name !< number of elements in the attribute's array end function integer(kind=c_int64_t) function h5ptc_writestepattrib_r8 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readstepattrib_r8 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(out) :: data(*) !< buffer to read value into end function integer(kind=c_int64_t) function h5ptc_writestepattrib_r4 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readstepattrib_r4 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(out) :: data(*) !< buffer to read value into end function integer(kind=c_int64_t) function h5ptc_writestepattrib_i8 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readstepattrib_i8 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(out) :: data(*) !< buffer to read value into end function integer(kind=c_int64_t) function h5ptc_writestepattrib_i4 ( filehandle, name, data, nelem) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array end function integer(kind=c_int64_t) function h5ptc_readstepattrib_i4 ( filehandle, name, data ) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(out) :: data(*) !< buffer to read value into end function ! ! read/write string ! integer(kind=c_int64_t) function h5ptc_writestepattrib_string (filehandle,name,value) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute character(kind=c_char), dimension(1), intent(in) :: value !< the string value to store end function integer(kind=c_int64_t) function h5ptc_readstepattrib_string (filehandle,name,value) bind(C) import integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(kind=c_char), dimension(1), intent(in) :: name !< the name of the attribute character(kind=c_char), dimension(1), intent(out) :: value !< buffer to read the string value into end function end interface contains !--------------------------------------------------------------------------- ! ! wrappers for functions with string arguments: ! converts strings into C strings ! !--------------------------------------------------------------------------- ! ! file attributes ! integer(kind=c_int64_t) function h5pt_getfileattribinfo (filehandle,idx,name,nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: idx !< index of the attribute to query (starting from 0) character(len=*), intent(out) :: name !< buffer to read the attribute name into integer(kind=c_int64_t), intent(out) :: nelem !< number of elements in the attribute's array integer(kind=c_int64_t) :: l_name !< size of name l_name = len(name) h5pt_getfileattribinfo = h5ptc_getfileattribinfo (filehandle,idx,name,nelem,l_name) name = fstring(name) end function integer(kind=c_int64_t) function h5pt_writefileattrib_r8 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writefileattrib_r8 = h5ptc_writefileattrib_r8 ( filehandle, cstring(name), data, nelem) end function h5pt_writefileattrib_r8 integer(kind=c_int64_t) function h5pt_readfileattrib_r8 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(out) :: data(*) !< buffer to read value into h5pt_readfileattrib_r8 = h5ptc_readfileattrib_r8 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_writefileattrib_r4 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writefileattrib_r4 = h5ptc_writefileattrib_r4( filehandle, cstring(name), data, nelem) end function integer(kind=c_int64_t) function h5pt_readfileattrib_r4 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(out) :: data(*) !< buffer to read value into h5pt_readfileattrib_r4 = h5ptc_readfileattrib_r4( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_writefileattrib_i8 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writefileattrib_i8 = h5ptc_writefileattrib_i8( filehandle, cstring(name), data, nelem) end function integer(kind=c_int64_t) function h5pt_readfileattrib_i8 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(out) :: data(*) !< buffer to read value into h5pt_readfileattrib_i8 = h5ptc_readfileattrib_i8( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_writefileattrib_i4 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writefileattrib_i4 = h5ptc_writefileattrib_i4( filehandle, cstring(name), data, nelem) end function integer(kind=c_int64_t) function h5pt_readfileattrib_i4 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(out) :: data(*) !< buffer to read value into h5pt_readfileattrib_i4 = h5ptc_readfileattrib_i4 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_writefileattrib_string ( filehandle, name, value) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the attribute character(len=*), intent(in) :: value !< the string value to store h5pt_writefileattrib_string = h5ptc_writefileattrib_string ( filehandle, cstring(name), cstring(value)) end function integer(kind=c_int64_t) function h5pt_readfileattrib_string ( filehandle, name, value) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the attribute character(len=*), intent(out) :: value !< buffer to read the string value into h5pt_readfileattrib_string = h5ptc_readfileattrib_string ( filehandle, cstring(name), value) value = fstring(value) end function ! ! step attributes: ! integer(kind=c_int64_t) function h5pt_getstepattribinfo (filehandle,idx,name,nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open integer(kind=c_int64_t), intent(in) :: idx !< index of the attribute to query (starting from 0) character(len=*), intent(out) :: name !< buffer to read the attribute name into integer(kind=c_int64_t), intent(out) :: nelem !< number of elements in the attribute's array integer(kind=c_int64_t) :: l_name !< number of elements in the attribute's array l_name = len(name) h5pt_getstepattribinfo = h5ptc_getstepattribinfo (filehandle,idx,name,nelem,l_name) name = fstring(name) end function integer(kind=c_int64_t) function h5pt_writestepattrib_r8 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writestepattrib_r8 = h5ptc_writestepattrib_r8 ( filehandle, cstring(name), data, nelem) end function integer(kind=c_int64_t) function h5pt_readstepattrib_r8 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_double), intent(out) :: data(*) !< buffer to read value into h5pt_readstepattrib_r8 = h5ptc_readstepattrib_r8 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_writestepattrib_r4 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writestepattrib_r4 = h5ptc_writestepattrib_r4 ( filehandle, cstring(name), data, nelem) end function integer(kind=c_int64_t) function h5pt_readstepattrib_r4 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute real(kind=c_float), intent(out) :: data(*) !< buffer to read value into h5pt_readstepattrib_r4 = h5ptc_readstepattrib_r4 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_writestepattrib_i8 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writestepattrib_i8 = h5ptc_writestepattrib_i8 ( filehandle, cstring(name), data, nelem) end function integer(kind=c_int64_t) function h5pt_readstepattrib_i8 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int64_t), intent(out) :: data(*) !< buffer to read value into h5pt_readstepattrib_i8 = h5ptc_readstepattrib_i8 ( filehandle, cstring(name), data ) end function integer(kind=c_int64_t) function h5pt_writestepattrib_i4 ( filehandle, name, data, nelem) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(in) :: data(*) !< the array of data to write into the attribute integer(kind=c_int64_t), intent(in) :: nelem !< the number of elements in the array h5pt_writestepattrib_i4 = h5ptc_writestepattrib_i4 ( filehandle, cstring(name), data, nelem) end function integer(kind=c_int64_t) function h5pt_readstepattrib_i4 ( filehandle, name, data ) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned at file open character(len=*), intent(in) :: name !< the name of the attribute integer(kind=c_int), intent(out) :: data(*) !< buffer to read value into h5pt_readstepattrib_i4 = h5ptc_readstepattrib_i4 ( filehandle, cstring(name), data ) end function ! ! read/write string ! integer(kind=c_int64_t) function h5pt_writestepattrib_string ( filehandle, name, value) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the attribute character(len=*), intent(in) :: value !< the string value to store h5pt_writestepattrib_string = h5ptc_writestepattrib_string ( filehandle, cstring(name), cstring(value)) end function integer(kind=c_int64_t) function h5pt_readstepattrib_string ( filehandle, name, value) implicit none integer(kind=c_int64_t), intent(in) :: filehandle !< the handle returned during file open character(len=*), intent(in) :: name !< the name of the attribute character(len=*), intent(out) :: value !< buffer to read the string value into h5pt_readstepattrib_string = h5ptc_readstepattrib_string ( filehandle, cstring(name), value) value = fstring(value) end function !--------------------------------------------------------------------------- ! ! function to safely convert a string to c format (ie. with a terminating ! ascii null character) ! !--------------------------------------------------------------------------- function cstring(string) implicit none character(len=*), intent(in) :: string character(len=len(string)+1) :: cstring cstring = trim(string)//char(0) end function cstring !--------------------------------------------------------------------------- ! ! function to safely convert a string from c format (ie. with a terminating ! ascii null character) back to a normal Fortran string ! !--------------------------------------------------------------------------- function fstring(string) implicit none character(len=*), intent(in) :: string !< the name of the dataset character(len=len(string)) :: fstring integer :: idx idx = index(string,char(0)) if (idx.gt.1) then fstring = string(1:idx-1) else fstring = '' endif end function fstring end module h5partattrib splash/src/H5Part/H5PartAttribF.c000644 000770 000000 00000016122 11357372333 017376 0ustar00dpricewheel000000 000000 /* * This is my modified H5PartAttribF.c for use in SPLASH * Main changes are that the strings are now passed * directly from Fortran, already with the null character appended * * Modified from the original H5Part Fortran interface * by Daniel Price 08/04/10 */ #include "H5Part.h" h5part_int64_t h5ptc_writefileattrib_r8 ( h5part_int64_t *f, const char *name, const h5part_float64_t *data, const h5part_float64_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteFileAttrib ( filehandle, name, H5PART_FLOAT64, data, *nelem); return herr; } h5part_int64_t h5ptc_readfileattrib_r8 ( h5part_int64_t *f, const char *name, const h5part_float64_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadFileAttrib ( filehandle, name, (void*)data); return herr; } h5part_int64_t h5ptc_writefileattrib_r4 ( h5part_int64_t *f, const char *name, const h5part_float32_t *data, const h5part_float32_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteFileAttrib ( filehandle, name, H5PART_FLOAT32, data, *nelem); return herr; } h5part_int64_t h5ptc_readfileattrib_r4 ( h5part_int64_t *f, const char *name, const h5part_float32_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadFileAttrib ( filehandle, name, (void*)data); return herr; } h5part_int64_t h5ptc_writefileattrib_i8 ( h5part_int64_t *f, const char *name, const h5part_int64_t *data, const h5part_int64_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteFileAttrib ( filehandle, name, H5PART_INT64, data, *nelem); return herr; } h5part_int64_t h5ptc_readfileattrib_i8 ( h5part_int64_t *f, const char *name, const h5part_int64_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadFileAttrib ( filehandle, name, (void*)data); return herr; } h5part_int64_t h5ptc_writefileattrib_i4 ( h5part_int64_t *f, const char *name, const h5part_int32_t *data, const h5part_int32_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteFileAttrib ( filehandle, name, H5PART_INT32, data, *nelem); return herr; } h5part_int64_t h5ptc_readfileattrib_i4 ( h5part_int64_t *f, const char *name, const h5part_int32_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadFileAttrib ( filehandle, name, (void*)data); return herr; } h5part_int64_t h5ptc_writestepattrib_r8 ( h5part_int64_t *f, const char *name, const h5part_float64_t *data, const h5part_float64_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteStepAttrib ( filehandle, name, H5PART_FLOAT64, data, *nelem); return herr; } h5part_int64_t h5ptc_readstepattrib_r8 ( h5part_int64_t *f, const char *name, const h5part_float64_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadStepAttrib ( filehandle, name, (void*)data); return herr; } h5part_int64_t h5ptc_writestepattrib_r4 ( h5part_int64_t *f, const char *name, const h5part_float32_t *data, const h5part_float32_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteStepAttrib ( filehandle, name, H5PART_FLOAT32, data, *nelem); return herr; } h5part_int64_t h5ptc_readstepattrib_r4 ( h5part_int64_t *f, const char *name, const h5part_float32_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadStepAttrib ( filehandle, name, (void*)data); return herr; } h5part_int64_t h5ptc_writestepattrib_i8 ( h5part_int64_t *f, const char *name, const h5part_int64_t *data, const h5part_int64_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteStepAttrib ( filehandle, name, H5PART_INT64, data, *nelem); return herr; } h5part_int64_t h5ptc_readstepattrib_i8 ( h5part_int64_t *f, const char *name, const h5part_int64_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadStepAttrib ( filehandle, name, (void*)data); return herr; } h5part_int64_t h5ptc_writestepattrib_i4 ( h5part_int64_t *f, const char *name, const h5part_int32_t *data, const h5part_int32_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteStepAttrib ( filehandle, name, H5PART_INT32, data, *nelem); return herr; } h5part_int64_t h5ptc_readstepattrib_i4 ( h5part_int64_t *f, const char *name, const h5part_int32_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadStepAttrib ( filehandle, name, (void*)data); return herr; } /*=================== Attributes ================*/ h5part_int64_t h5ptc_writefileattrib_string ( const h5part_int64_t *f, const char *attrib_name, const char *attrib_value ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteFileAttribString ( filehandle, attrib_name, attrib_value ); return herr; } h5part_int64_t h5ptc_writestepattrib_string ( const h5part_int64_t *f, const char *attrib_name, const char *attrib_value ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteStepAttribString ( filehandle, attrib_name, attrib_value ); return herr; } /* Reading attributes ************************* */ h5part_int64_t h5ptc_getnstepattribs ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartGetNumStepAttribs ( filehandle ); } h5part_int64_t h5ptc_getnfileattribs ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartGetNumFileAttribs ( filehandle ); } h5part_int64_t h5ptc_getstepattribinfo ( const h5part_int64_t *f, const h5part_int64_t *idx, char *name, h5part_int64_t *nelem, const h5part_int64_t *l_name ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t type; h5part_int64_t herr = H5PartGetStepAttribInfo ( filehandle, *idx, name, *l_name, &type, nelem); return herr; } h5part_int64_t h5ptc_getfileattribinfo ( const h5part_int64_t *f, const h5part_int64_t *idx, char *name, h5part_int64_t *nelem, const h5part_int64_t *l_name ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t type; h5part_int64_t herr = H5PartGetFileAttribInfo ( filehandle, *idx, name, *l_name, &type, nelem); return herr; } h5part_int64_t h5ptc_readstepattrib_string ( const h5part_int64_t *f, const char *attrib_name, char *attrib_value ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadStepAttrib ( filehandle, attrib_name, attrib_value ); return herr; } h5part_int64_t h5ptc_readfileattrib_string ( const h5part_int64_t *f, const char *attrib_name, char *attrib_value ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadFileAttrib ( filehandle, attrib_name, attrib_value ); return herr; } splash/src/H5Part/H5PartF.c000644 000770 000000 00000023410 11357372333 016226 0ustar00dpricewheel000000 000000 /* * This is my modified H5PartF.c for use in SPLASH * Main changes are that the strings are now passed * directly from Fortran, already with the null character appended * * Modified from the original H5Part Fortran interface * by Daniel Price 08/04/10 */ #include "H5Part.h" #include char _H5Part_flagsfor2c ( char * flags ) { char fbits = 0x00; flags = strtok ( flags, "," ); while ( flags != NULL ) { if ( strcmp ( flags, "vfd_mpiposix" ) == 0 ) fbits |= H5PART_VFD_MPIPOSIX; else if ( strcmp ( flags, "fs_lustre" ) == 0 ) fbits |= H5PART_FS_LUSTRE; flags = strtok ( NULL, "," ); } return fbits; } /* open/close interface */ h5part_int64_t h5ptc_openr ( const char *file_name ) { H5PartFile* f = H5PartOpenFile ( file_name, H5PART_READ ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_openw ( const char *file_name ) { H5PartFile* f = H5PartOpenFile ( file_name, H5PART_WRITE ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_opena ( const char *file_name ) { H5PartFile* f = H5PartOpenFile ( file_name, H5PART_APPEND ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_openr_align ( const char *file_name, const h5part_int64_t *align ) { H5PartFile* f = H5PartOpenFileAlign ( file_name, H5PART_READ, *align ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_openw_align ( const char *file_name, const h5part_int64_t *align ) { H5PartFile* f = H5PartOpenFileAlign ( file_name, H5PART_WRITE, *align ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_opena_align ( const char *file_name, const h5part_int64_t *align ) { H5PartFile* f = H5PartOpenFileAlign ( file_name, H5PART_APPEND, *align ); return (h5part_int64_t)(size_t)f; } #ifdef PARALLEL_IO h5part_int64_t h5ptc_openr_par ( const char *file_name, MPI_Fint *fcomm ) { MPI_Comm ccomm = MPI_Comm_f2c (*fcomm); H5PartFile* f = H5PartOpenFileParallel ( file_name, H5PART_READ, ccomm ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_openw_par ( const char *file_name, MPI_Fint *fcomm ) { MPI_Comm ccomm = MPI_Comm_f2c (*fcomm); H5PartFile* f = H5PartOpenFileParallel ( file_name, H5PART_WRITE, ccomm ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_opena_par ( const char *file_name, MPI_Fint *fcomm ) { MPI_Comm ccomm = MPI_Comm_f2c (*fcomm); H5PartFile* f = H5PartOpenFileParallel ( file_name, H5PART_APPEND, ccomm ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_openr_par_align ( const char *file_name, MPI_Fint *fcomm, const h5part_int64_t *align ) { MPI_Comm ccomm = MPI_Comm_f2c (*fcomm); H5PartFile* f = H5PartOpenFileParallelAlign ( file_name, H5PART_READ, ccomm, *align ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_openw_par_align ( const char *file_name, MPI_Fint *fcomm, const h5part_int64_t *align, const char *flags ) { MPI_Comm ccomm = MPI_Comm_f2c (*fcomm); char fbits = H5PART_WRITE | _H5Part_flagsfor2c ( flags ); H5PartFile* f = H5PartOpenFileParallelAlign ( file_name, fbits, ccomm, *align ); return (h5part_int64_t)(size_t)f; } h5part_int64_t h5ptc_opena_par_align ( const char *file_name, MPI_Fint *fcomm, const h5part_int64_t *align, const char *flags ) { MPI_Comm ccomm = MPI_Comm_f2c (*fcomm); char fbits = H5PART_APPEND | _H5Part_flagsfor2c ( flags ); H5PartFile* f = H5PartOpenFileParallelAlign ( file_name, fbits, ccomm, *align ); return (h5part_int64_t)(size_t)f; } #endif h5part_int64_t h5ptc_close ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartCloseFile ( filehandle ); } /*==============Writing and Setting Dataset info========*/ h5part_int64_t h5ptc_readstep ( const h5part_int64_t *f, const h5part_int64_t *step, h5part_float64_t *x, h5part_float64_t *y, h5part_float64_t *z, h5part_float64_t *px, h5part_float64_t *py, h5part_float64_t *pz, h5part_int64_t *id ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartReadParticleStep ( filehandle,(*step)-1,x,y,z,px,py,pz,id); } h5part_int64_t h5ptc_setnpoints ( const h5part_int64_t *f, h5part_int64_t *np ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartSetNumParticles ( filehandle, *np ); } h5part_int64_t h5ptc_setnpoints_strided ( const h5part_int64_t *f, h5part_int64_t *np, h5part_int64_t *stride ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartSetNumParticlesStrided ( filehandle, *np, *stride ); } h5part_int64_t h5ptc_setstep ( const h5part_int64_t *f, h5part_int64_t *step ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartSetStep ( filehandle, (*step)-1 ); } h5part_int64_t h5ptc_writedata_r8 ( const h5part_int64_t *f, const char *name, const h5part_float64_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteDataFloat64 ( filehandle, name, data ); return herr; } h5part_int64_t h5ptc_writedata_r4 ( const h5part_int64_t *f, const char *name, const h5part_float32_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteDataFloat32 ( filehandle, name, data ); return herr; } h5part_int64_t h5ptc_writedata_i8 ( const h5part_int64_t *f, const char *name, const h5part_int64_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteDataInt64 ( filehandle, name, data ); return herr; } h5part_int64_t h5ptc_writedata_i4 ( const h5part_int64_t *f, const char *name, const h5part_int32_t *data ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartWriteDataInt32 ( filehandle, name, data ); return herr; } /*==============Reading Data Characteristics============*/ h5part_int64_t h5ptc_getnsteps ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartGetNumSteps ( filehandle ); } h5part_int64_t h5ptc_getndatasets ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartGetNumDatasets ( filehandle ); } h5part_int64_t h5ptc_getnpoints ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartGetNumParticles ( filehandle ); } h5part_int64_t h5ptc_getdatasetname ( const h5part_int64_t *f, const h5part_int64_t *index, char *name, const int l_name ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartGetDatasetName ( filehandle, *index, name, l_name ); return herr; } h5part_int64_t h5ptc_getdatasetinfo ( const h5part_int64_t *f, const h5part_int64_t *index, char *name, h5part_int64_t *type, h5part_int64_t *nelem, const h5part_int64_t *l_name ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t type_tmp; h5part_int64_t herr = H5PartGetDatasetInfo ( filehandle, *index, name, *l_name, &type_tmp, nelem ); if (type_tmp == H5PART_INT64) { *type = 1; } else if (type_tmp == H5PART_INT32) { *type = 2; } else if (type_tmp == H5PART_FLOAT64) { *type = 3; } else if (type_tmp == H5PART_FLOAT32) { *type = 4; } else if (type_tmp == H5PART_CHAR) { *type = 5; } else if (type_tmp == H5PART_STRING) { *type = 6; } else { *type = 0; } return herr; } /*=============Setting and getting views================*/ h5part_int64_t h5ptc_setview ( const h5part_int64_t *f, const h5part_int64_t *start, const h5part_int64_t *end ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartSetView ( filehandle, *start, *end ); } h5part_int64_t h5ptc_setview_indices ( const h5part_int64_t *f, const h5part_int64_t *indices, const h5part_int64_t *nelem ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartSetViewIndices ( filehandle, indices, *nelem ); } h5part_int64_t h5ptc_resetview ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartResetView ( filehandle ); } h5part_int64_t h5ptc_hasview ( const h5part_int64_t *f ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartHasView ( filehandle ); } h5part_int64_t h5ptc_getview ( const h5part_int64_t *f, h5part_int64_t *start, h5part_int64_t *end ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; return H5PartGetView ( filehandle, start, end); } /*==================Reading data ============*/ h5part_int64_t h5ptc_readdata_r8 ( const h5part_int64_t *f, const char *name, h5part_float64_t *array ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadDataFloat64 ( filehandle, name, array ); return herr; } h5part_int64_t h5ptc_readdata_r4 ( const h5part_int64_t *f, const char *name, h5part_float32_t *array ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadDataFloat32 ( filehandle, name, array ); return herr; } h5part_int64_t h5ptc_readdata_i8 ( const h5part_int64_t *f, const char *name, h5part_int64_t *array ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadDataInt64 ( filehandle, name, array ); return herr; } h5part_int64_t h5ptc_readdata_i4 ( const h5part_int64_t *f, const char *name, h5part_int32_t *array ) { H5PartFile *filehandle = (H5PartFile*)(size_t)*f; h5part_int64_t herr = H5PartReadDataInt32 ( filehandle, name, array ); return herr; } /* h5part_int64_t h5ptc_set_verbosity_level ( const h5part_int64_t *level ) { return H5PartSetVerbosityLevel ( *level ); } */ splash/src/H5Part/README000644 000770 000000 00000003164 11352542473 015534 0ustar00dpricewheel000000 000000 Website: http://vis.lbl.gov/Research/AcceleratorSAPP/ Particle based simulations of accelerator beam-lines, especially in six dimensional phase space, generate vast amounts of data. Even though a subset of statistical information regarding phase space or analysis needs to be preserved, reading and writing such enormous restart files on massively parallel supercomputing systems remains challenging. H5Part is a very simple data storage schema and provides an API that simplifies the reading/writing of the data to the HDF5 file format. An important foundation for a stable visualization and data analysis environment is a stable and portable file storage format and its associated APIs. The presence of a "common file storage format," including associated APIs, will help foster a fundamental level of interoperability across the project's software infrastructure. It will also help ensure that key data analysis capabilities are present during the earliest phases of the software development effort. H5Part is built on top of the HDF5 (Hierarchical Data Format). HDF5 offers a self-describing machine-independent binary file format that supports scalable parallel I/O performance for MPI codes on a variety of supercomputing systems, and works equally well on laptop computers. The API is available for C, C++, and Fortran codes. The H5Part file format and APIs enable disparate research groups with different simulation implementations to transparently share datasets and data analysis tools. For instance, the common file format will enable groups that depend on completely different simulation implementations to share data analysis tools. splash/scripts/cpfiles.bash000755 000770 000000 00000001645 11230074637 016737 0ustar00dpricewheel000000 000000 #!/bin/bash # # short script to copy all splash # files to a new prefix # # ie. splash.defaults, splash.limits, splash.units etc. # become new.defaults, new.limits, new.units # # SPLASH can be invoked to use the new settings files # using the -p command line option # if [ $# -lt 1 ] || [ $# -gt 2 ]; then echo 'SPLASH files copy utility -- ' echo 'copies splash.defaults, splash.limits etc. ' echo ' to new.defaults, new.limits etc. (use with splash -p new)' echo echo "Usage $0 newprefix [oldprefix]"; echo echo '(default old prefix is "splash")'; exit; else new=$1; if [ $# -eq 2 ]; then old=$2; else old='splash'; fi for ext in defaults limits units titles anim legend columns filenames; do if [ -e $old.$ext ]; then cp $old.$ext $new.$ext; echo "$old.$ext -> $new.$ext"; else echo "$old.$ext does not exist"; fi done fi splash/scripts/fixpgplotnames.bash000755 000770 000000 00000003121 11230074637 020341 0ustar00dpricewheel000000 000000 #!/bin/bash # @(#) renames pgplot filenames so they are listed in the correct order # @(#) NB: only works for < 10000 files # # 25/7/2006 Daniel Price, University of Exeter # dprice@astro.ex.ac.uk # # Usage: fixpgplotnames.bash [noffset] # where noffset changes the starting number (default is zero) # if [ $# -ne 1 ]; then numoffset=0; else numoffset=$1; echo Starting file numbers at $numoffset; # should check if offset is really a number, otherwise might get garbage ##if [ ${numoffset} -ne '[0-9]' ]; then exit "Usage: fixgifs.bash [nstart]"; fi fi # # copy first file(s) (e.g. pgplot.gif) with offset if appropriate # for x in pgplot.???; do num=1; let "num=num+numoffset"; lennum=${#num}; newname=${x/./_$num.} if test $lennum -eq 1; then newname=${newname/_/_000}; fi; if test $lennum -eq 2; then newname=${newname/_/_00}; fi; if test $lennum -eq 3; then newname=${newname/_/_0}; fi; echo $x '->' $newname; mv $x $newname; done; # # fix all subsequent files (e.g. pgplot.gif_1 pgplot.gif_2 ... pgplot.gif_11 ) # for x in pgplot.???_*; do num=${x##pgplot*_}; # extract number from the end of the string prefix=${x%%_*}; # extract string before the number # # add the offset # let "num=num+numoffset"; # # construct new filename # newname=${prefix/./_$num.}; lennum=${#num}; # # add appropriate number of zeros # if test $lennum -eq 1; then newname=${newname/_/_000}; fi; if test $lennum -eq 2; then newname=${newname/_/_00}; fi; if test $lennum -eq 3; then newname=${newname/_/_0}; fi; echo $x '->' $newname; mv $x $newname; done; exit; splash/scripts/getav.pl000755 000770 000000 00000001500 11230074637 016104 0ustar00dpricewheel000000 000000 #!/usr/bin/perl # adds up the L2 errors from supersphplot output; calculates average use strict; use warnings; use List::Util qw(sum); my $file = ' '; my $avg = 0; if ($#ARGV < 0) { print "script which parses supersphplot output for L2 errors \n"; print "and calculates the average. Written by D. Price. \n\n"; die "Usage: $0 filename(s) \n"; } foreach $file (@ARGV) { open my $fh, '<', $file or die "Can't open $file: $!"; my @errors; while ( <$fh> ) { if ( my ($error) = m/L2 error\s+=\s+(\S*)\s+/ ) { #print "error = $error \n"; push @errors, $error; } } my $nerrors = scalar(@errors); if ($nerrors > 0) { $avg = sum(@errors) / $nerrors; } else { $avg = 0; } print "$file: Average of $nerrors errors: $avg\n"; } #print "$_\n" for @errors; splash/scripts/makemovie.sh000755 000770 000000 00000003323 11600073705 016753 0ustar00dpricewheel000000 000000 #!/bin/bash # # Script supplied by Ben Ayliffe # for making movies that are playable # on both Mac and Linux without the need # for special software # # Requires the ffmpeg and mencoder utilities # if [ "$1" == "-h" ] then echo '-------------------------------------------------------------------------------' echo "Expected input form :